[Bio] / FigKernelPackages / Tracer.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/Tracer.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.39, Fri Feb 24 19:45:29 2006 UTC revision 1.46, Thu Jun 8 13:42:24 2006 UTC
# Line 19  Line 19 
19    
20      require Exporter;      require Exporter;
21      @ISA = ('Exporter');      @ISA = ('Exporter');
22      @EXPORT = qw(Trace T TSetup QTrace Confess Cluck Min Max Assert Open OpenDir TICK StandardSetup ScriptSetup ScriptFinish Insure);      @EXPORT = qw(Trace T TSetup QTrace Confess Cluck Min Max Assert Open OpenDir TICK StandardSetup ScriptSetup ScriptFinish Insure ChDir);
23      @EXPORT_OK = qw(GetFile GetOptions Merge MergeOptions ParseCommand ParseRecord UnEscape Escape);      @EXPORT_OK = qw(GetFile GetOptions Merge MergeOptions ParseCommand ParseRecord UnEscape Escape);
24      use strict;      use strict;
25      use Carp qw(longmess croak);      use Carp qw(longmess croak);
# Line 275  Line 275 
275  of a keyword, the value is separated from the option name by an equal sign. You  of a keyword, the value is separated from the option name by an equal sign. You
276  can see this last in the command-line example above.  can see this last in the command-line example above.
277    
278    You can specify a different default trace level by setting C<$options->{trace}>
279    prior to calling this method.
280    
281  An example at this point would help. Consider, for example, the command-line utility  An example at this point would help. Consider, for example, the command-line utility
282  C<TransactFeatures>. It accepts a list of positional parameters plus the options  C<TransactFeatures>. It accepts a list of positional parameters plus the options
283  C<safe>, C<noAlias>, C<start>, and C<tblFiles>. To start up this command, we execute  C<safe>, C<noAlias>, C<start>, and C<tblFiles>. To start up this command, we execute
# Line 314  Line 317 
317  need to be added in the future, they can be processed by this method without  need to be added in the future, they can be processed by this method without
318  upsetting the command-line utilities.  upsetting the command-line utilities.
319    
320    If the C<background> option is specified on the command line, then the
321    standard and error outputs will be directed to files in the temporary
322    directory, using the same suffix as the trace file. So, if the command
323    line specified
324    
325        -user=Bruce -background
326    
327    then the trace output would go to C<traceBruce.log>, the standard output to
328    C<outBruce.log>, and the error output to C<errBruce.log>. This is designed to
329    simplify starting a command in the background.
330    
331  Finally, if the special option C<-h> is specified, the option names will  Finally, if the special option C<-h> is specified, the option names will
332  be traced at level 0 and the program will exit without processing.  be traced at level 0 and the program will exit without processing.
333  This provides a limited help capability. For example, if the user enters  This provides a limited help capability. For example, if the user enters
# Line 330  Line 344 
344          -start    start with this genome          -start    start with this genome
345          -tblFiles output TBL files containing the corrected IDs          -tblFiles output TBL files containing the corrected IDs
346    
347    The caller has the option of modifying the tracing scheme by placing a value
348    for C<trace> in the incoming options hash. The default value can be overridden,
349    or the tracing to the standard output can be turned off by suffixing a minus
350    sign to the trace level. So, for example,
351    
352        { trace => [0, "tracing level (default 0)"],
353           ...
354    
355    would set the default trace level to 0 instead of 2, while
356    
357        { trace => ["2-", "tracing level (default 2)"],
358           ...
359    
360    would leave the default at 2, but trace only to the log file, not to the
361    standard output.
362    
363  The parameters to this method are as follows.  The parameters to this method are as follows.
364    
365  =over 4  =over 4
# Line 347  Line 377 
377  by specifying the options as command-line switches prefixed by a hyphen.  by specifying the options as command-line switches prefixed by a hyphen.
378  Tracing-related options may be added to this hash. If the C<-h> option is  Tracing-related options may be added to this hash. If the C<-h> option is
379  specified on the command line, the option descriptions will be used to  specified on the command line, the option descriptions will be used to
380  explain the options.  explain the options. To turn off tracing to the standard output, add a
381    minus sign to the value for C<trace> (see above).
382    
383  =item parmHelp  =item parmHelp
384    
385  A string that vaguely describes the positional parameters. This is used  A string that vaguely describes the positional parameters. This is used
386  if the user specifies the C<-h> option.  if the user specifies the C<-h> option.
387    
388  =item ARGV  =item argv
389    
390  List of command line parameters, including the option switches, which must  List of command line parameters, including the option switches, which must
391  precede the positional parameters and be prefixed by a hyphen.  precede the positional parameters and be prefixed by a hyphen.
# Line 374  Line 405 
405      # Get the parameters.      # Get the parameters.
406      my ($categories, $options, $parmHelp, @argv) = @_;      my ($categories, $options, $parmHelp, @argv) = @_;
407      # Add the tracing options.      # Add the tracing options.
408        if (! exists $options->{trace}) {
409      $options->{trace} = [2, "tracing level"];      $options->{trace} = [2, "tracing level"];
410        }
411      $options->{sql} = [0, "turn on SQL tracing"];      $options->{sql} = [0, "turn on SQL tracing"];
412      $options->{h} = [0, "display command-line options"];      $options->{h} = [0, "display command-line options"];
413      $options->{user} = [$$, "trace log file name suffix"];      $options->{user} = [$$, "trace log file name suffix"];
414        $options->{background} = [0, "spool standard and error output"];
415      # Create a parsing hash from the options hash. The parsing hash      # Create a parsing hash from the options hash. The parsing hash
416      # contains the default values rather than the default value      # contains the default values rather than the default value
417      # and the description. While we're at it, we'll memorize the      # and the description. While we're at it, we'll memorize the
# Line 392  Line 426 
426      }      }
427      # Parse the command line.      # Parse the command line.
428      my ($retOptions, @retParameters) = ParseCommand(\%parseOptions, @argv);      my ($retOptions, @retParameters) = ParseCommand(\%parseOptions, @argv);
429        # Get the logfile suffix.
430        my $suffix = $retOptions->{user};
431        # Check for background mode.
432        if ($retOptions->{background}) {
433            my $outFileName = "$FIG_Config::temp/out$suffix.log";
434            my $errFileName = "$FIG_Config::temp/err$suffix.log";
435            open STDOUT, ">$outFileName";
436            open STDERR, ">$errFileName";
437        }
438      # Now we want to set up tracing. First, we need to know if SQL is to      # Now we want to set up tracing. First, we need to know if SQL is to
439      # be traced.      # be traced.
440      my @cats = @{$categories};      my @cats = @{$categories};
# Line 400  Line 443 
443      }      }
444      # Add the default categories.      # Add the default categories.
445      push @cats, "Tracer", "FIG";      push @cats, "Tracer", "FIG";
446      # Next, we create the category string by prefixing the trace level      # Next, we create the category string by joining the categories.
447      # and joining the categories.      my $cats = join(" ", @cats);
448      my $cats = join(" ", $parseOptions{trace}, @cats);      # Check to determine whether or not the caller wants to turn off tracing
449        # to the standard output.
450        my $traceLevel = $retOptions->{trace};
451        my $textOKFlag = 1;
452        if ($traceLevel =~ /^(.)-/) {
453            $traceLevel = $1;
454            $textOKFlag = 0;
455        }
456        # Now we set up the trace mode.
457        my $traceMode;
458        # Verify that we can open a file in the FIG temporary directory.
459        my $traceFileName = "$FIG_Config::temp/trace$suffix.log";
460        if (open TESTTRACE, ">$traceFileName") {
461            # Here we can trace to a file.
462            $traceMode = ">$traceFileName";
463            if ($textOKFlag) {
464                # Echo to standard output if the text-OK flag is set.
465                $traceMode = "+$traceMode";
466            }
467            # Close the test file.
468            close TESTTRACE;
469        } else {
470            # Here we can't trace to a file. We trace to the standard output if it's
471            # okay, and the error log otherwise.
472            if ($textOKFlag) {
473                $traceMode = "TEXT";
474            } else {
475                $traceMode = "WARN";
476            }
477        }
478      # Now set up the tracing.      # Now set up the tracing.
479      my $suffix = $retOptions->{user};      TSetup("$traceLevel $cats", $traceMode);
     TSetup($cats, "+>$FIG_Config::temp/trace$suffix.log");  
