[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.51, Wed Jun 14 01:08:46 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);
26      use CGI;      use CGI;
27        use Cwd;
28      use FIG_Config;      use FIG_Config;
29      use PageBuilder;      use PageBuilder;
30      use Digest::MD5;      use Digest::MD5;
31      use File::Basename;      use File::Basename;
32      use File::Path;      use File::Path;
33        use File::stat;
34    
35  =head1 Tracing and Debugging Helpers  =head1 Tracing and Debugging Helpers
36    
# Line 275  Line 277 
277  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
278  can see this last in the command-line example above.  can see this last in the command-line example above.
279    
280    You can specify a different default trace level by setting C<$options->{trace}>
281    prior to calling this method.
282    
283  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
284  C<TransactFeatures>. It accepts a list of positional parameters plus the options  C<TransactFeatures>. It accepts a list of positional parameters plus the options
285  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 319 
319  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
320  upsetting the command-line utilities.  upsetting the command-line utilities.
321    
322    If the C<background> option is specified on the command line, then the
323    standard and error outputs will be directed to files in the temporary
324    directory, using the same suffix as the trace file. So, if the command
325    line specified
326    
327        -user=Bruce -background
328    
329    then the trace output would go to C<traceBruce.log>, the standard output to
330    C<outBruce.log>, and the error output to C<errBruce.log>. This is designed to
331    simplify starting a command in the background.
332    
333  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
334  be traced at level 0 and the program will exit without processing.  be traced at level 0 and the program will exit without processing.
335  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 346 
346          -start    start with this genome          -start    start with this genome
347          -tblFiles output TBL files containing the corrected IDs          -tblFiles output TBL files containing the corrected IDs
348    
349    The caller has the option of modifying the tracing scheme by placing a value
350    for C<trace> in the incoming options hash. The default value can be overridden,
351    or the tracing to the standard output can be turned off by suffixing a minus
352    sign to the trace level. So, for example,
353    
354        { trace => [0, "tracing level (default 0)"],
355           ...
356    
357    would set the default trace level to 0 instead of 2, while
358    
359        { trace => ["2-", "tracing level (default 2)"],
360           ...
361    
362    would leave the default at 2, but trace only to the log file, not to the
363    standard output.
364    
365  The parameters to this method are as follows.  The parameters to this method are as follows.
366    
367  =over 4  =over 4
# Line 347  Line 379 
379  by specifying the options as command-line switches prefixed by a hyphen.  by specifying the options as command-line switches prefixed by a hyphen.
380  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
381  specified on the command line, the option descriptions will be used to  specified on the command line, the option descriptions will be used to
382  explain the options.  explain the options. To turn off tracing to the standard output, add a
383    minus sign to the value for C<trace> (see above).
384    
385  =item parmHelp  =item parmHelp
386    
387  A string that vaguely describes the positional parameters. This is used  A string that vaguely describes the positional parameters. This is used
388  if the user specifies the C<-h> option.  if the user specifies the C<-h> option.
389    
390  =item ARGV  =item argv
391    
392  List of command line parameters, including the option switches, which must  List of command line parameters, including the option switches, which must
393  precede the positional parameters and be prefixed by a hyphen.  precede the positional parameters and be prefixed by a hyphen.
# Line 374  Line 407 
407      # Get the parameters.      # Get the parameters.
408      my ($categories, $options, $parmHelp, @argv) = @_;      my ($categories, $options, $parmHelp, @argv) = @_;
409      # Add the tracing options.      # Add the tracing options.
410        if (! exists $options->{trace}) {
411      $options->{trace} = [2, "tracing level"];      $options->{trace} = [2, "tracing level"];
412        }
413      $options->{sql} = [0, "turn on SQL tracing"];      $options->{sql} = [0, "turn on SQL tracing"];
414      $options->{h} = [0, "display command-line options"];      $options->{h} = [0, "display command-line options"];
415      $options->{user} = [$$, "trace log file name suffix"];      $options->{user} = [$$, "trace log file name suffix"];
416        $options->{background} = [0, "spool standard and error output"];
417      # Create a parsing hash from the options hash. The parsing hash      # Create a parsing hash from the options hash. The parsing hash
418      # contains the default values rather than the default value      # contains the default values rather than the default value
419      # 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 428 
428      }      }
429      # Parse the command line.      # Parse the command line.
430      my ($retOptions, @retParameters) = ParseCommand(\%parseOptions, @argv);      my ($retOptions, @retParameters) = ParseCommand(\%parseOptions, @argv);
431        # Get the logfile suffix.
432        my $suffix = $retOptions->{user};
433        # Check for background mode.
434        if ($retOptions->{background}) {
435            my $outFileName = "$FIG_Config::temp/out$suffix.log";
436            my $errFileName = "$FIG_Config::temp/err$suffix.log";
437            open STDOUT, ">$outFileName";
438            open STDERR, ">$errFileName";
439        }
440      # 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
441      # be traced.      # be traced.
442      my @cats = @{$categories};      my @cats = @{$categories};
# Line 400  Line 445 
445      }      }
446      # Add the default categories.      # Add the default categories.
447      push @cats, "Tracer", "FIG";      push @cats, "Tracer", "FIG";
448      # Next, we create the category string by prefixing the trace level      # Next, we create the category string by joining the categories.
449      # and joining the categories.      my $cats = join(" ", @cats);
450      my $cats = join(" ", $parseOptions{trace}, @cats);      # Check to determine whether or not the caller wants to turn off tracing
451        # to the standard output.
452        my $traceLevel = $retOptions->{trace};
453        my $textOKFlag = 1;
454        if ($traceLevel =~ /^(.)-/) {
455            $traceLevel = $1;
456            $textOKFlag = 0;
457        }
458        # Now we set up the trace mode.
459        my $traceMode;
460        # Verify that we can open a file in the FIG temporary directory.
461        my $traceFileName = "$FIG_Config::temp/trace$suffix.log";
462        if (open TESTTRACE, ">$traceFileName") {
463            # Here we can trace to a file.
464            $traceMode = ">$traceFileName";
465            if ($textOKFlag) {
466                # Echo to standard output if the text-OK flag is set.
467                $traceMode = "+$traceMode";
468            }
469            # Close the test file.
470            close TESTTRACE;
471        } else {
472            # Here we can't trace to a file. We trace to the standard output if it's
473            # okay, and the error log otherwise.
474            if ($textOKFlag) {
475                $traceMode = "TEXT";
476            } else {
477                $traceMode = "WARN";
478            }
479        }
480      # Now set up the tracing.      # Now set up the tracing.
481      my $suffix = $retOptions->{user};      TSetup("$traceLevel $cats", $traceMode);
     TSetup($cats, "+>$FIG_Config::temp/trace$suffix.log");  
