[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.43, Mon Apr 24 21:05:17 2006 UTC revision 1.48, Thu Jun 8 13:54:49 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 344  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 361  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 426  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      # Verify that we can open a file in the temporary directory.      # to the standard output.
452      my $traceMode = "TEXT";      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";      my $traceFileName = "$FIG_Config::temp/trace$suffix.log";
462      if (open TESTTRACE, ">$traceFileName") {      if (open TESTTRACE, ">$traceFileName") {
463          $traceMode = "+>$traceFileName";          # 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;          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      TSetup($cats, $traceMode);      TSetup("$traceLevel $cats", $traceMode);
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 1969  Line 2010 
2010      }      }
2011  }  }
2012    
2013    =head3 SetPermissions
2014    
2015    C<< Tracer::SetPermissions($dirName, $group, $mask); >>
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    =back
2040    
2041    =cut
2042    
2043    sub SetPermissions {
2044        # Get the parameters.
2045        my ($dirName, $group, $mask) = @_;
2046        # Set up for error recovery.
2047        eval {
2048            ChDir($dirName);
2049            # Get the group ID.
2050            my $gid = getgrnam($group);
2051            Trace("Fixing permissions for directory $dirName using group $group($gid).") if T(2);
2052            my $fixCount = 0;
2053            my $lookCount = 0;
2054            # @dirs will be a stack of directories to be processed.
2055            my @dirs = (getcwd());
2056            while (scalar(@dirs) > 0) {
2057                # Get the current directory.
2058                my $dir = pop @dirs;
2059                # Get all its non-hidden members.
2060                my @submems = OpenDir($dir, 1);
2061                for my $submem (@submems) {
2062                    # Get the full name.
2063                    my $thisMem = "$dir/$submem";
2064                    Trace("Checking member $thisMem.") if T(4);
2065                    $lookCount++;
2066                    if ($lookCount % 1000 == 0) {
2067                        Trace("$lookCount members examined. Current is $thisMem.") if T(3);
2068                    }
2069                    # Fix the group.
2070                    chown -1, $gid, $thisMem;
2071                    # Insure this member is not a symlink.
2072                    if (! -l $thisMem) {
2073                        # Get its info.
2074                        my $fileInfo = stat $thisMem;
2075                        # Only proceed if we got the info. Otherwise, it's a hard link
2076                        # and we want to skip it anyway.
2077                        if ($fileInfo) {
2078                            my $fileMode = $fileInfo->mode;
2079                            if (($fileMode & $mask) == 0) {
2080                                # Fix this member.
2081                                $fileMode |= $mask;
2082                                chmod $fileMode, $thisMem;
2083                                $fixCount++;
2084                            }
2085                            # If it's a subdirectory, stack it.
2086                            if (-d $thisMem) {
2087                                push @dirs, $thisMem;
2088                            }
2089                        }
2090                    }
2091                }
2092            }
2093            Trace("$lookCount files and directories processed, $fixCount fixed.") if T(2);
2094        };
2095        # Check for an error.
2096        if ($@) {
2097            Confess("SetPermissions error: $@");
2098        }
2099    }
2100    
2101  1;  1;

Legend:
Removed from v.1.43  
changed lines
  Added in v.1.48

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3