[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.110, Tue Sep 23 21:48:27 2008 UTC revision 1.111, Tue Sep 30 15:20:36 2008 UTC
# Line 38  Line 38 
38      use Time::Local;      use Time::Local;
39      use POSIX qw(strftime);      use POSIX qw(strftime);
40      use Time::Zone;      use Time::Zone;
41      use Fcntl ':flock';      use Fcntl qw(:DEFAULT :flock);
42    
43    
44  =head1 Tracing and Debugging Helpers  =head1 Tracing and Debugging Helpers
# Line 493  Line 493 
493      } elsif ($Destination =~ m/^>>/) {      } elsif ($Destination =~ m/^>>/) {
494          # Write the trace message to an output file.          # Write the trace message to an output file.
495          open(TRACING, $Destination) || die "Tracing open for \"$Destination\" failed: $!";          open(TRACING, $Destination) || die "Tracing open for \"$Destination\" failed: $!";
496            # Lock the file.
497            flock TRACING, LOCK_EX;
498          print TRACING "$formatted\n";          print TRACING "$formatted\n";
499          close TRACING;          close TRACING;
500          # If the Tee flag is on, echo it to the standard output.          # If the Tee flag is on, echo it to the standard output.
# Line 1613  Line 1615 
1615          -noAlias  do not expect aliases in CHANGE transactions          -noAlias  do not expect aliases in CHANGE transactions
1616          -start    start with this genome          -start    start with this genome
1617          -tblFiles output TBL files containing the corrected IDs          -tblFiles output TBL files containing the corrected IDs
1618            -forked   do not erase the trace file before tracing
1619    
1620  The caller has the option of modifying the tracing scheme by placing a value  The caller has the option of modifying the tracing scheme by placing a value
1621  for C<trace> in the incoming options hash. The default value can be overridden,  for C<trace> in the incoming options hash. The default value can be overridden,
# Line 1682  Line 1685 
1685      if (! exists $options->{trace}) {      if (! exists $options->{trace}) {
1686          $options->{trace} = ['2', "tracing level (E for emergency tracing)"];          $options->{trace} = ['2', "tracing level (E for emergency tracing)"];
1687      }      }
1688        $options->{forked} = [0, "keep old trace file"];
1689      $options->{sql} = [0, "turn on SQL tracing"];      $options->{sql} = [0, "turn on SQL tracing"];
1690      $options->{help} = [0, "display command-line options"];      $options->{help} = [0, "display command-line options"];
1691      $options->{user} = [$tkey, "tracing key"];      $options->{user} = [$tkey, "tracing key"];
# Line 1705  Line 1709 
1709      my $suffix = $retOptions->{user};      my $suffix = $retOptions->{user};
1710      # Check for background mode.      # Check for background mode.
1711      if ($retOptions->{background}) {      if ($retOptions->{background}) {
1712          my $outFileName = "$FIG_Config::temp/out$suffix.log";          my $outFileName = "$FIG_Config::temp/out$suffix$$.log";
1713          my $errFileName = "$FIG_Config::temp/err$suffix.log";          my $errFileName = "$FIG_Config::temp/err$suffix$$.log";
1714          open STDOUT, ">$outFileName";          open STDOUT, ">$outFileName";
1715          open STDERR, ">$errFileName";          open STDERR, ">$errFileName";
1716          # Check for phone support. If we have phone support and a phone number,          # Check for phone support. If we have phone support and a phone number,
# Line 1744  Line 1748 
1748          my $traceMode;          my $traceMode;
1749          # Verify that we can open a file in the FIG temporary directory.          # Verify that we can open a file in the FIG temporary directory.
1750          my $traceFileName = "$FIG_Config::temp/trace$suffix.log";          my $traceFileName = "$FIG_Config::temp/trace$suffix.log";
1751          if (open TESTTRACE, ">$traceFileName") {          my $traceFileSpec = ($retOptions->{forked} ? ">>$traceFileName" : ">$traceFileName");
1752            if (open TESTTRACE, "$traceFileSpec") {
1753              # Here we can trace to a file.              # Here we can trace to a file.
1754              $traceMode = ">$traceFileName";              $traceMode = ">>$traceFileName";
1755              if ($textOKFlag) {              if ($textOKFlag) {
1756                  # Echo to standard output if the text-OK flag is set.                  # Echo to standard output if the text-OK flag is set.
1757                  $traceMode = "+$traceMode";                  $traceMode = "+$traceMode";
# Line 1947  Line 1952 
1952      }      }
1953  }  }
1954    
1955    =head3 UnparseOptions
1956    
1957        my $optionString = Tracer::UnparseOptions(\%options);
1958    
1959    Convert an option hash into a command-line string. This will not
1960    necessarily be the same text that came in, but it will nonetheless
1961    produce the same ultimate result when parsed by L</StandardSetup>.
1962    
1963    =over 4
1964    
1965    =item options
1966    
1967    Reference to a hash of options to convert into an option string.
1968    
1969    =item RETURN
1970    
1971    Returns a string that will parse to the same set of options when
1972    parsed by L</StandardSetup>.
1973    
1974    =back
1975    
1976    =cut
1977    
1978    sub UnparseOptions {
1979        # Get the parameters.
1980        my ($options) = @_;
1981        # The option segments will be put in here.
1982        my @retVal = ();
1983        # Loop through the options.
1984        for my $key (keys %$options) {
1985            # Get the option value.
1986            my $value = $options->{$key};
1987            # Only use it if it's nonempty.
1988            if (defined $value && $value ne "") {
1989                my $segment = "--$key=$value";
1990                # Quote it if necessary.
1991                if ($segment =~ /[ |<>*]/) {
1992                    $segment = '"' . $segment . '"';
1993                }
1994                # Add it to the return list.
1995                push @retVal, $segment;
1996            }
1997        }
1998        # Return the result.
1999        return join(" ", @retVal);
2000    }
2001    
2002  =head3 ParseCommand  =head3 ParseCommand
2003    
2004      my ($options, @arguments) = Tracer::ParseCommand(\%optionTable, @inputList);      my ($options, @arguments) = Tracer::ParseCommand(\%optionTable, @inputList);

Legend:
Removed from v.1.110  
changed lines
  Added in v.1.111

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3