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

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3