[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.79, Thu Nov 9 21:12:46 2006 UTC revision 1.88, Thu Jun 14 19:27:32 2007 UTC
# Line 186  Line 186 
186  using the L</StandardScript> or L</StandardSetup> methods, emergency tracing  using the L</StandardScript> or L</StandardSetup> methods, emergency tracing
187  will be configured automatically.  will be configured automatically.
188    
189    NOTE: to configure emergency tracing from the command line instead of the Debugging
190    Control Panel (see below), use the C<trace.pl> script.
191    
192  =head3 Debugging Control Panel  =head3 Debugging Control Panel
193    
194  The debugging control panel provides several tools to assist in development of  The debugging control panel provides several tools to assist in development of
# Line 445  Line 448 
448                            noAlias => [0, "do not expect aliases in CHANGE transactions"],                            noAlias => [0, "do not expect aliases in CHANGE transactions"],
449                            start => [' ', "start with this genome"],                            start => [' ', "start with this genome"],
450                            tblFiles => [0, "output TBL files containing the corrected IDs"] },                            tblFiles => [0, "output TBL files containing the corrected IDs"] },
451                          "command transactionDirectory IDfile",                          "<command> <transactionDirectory> <IDfile>",
452                        @ARGV);                        @ARGV);
453    
454    
# Line 457  Line 460 
460    
461      TransactFeatures -trace=2 -noAlias register ../xacts IDs.tbl      TransactFeatures -trace=2 -noAlias register ../xacts IDs.tbl
462    
463    Single and double hyphens are equivalent. So, you could also code the
464    above command as
465    
466        TransactFeatures --trace=2 --noAlias register ../xacts IDs.tbl
467    
468  In this case, C<register>, C<../xacts>, and C<IDs.tbl> are the positional  In this case, C<register>, C<../xacts>, and C<IDs.tbl> are the positional
469  parameters, and would find themselves in I<@parameters> after executing the  parameters, and would find themselves in I<@parameters> after executing the
470  above code fragment. The tracing would be set to level 2, and the categories  above code fragment. The tracing would be set to level 2, and the categories
# Line 491  Line 499 
499  the tracing key is taken from the C<Tracing> environment variable. If there  the tracing key is taken from the C<Tracing> environment variable. If there
500  is no value for that variable, the tracing key will be computed from the PID.  is no value for that variable, the tracing key will be computed from the PID.
501    
502  Finally, if the special option C<-h> is specified, the option names will  Finally, if the special option C<-help> is specified, the option
503  be traced at level 0 and the program will exit without processing.  names will be traced at level 0 and the program will exit without processing.
504  This provides a limited help capability. For example, if the user enters  This provides a limited help capability. For example, if the user enters
505    
506      TransactFeatures -h      TransactFeatures -help
507    
508  he would see the following output.  he would see the following output.
509    
510      TransactFeatures [options] command transactionDirectory IDfile      TransactFeatures [options] <command> <transactionDirectory> <IDfile>
511          -trace    tracing level (default E)          -trace    tracing level (default E)
512          -sql      trace SQL commands          -sql      trace SQL commands
513          -safe     use database transactions          -safe     use database transactions
# Line 571  Line 579 
579      my $tkey = EmergencyKey();      my $tkey = EmergencyKey();
580      # Add the tracing options.      # Add the tracing options.
581      if (! exists $options->{trace}) {      if (! exists $options->{trace}) {
582          $options->{trace} = ['E', "tracing level (E for emergency tracing)"];          $options->{trace} = ['2', "tracing level (E for emergency tracing)"];
583      }      }
584      $options->{sql} = [0, "turn on SQL tracing"];      $options->{sql} = [0, "turn on SQL tracing"];
585      $options->{h} = [0, "display command-line options"];      $options->{help} = [0, "display command-line options"];
586      $options->{user} = [$tkey, "tracing key"];      $options->{user} = [$tkey, "tracing key"];
587      $options->{background} = [0, "spool standard and error output"];      $options->{background} = [0, "spool standard and error output"];
588      # Create a parsing hash from the options hash. The parsing hash      # Create a parsing hash from the options hash. The parsing hash
# Line 649  Line 657 
657      }      }
658      # 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
659      # options and exit the program.      # options and exit the program.
660      if ($retOptions->{h}) {      if ($retOptions->{help}) {
661          $0 =~ m#[/\\](\w+)(\.pl)?$#i;          $0 =~ m#[/\\](\w+)(\.pl)?$#i;
662          print "$1 [options] $parmHelp\n";          print "$1 [options] $parmHelp\n";
663          for my $key (sort keys %{$options}) {          for my $key (sort keys %{$options}) {
# Line 662  Line 670 
670          }          }
671          exit(0);          exit(0);
672      }      }
673        # Trace the options, if applicable.
674        if (T(3)) {
675            my @parms = grep { $retOptions->{$_} } keys %{$retOptions};
676            Trace("Selected options: " . join(", ", sort @parms) . ".");
677        }
678      # Return the parsed parameters.      # Return the parsed parameters.
679      return ($retOptions, @retParameters);      return ($retOptions, @retParameters);
680  }  }
# Line 1251  Line 1264 
1264              if (!$package) {              if (!$package) {
1265                  $category = "main";                  $category = "main";
1266              } else {              } else {
1267                  $category = $package;                  my @cats = split /::/, $package;
1268                    $category = $cats[$#cats];
1269              }              }
1270          }          }
1271          # Save the category name.          # Save the category name.
# Line 1281  Line 1295 
1295    
1296  C<< my ($options, @arguments) = ParseCommand({ errors => 0, logFile => 'trace.log'}, @words); >>  C<< my ($options, @arguments) = ParseCommand({ errors => 0, logFile => 'trace.log'}, @words); >>
1297    
1298  In this case, the list @words will be treated as a command line. There are two options available,  In this case, the list @words will be treated as a command line and there are two options available,
1299  B<errors> and B<logFile>. If @words has the following format  B<errors> and B<logFile>. If @words has the following format
1300    
1301  C<< -logFile=error.log apple orange rutabaga >>  C<< -logFile=error.log apple orange rutabaga >>
# Line 1295  Line 1309 
1309  C<< apple orange rutabaga >>  C<< apple orange rutabaga >>
1310    
1311  The parser allows for some escape sequences. See L</UnEscape> for a description. There is no  The parser allows for some escape sequences. See L</UnEscape> for a description. There is no
1312  support for quote characters.  support for quote characters. Options can be specified with single or double hyphens.
1313    
1314  =over 4  =over 4
1315    
# Line 1320  Line 1334 
1334      my ($optionTable, @inputList) = @_;      my ($optionTable, @inputList) = @_;
1335      # Process any options in the input list.      # Process any options in the input list.
1336      my %overrides = ();      my %overrides = ();
1337      while ((@inputList > 0) && ($inputList[0] =~ /^-/)) {      while ((@inputList > 0) && ($inputList[0] =~ /^--?/)) {
1338          # Get the current option.          # Get the current option.
1339          my $arg = shift @inputList;          my $arg = shift @inputList;
1340          # Pull out the option name.          # Pull out the option name.
1341          $arg =~ /^-([^=]*)/g;          $arg =~ /^--?([^=]*)/g;
1342          my $name = $1;          my $name = $1;
1343          # Check for an option value.          # Check for an option value.
1344          if ($arg =~ /\G=(.*)$/g) {          if ($arg =~ /\G=(.*)$/g) {
# Line 1759  Line 1773 
1773  sub Confess {  sub Confess {
1774      # Get the parameters.      # Get the parameters.
1775      my ($message) = @_;      my ($message) = @_;
1776        if (! defined($FIG_Config::no_tool_hdr)) {
1777            # Here we have a tool header. Display its length so that the user can adjust the line numbers.
1778            #
1779            # Don't try to GetFile before checking if the file exists, otherwise we
1780            # have an infinite loop. We shoudl probably look for tool_hdr in the right place
1781            # though.
1782            #
1783            if (-f "$FIG_Config::common_runtime/tool_hdr")
1784            {
1785                my @lines = GetFile("$FIG_Config::common_runtime/tool_hdr");
1786                Trace("Tool header has " . scalar(@lines) . " lines.");
1787            }
1788        }
1789      # Trace the call stack.      # Trace the call stack.
1790      Cluck($message);      Cluck($message);
1791      # Abort the program.      # Abort the program.
# Line 2104  Line 2131 
2131  C<< my ($cgi, $varHash) = ScriptSetup($noTrace); >>  C<< my ($cgi, $varHash) = ScriptSetup($noTrace); >>
2132    
2133  Perform standard tracing and debugging setup for scripts. The value returned is  Perform standard tracing and debugging setup for scripts. The value returned is
2134  the CGI object followed by a pre-built variable hash.  the CGI object followed by a pre-built variable hash. At the end of the script,
2135    the client should call L</ScriptFinish> to output the web page.
 The C<Trace> form parameter is used to determine whether or not tracing is active and  
 which trace modules (other than C<Tracer> itself) should be turned on. Specifying  
 the C<CGI> trace module will trace parameter and environment information. Parameters are  
 traced at level 3 and environment variables at level 4. To trace to a file instead of to  
 the web page, set C<TF> to 1. At the end of the script, the client should call  
 L</ScriptFinish> to output the web page.  
2136    
2137  In some situations, it is not practical to invoke tracing via form parameters. For this  This method calls L</ETracing> to configure tracing, which allows the tracing
2138  situation, you can turn on emergency tracing from the debugging control panel.  to be configured via the emergency tracing form on the debugging control panel.
2139  Tracing will then be turned on automatically for all programs that use the L</ETracing>  Tracing will then be turned on automatically for all programs that use the L</ETracing>
2140  method, which includes every program that uses this method or L</StandardSetup>.  method, which includes every program that uses this method or L</StandardSetup>.
2141    
# Line 2291  Line 2312 
2312  This method converts an emergency tracing destination to a real  This method converts an emergency tracing destination to a real
2313  tracing destination. The main difference is that if the  tracing destination. The main difference is that if the
2314  destination is C<FILE> or C<APPEND>, we convert it to file  destination is C<FILE> or C<APPEND>, we convert it to file
2315  output.  output. If the destination is C<DUAL>, we convert it to file
2316    and standard output.
2317    
2318  =over 4  =over 4
2319    
# Line 2315  Line 2337 
2337      # Get the parameters.      # Get the parameters.
2338      my ($tkey, $myDest) = @_;      my ($tkey, $myDest) = @_;
2339      # Declare the return variable.      # Declare the return variable.
2340      my $retVal;      my $retVal = $myDest;
2341      # Process according to the destination value.      # Process according to the destination value.
2342      if ($myDest eq 'FILE') {      if ($myDest eq 'FILE') {
2343          $retVal = ">" . EmergencyFileTarget($tkey);          $retVal = ">" . EmergencyFileTarget($tkey);
2344      } elsif ($myDest eq 'APPEND') {      } elsif ($myDest eq 'APPEND') {
2345          $retVal = ">>" . EmergencyFileTarget($tkey);          $retVal = ">>" . EmergencyFileTarget($tkey);
2346      } else {      } elsif ($myDest eq 'DUAL') {
2347          $retVal = $myDest;          $retVal = "+>" . EmergencyFileTarget($tkey);
2348      }      }
2349      # Return the result.      # Return the result.
2350      return $retVal;      return $retVal;
# Line 2332  Line 2354 
2354    
2355  C<< Emergency($key, $hours, $dest, $level, @modules); >>  C<< Emergency($key, $hours, $dest, $level, @modules); >>
2356    
2357  Turn on emergency tracing. This method can only be invoked over the web and is  Turn on emergency tracing. This method is normally invoked over the web from
2358  should not be called if debug mode is off. The caller specifies the duration of the  a debugging console, but it can also be called by the C<trace.pl> script.
2359  emergency in hours, the desired tracing destination, the trace level,  The caller specifies the duration of the emergency in hours, the desired tracing
2360  and a list of the trace modules to activate. For the length of the duration, when a  destination, the trace level, and a list of the trace modules to activate.
2361  program in an environment with the specified tracing key active invokes a Sprout  For the length of the duration, when a program in an environment with the
2362  CGI script, tracing will be turned on automatically. See L</TSetup> for more  specified tracing key active invokes a Sprout CGI script, tracing will be
2363  about tracing setup and L</ETracing> for more about emergency tracing.  turned on automatically. See L</TSetup> for more about tracing setup and
2364    L</ETracing> for more about emergency tracing.
2365    
2366  =over 4  =over 4
2367    
# Line 2974  Line 2997 
2997      my $line = <$handle>;      my $line = <$handle>;
2998      # Only proceed if we found something.      # Only proceed if we found something.
2999      if (defined $line) {      if (defined $line) {
3000          # Remove the new-line.          # Remove the new-line. We are a bit over-cautious here because the file may be coming in via an
3001          chomp $line;          # upload control and have a nonstandard EOL combination.
3002          Trace("Line read: $line") if T(File => 4);          $line =~ s/(\r|\n)+$//;
3003            # Here we do some fancy tracing to help in debugging complicated EOL marks.
3004            if (T(File => 4)) {
3005                my $escapedLine = $line;
3006                $escapedLine =~ s/\n/\\n/g;
3007                $escapedLine =~ s/\r/\\r/g;
3008                $escapedLine =~ s/\t/\\t/g;
3009                Trace("Line read: -->$escapedLine<--");
3010            }
3011          # If the line is empty, return a single empty string; otherwise, parse          # If the line is empty, return a single empty string; otherwise, parse
3012          # it into fields.          # it into fields.
3013          if ($line eq "") {          if ($line eq "") {
# Line 2994  Line 3025 
3025    
3026  =head3 PutLine  =head3 PutLine
3027    
3028  C<< Tracer::PutLine($handle, \@fields); >>  C<< Tracer::PutLine($handle, \@fields, $eol); >>
3029    
3030  Write a line of data to a tab-delimited file. The specified field values will be  Write a line of data to a tab-delimited file. The specified field values will be
3031  output in tab-separated form, with a trailing new-line.  output in tab-separated form, with a trailing new-line.
# Line 3009  Line 3040 
3040    
3041  List of field values.  List of field values.
3042    
3043    =item eol (optional)
3044    
3045    End-of-line character (default is "\n").
3046    
3047  =back  =back
3048    
3049  =cut  =cut
3050    
3051  sub PutLine {  sub PutLine {
3052      # Get the parameters.      # Get the parameters.
3053      my ($handle, $fields) = @_;      my ($handle, $fields, $eol) = @_;
3054      # Write the data.      # Write the data.
3055      print $handle join("\t", @{$fields}) . "\n";      print $handle join("\t", @{$fields}) . ($eol || "\n");
3056  }  }
3057    
3058  =head3 GenerateURL  =head3 GenerateURL
# Line 3154  Line 3189 
3189      return $retVal;      return $retVal;
3190  }  }
3191    
3192    
3193  1;  1;

Legend:
Removed from v.1.79  
changed lines
  Added in v.1.88

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3