482      # 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
483      # options and exit the program.      # options and exit the program.
484      if ($retOptions->{h}) {      if ($retOptions->{h}) {
# Line 1901  Line 1974 
1974      my ($dirName) = @_;      my ($dirName) = @_;
1975      if (! -d $dirName) {      if (! -d $dirName) {
1976          Trace("Creating $dirName directory.") if T(2);          Trace("Creating $dirName directory.") if T(2);
1977          mkpath $dirName;          eval { mkpath $dirName; };
1978            if ($@) {
1979                Confess("Error creating $dirName: $@");
1980            }
1981        }
1982    }
1983    
1984    =head3 ChDir
1985    
1986    C<< ChDir($dirName); >>
1987    
1988    Change to the specified directory.
1989    
1990    =over 4
1991    
1992    =item dirName
1993    
1994    Name of the directory to which we want to change.
1995    
1996    =back
1997    
1998    =cut
1999    
2000    sub ChDir {
2001        my ($dirName) = @_;
2002        if (! -d $dirName) {
2003            Confess("Cannot change to directory $dirName: no such directory.");
2004        } else {
2005            Trace("Changing to directory $dirName.") if T(4);
2006            my $okFlag = chdir $dirName;
2007            if (! $okFlag) {
2008                Confess("Error switching to directory $dirName.");
2009            }
2010        }
2011    }
2012    
2013    =head3 SetPermissions
2014    
2015    C<< Tracer::SetPermissions($dirName, $group, $mask, %otherMasks); >>
2016    
2017    Set the permissions for a directory and all the files and folders inside it.
2018    In addition, the group ownership will be changed to the specified value.
2019    
2020    This method is more vulnerable than most to permission and compatability
2021    problems, so it does internal error recovery.
2022    
2023    =over 4
2024    
2025    =item dirName
2026    
2027    Name of the directory to process.
2028    
2029    =item group
2030    
2031    Name of the group to be assigned.
2032    
2033    =item mask
2034    
2035    Permission mask. Bits that are C<1> in this mask will be ORed into the
2036    permission bits of any file or directory that does not already have them
2037    set to 1.
2038    
2039    =item otherMasks
2040    
2041    Map of search patterns to permission masks. If a directory name matches
2042    one of the patterns, that directory and all its members and subdirectories
2043    will be assigned the new pattern. For example, the following would
2044    assign 01664 to most files, but would use 01777 for directories named C<tmp>.
2045    
2046        Tracer::SetPermissions($dirName, 'fig', 01664, '^tmp$' => 01777);
2047    
2048    The list is ordered, so the following would use 0777 for C<tmp1> and
2049    0666 for C<tmp>, C<tmp2>, or C<tmp3>.
2050    
2051        Tracer::SetPermissions($dirName, 'fig', 01664, '^tmp1' => 0777,
2052                                                       '^tmp' => 0666);
2053    
2054    Note that the pattern matches are all case-insensitive, and only directory
2055    names are matched, not file names.
2056    
2057    =back
2058    
2059    =cut
2060    
2061    sub SetPermissions {
2062        # Get the parameters.
2063        my ($dirName, $group, $mask, @otherMasks) = @_;
2064        # Set up for error recovery.
2065        eval {
2066            # Switch to the specified directory.
2067            ChDir($dirName);
2068            # Get the group ID.
2069            my $gid = getgrnam($group);
2070            # Get the mask for tracing.
2071            my $traceMask = sprintf("%04o", $mask) . "($mask)";
2072            Trace("Fixing permissions for directory $dirName using group $group($gid) and mask $traceMask.") if T(2);
2073            my $fixCount = 0;
2074            my $lookCount = 0;
2075            # @dirs will be a stack of directories to be processed.
2076            my @dirs = (getcwd());
2077            while (scalar(@dirs) > 0) {
2078                # Get the current directory.
2079                my $dir = pop @dirs;
2080                # Check for a match to one of the specified directory names. To do
2081                # that, we need to pull the individual part of the name off of the
2082                # whole path.
2083                my $simpleName = $dir;
2084                if ($dir =~ m!/(.+)$!) {
2085                    $simpleName = $1;
2086                }
2087                # Search for a match.
2088                my $match = 0;
2089                my $i;
2090                for ($i = 0; $i < $#otherMasks && ! $match; $i += 2) {
2091                    my $pattern = $otherMasks[$i];
2092                    if ($simpleName =~ /$pattern/i) {
2093                        $match = 1;
2094                    }
2095                }
2096                # Check for a match.
2097                if ($match && $otherMasks[$i+1] != $mask) {
2098                    # This directory matches one of the incoming patterns, and it's
2099                    # a different mask, so we process it recursively with that mask.
2100                    SetPermissions($dir, $group, $otherMasks[$i+1], @otherMasks);
2101                } else {
2102                    # Here we can process normally. Get all of the non-hidden members.
2103                    my @submems = OpenDir($dir, 1);
2104                    for my $submem (@submems) {
2105                        # Get the full name.
2106                        my $thisMem = "$dir/$submem";
2107                        Trace("Checking member $thisMem.") if T(4);
2108                        $lookCount++;
2109                        if ($lookCount % 1000 == 0) {
2110                            Trace("$lookCount members examined. Current is $thisMem. Mask is $traceMask") if T(3);
2111                        }
2112                        # Fix the group.
2113                        chown -1, $gid, $thisMem;
2114                        # Insure this member is not a symlink.
2115                        if (! -l $thisMem) {
2116                            # Get its info.
2117                            my $fileInfo = stat $thisMem;
2118                            # Only proceed if we got the info. Otherwise, it's a hard link
2119                            # and we want to skip it anyway.
2120                            if ($fileInfo) {
2121                                my $fileMode = $fileInfo->mode;
2122                                if (($fileMode & $mask) == 0) {
2123                                    # Fix this member.
2124                                    $fileMode |= $mask;
2125                                    chmod $fileMode, $thisMem;
2126                                    $fixCount++;
2127                                }
2128                                # If it's a subdirectory, stack it.
2129                                if (-d $thisMem) {
2130                                    push @dirs, $thisMem;
2131                                }
2132                            }
2133                        }
2134                    }
2135                }
2136            }
2137            Trace("$lookCount files and directories processed, $fixCount fixed.") if T(2);
2138        };
2139        # Check for an error.
2140        if ($@) {
2141            Confess("SetPermissions error: $@");
2142      }      }
2143  }  }
2144    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3