480      # Check for the "h" option. If it is specified, dump the command-line      # Check for the "h" option. If it is specified, dump the command-line
481      # options and exit the program.      # options and exit the program.
482      if ($retOptions->{h}) {      if ($retOptions->{h}) {
# Line 1901  Line 1972 
1972      my ($dirName) = @_;      my ($dirName) = @_;
1973      if (! -d $dirName) {      if (! -d $dirName) {
1974          Trace("Creating $dirName directory.") if T(2);          Trace("Creating $dirName directory.") if T(2);
1975          mkpath $dirName;          eval { mkpath $dirName; };
1976            if ($@) {
1977                Confess("Error creating $dirName: $@");
1978            }
1979        }
1980    }
1981    
1982    =head3 ChDir
1983    
1984    C<< ChDir($dirName); >>
1985    
1986    Change to the specified directory.
1987    
1988    =over 4
1989    
1990    =item dirName
1991    
1992    Name of the directory to which we want to change.
1993    
1994    =back
1995    
1996    =cut
1997    
1998    sub ChDir {
1999        my ($dirName) = @_;
2000        if (! -d $dirName) {
2001            Confess("Cannot change to directory $dirName: no such directory.");
2002        } else {
2003            Trace("Changing to directory $dirName.") if T(4);
2004            my $okFlag = chdir $dirName;
2005            if (! $okFlag) {
2006                Confess("Error switching to directory $dirName.");
2007            }
2008        }
2009    }
2010    
2011    =head3 SetPermissions
2012    
2013    C<< Tracer::SetPermissions($dirName, $group, $mask); >>
2014    
2015    Set the permissions for a directory and all the files and folders inside it.
2016    In addition, the group ownership will be changed to the specified value.
2017    
2018    This method is more vulnerable than most to permission and compatability
2019    problems, so it does internal error recovery.
2020    
2021    =over 4
2022    
2023    =item dirName
2024    
2025    Name of the directory to process.
2026    
2027    =item group
2028    
2029    Name of the group to be assigned.
2030    
2031    =item mask
2032    
2033    Permission mask. Bits that are C<1> in this mask will be ORed into the
2034    permission bits of any file or directory that does not already have them
2035    set to 1.
2036    
2037    =back
2038    
2039    =cut
2040    
2041    sub SetPermissions {
2042        # Get the parameters.
2043        my ($dirName, $group, $mask) = @_;
2044        # Set up for error recovery.
2045        eval {
2046            ChDir($dirName);
2047            # Get the group ID.
2048            my $gid = getgrnam($group);
2049            Trace("Fixing permissions for directory $dirName using group $group($gid).") if T(2);
2050            my $fixCount = 0;
2051            my $lookCount = 0;
2052            # @dirs will be a stack of directories to be processed.
2053            my @dirs = (getcwd());
2054            while (scalar(@dirs) > 0) {
2055                # Get the current directory.
2056                my $dir = pop @dirs;
2057                # Get all its non-hidden members.
2058                my @submems = OpenDir($dir, 1);
2059                for my $submem (@submems) {
2060                    # Get the full name.
2061                    my $thisMem = "$dir/$submem";
2062                    Trace("Checking member $thisMem.") if T(4);
2063                    $lookCount++;
2064                    if ($lookCount % 1000 == 0) {
2065                        Trace("$lookCount members examined. Current is $thisMem.") if T(3);
2066                    }
2067                    # Fix the group.
2068                    chown -1, $gid, $thisMem;
2069                    # Insure this member is not a symlink.
2070                    if (! -l $thisMem) {
2071                        # Get its info.
2072                        my $fileInfo = stat $thisMem;
2073                        # Only proceed if we got the info. Otherwise, it's a hard link
2074                        # and we want to skip it anyway.
2075                        if ($fileInfo) {
2076                            my $fileMode = $fileInfo->mode;
2077                            if (($fileMode & $mask) == 0) {
2078                                # Fix this member.
2079                                $fileMode |= $mask;
2080                                chmod $fileMode, $thisMem;
2081                                $fixCount++;
2082                            }
2083                            # If it's a subdirectory, stack it.
2084                            if (-d $thisMem) {
2085                                push @dirs, $thisMem;
2086                            }
2087                        }
2088                    }
2089                }
2090            }
2091            Trace("$lookCount files and directories processed, $fixCount fixed.") if T(2);
2092        };
2093        # Check for an error.
2094        if ($@) {
2095            Confess("SetPermissions error: $@");
2096      }      }
2097  }  }
2098    

Legend:
Removed from v.1.39  
changed lines
  Added in v.1.46

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3