[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.6, Mon Mar 7 02:01:51 2005 UTC revision 1.10, Thu Jun 9 05:36:30 2005 UTC
# Line 2  Line 2 
2    
3          require Exporter;          require Exporter;
4          @ISA = ('Exporter');          @ISA = ('Exporter');
5          @EXPORT = qw(Trace T TSetup QTrace Confess Cluck Min Max Assert);          @EXPORT = qw(Trace T TSetup QTrace Confess Cluck Min Max Assert Open);
6          @EXPORT_OK = qw(GetFile GetOptions Merge MergeOptions ParseCommand ParseRecord UnEscape);          @EXPORT_OK = qw(GetFile GetOptions Merge MergeOptions ParseCommand ParseRecord UnEscape Escape);
7          use strict;          use strict;
8          use Carp qw(longmess croak);          use Carp qw(longmess croak);
9          use CGI;          use CGI;
10            use FIG_Config;
11        use PageBuilder;
12    
13  =head1 Tracing and Debugging Helpers  =head1 Tracing and Debugging Helpers
14    
# Line 18  Line 20 
20  has a list of categories and a single trace level set by the B<TSetup> method. Only messages whose trace  has a list of categories and a single trace level set by the B<TSetup> method. Only messages whose trace
21  level is less than or equal to this package's trace level and whose category is activated will  level is less than or equal to this package's trace level and whose category is activated will
22  be written. Thus, a higher trace level on a message indicates that the message  be written. Thus, a higher trace level on a message indicates that the message
23  is less likely to be seen. A higher trace level passed to B<Setup> means more trace messages will  is less likely to be seen. A higher trace level passed to B<TSetup> means more trace messages will
24  appear. To generate a trace message, use the following syntax.  appear. To generate a trace message, use the following syntax.
25    
26  C<< Trace($message) if T(errors => 4); >>  C<< Trace($message) if T(errors => 4); >>
# Line 36  Line 38 
38    
39  C<< Trace($message) if T(2); >>  C<< Trace($message) if T(2); >>
40    
41  To set up tracing, you call the C</Setup> method. The method takes as input a trace level, a list  To set up tracing, you call the L</TSetup> method. The method takes as input a trace level, a list
42  of category names, and a set of options. The trace level and list of category names are  of category names, and a set of options. The trace level and list of category names are
43  specified as a space-delimited string. Thus  specified as a space-delimited string. Thus
44    
45  C<< TSetup('3 errors Sprout ERDB', 'HTML'); >>  C<< TSetup('3 errors Sprout ERDB', 'HTML'); >>
46    
47  sets the trace level to 3, activated the C<errors>, C<Sprout>, and C<ERDB> categories, and  sets the trace level to 3, activates the C<errors>, C<Sprout>, and C<ERDB> categories, and
48  specifies that messages should be output as HTML paragraphs. The idea is to make it easier to  specifies that messages should be output as HTML paragraphs. The parameters are formatted
49  input tracing configuration on a web form.  a little clumsily, but it makes them easier to input on a web form or in a query URL.
50    
51  In addition to HTML and file output for trace messages, you can specify that the trace messages  In addition to HTML and file output for trace messages, you can specify that the trace messages
52  be queued. The messages can then be retrieved by calling the L</QTrace> method. This approach  be queued. The messages can then be retrieved by calling the L</QTrace> method. This approach
# Line 59  Line 61 
61  Thus, debugging information is available and easily retrieved even when the application is  Thus, debugging information is available and easily retrieved even when the application is
62  being used out in the field.  being used out in the field.
63    
64    There is no hard and fast rule on how to use trace levels. The following is therefore only
65    a suggestion.
66    
67    =over 4
68    
69    =item 0 Error
70    
71    Message indicates an error that may lead to incorrect results or that has stopped the
72    application entirely.
73    
74    =item 1 Warning
75    
76    Message indicates something that is unexpected but that probably did not interfere
77    with program execution.
78    
79    =item 2 Notice
80    
81    Message indicates the beginning or end of a major task.
82    
83    =item 3 Information
84    
85    Message indicates a subtask. In the FIG system, a subtask generally relates to a single
86    genome. This would be a big loop that is not expected to execute more than 500 times or so.
87    
88    =item 4 Detail
89    
90    Message indicates a low-level loop iteration.
91    
92    =back
93    
94  =cut  =cut
95    
96  # Declare the configuration variables.  # Declare the configuration variables.
97    
98  my $Destination = "NONE";       # Description of where to send the trace output.  my $Destination = "NONE";       # Description of where to send the trace output.
99    my $TeeFlag = 0;                        # TRUE if output is going to a file and to the
100                                                            # standard output
101  my %Categories = ( main => 1 );  my %Categories = ( main => 1 );
102                                                          # hash of active category names                                                          # hash of active category names
103  my $TraceLevel = 0;                     # trace level; a higher trace level produces more  my $TraceLevel = 0;                     # trace level; a higher trace level produces more
104                                                          # messages                                                          # messages
105  my @Queue = ();                         # queued list of trace messages.  my @Queue = ();                         # queued list of trace messages.
106    my $LastCategory = "main";  # name of the last category interrogated
107    
108  =head2 Public Methods  =head2 Public Methods
109    
# Line 90  Line 125 
125    
126  The destination for the trace output. To send the trace output to a file, specify the file  The destination for the trace output. To send the trace output to a file, specify the file
127  name preceded by a ">" symbol. If a double symbol is used (">>"), then the data is appended  name preceded by a ">" symbol. If a double symbol is used (">>"), then the data is appended
128  to the file. Otherwise the file is cleared before tracing begins. In addition to sending  to the file. Otherwise the file is cleared before tracing begins. Precede the first ">"
129  the trace messages to a file, you can specify a special destination. C<HTML> will cause  symbol with a C<+> to echo output to a file AND to the standard output. In addition to
130  tracing to the standard output with each line formatted as an HTML paragraph. C<TEXT>  sending the trace messages to a file, you can specify a special destination. C<HTML> will
131    cause tracing to the standard output with each line formatted as an HTML paragraph. C<TEXT>
132  will cause tracing to the standard output as ordinary text. C<ERROR> will cause trace  will cause tracing to the standard output as ordinary text. C<ERROR> will cause trace
133  messages to be sent to the standard error output as ordinary text. C<QUEUE> will cause trace  messages to be sent to the standard error output as ordinary text. C<QUEUE> will cause trace
134  messages to be stored in a queue for later retrieval by the L</QTrace> method. C<WARN> will  messages to be stored in a queue for later retrieval by the L</QTrace> method. C<WARN> will
# Line 115  Line 151 
151                  $Categories{$category} = 1;                  $Categories{$category} = 1;
152          }          }
153          # Now we need to process the destination information. The most important special          # Now we need to process the destination information. The most important special
154          # case is the single ">", which requires we clear the file first. After doing          # cases are the single ">", which requires we clear the file first, and the
155          # so, we tack on another ">" sign so that future trace messages are appended.          # "+" prefix which indicates a double echo.
156            if ($target =~ m/^\+?>>?/) {
157                    if ($target =~ m/^\+/) {
158                            $TeeFlag = 1;
159                            $target = substr($target, 1);
160                    }
161          if ($target =~ m/^>[^>]/) {          if ($target =~ m/^>[^>]/) {
162                  open TRACEFILE, $target;                  open TRACEFILE, $target;
163                  print TRACEFILE Now() . " Tracing initialized.\n";                  print TRACEFILE Now() . " Tracing initialized.\n";
164                  close TRACEFILE;                  close TRACEFILE;
165                  $Destination = ">$target";                  $Destination = ">$target";
166          } else {          } else {
167                            $Destination = $target;
168                    }
169            } else {
170                  $Destination = uc($target);                  $Destination = uc($target);
171          }          }
172  }  }
173    
174    =head3 Open
175    
176    C<< my $handle = Open($fileHandle, $fileSpec, $message); >>
177    
178    Open a file and throw an exception if the open fails.
179    
180    The I<$fileSpec> is essentially the second argument of the PERL C<open>
181    function. The mode is specified using Unix-like shell information. So, for
182    example,
183    
184            Open(\*LOGFILE, '>>/usr/spool/news/twitlog', "Could not open twit log.");
185    
186    would open for output appended to the specified file, and
187    
188            Open(\*DATASTREAM, "| sort -u >$outputFile", "Could not open $outputFile.");
189    
190    would open a pipe that sorts the records written and removes duplicates. Note
191    that the file handle is specified as a string. Note the use of file handle
192    syntax in the Open call. To use anonymous file handles, code as follows.
193    
194            my $logFile = Open(undef, '>>/usr/spool/news/twitlog', "Could not open twit log.");
195    
196    The I<$message> parameter is used if the open fails to construct an error message.
197    If the parameter is omitted, a standard message is constructed using the file spec.
198    
199            Could not open "/usr/spool/news/twitlog"
200    
201    Note that the mode characters are automatically cleaned from the file name.
202    The actual error message from the file system will be captured and appended to the
203    message in any case.
204    
205            Could not open "/usr/spool/news/twitlog": file not found.
206    
207    In some versions of PERL the only error message we get is a number, which
208    corresponds to the C++ C<errno> value.
209    
210            Could not open "/usr/spool/news/twitlog": 6.
211    
212    This method has no provision for passing back error information. Its purpose is
213    to simplify the standard coding practice of opening files and killing the process
214    if the open doesn't work. If the trace level for C<Tracer> is set to level 1,
215    it will automatically show a stack trace as well.
216    
217    =over 4
218    
219    =item fileHandle
220    
221    File handle. If this parameter is C<undef>, a file handle will be generated
222    and returned as the value of this method.
223    
224    =item fileSpec
225    
226    File name and mode, as per the PERL C<open> function.
227    
228    =item message (optional)
229    
230    Error message to use if the open fails. If omitted, a standard error message
231    will be generated. In either case, the error information from the file system
232    is appended to the message.
233    
234    =item RETURN
235    
236    Returns the name of the file handle assigned to the file.
237    
238    =back
239    
240    =cut
241    
242    sub Open {
243            # Get the parameters.
244            my ($fileHandle, $fileSpec, $message) = @_;
245            # Attempt to open the file.
246            my $rv = open $fileHandle, $fileSpec;
247            # If the open failed, generate an error message.
248            if (! $rv) {
249                    # Save the system error message.
250                    my $sysMessage = $!;
251                    # Clean any obvious mode characters and leading spaces from the
252                    # filename.
253                    $fileSpec =~ s/^(<|>*)\s*//;
254                    if (!$message) {
255                            $message = "Could not open \"$fileSpec\"";
256                    }
257                    # Terminate with an error using the supplied message and the
258                    # error message from the file system.
259                    Confess("$message: $!");
260            }
261            # Return the file handle.
262            return $fileHandle;
263    }
264    
265  =head3 SetLevel  =head3 SetLevel
266    
267  C<< Tracer::SetLevel($newLevel); >>  C<< Tracer::SetLevel($newLevel); >>
# Line 370  Line 505 
505          my ($message) = @_;          my ($message) = @_;
506          # Get the timestamp.          # Get the timestamp.
507          my $timeStamp = Now();          my $timeStamp = Now();
508          # Format the message.          # Format the message. Note we strip off any line terminators at the end.
509          my $formatted = "$timeStamp $message";          my $formatted = "$timeStamp <$LastCategory>: " . Strip($message);
510          # Process according to the destination.          # Process according to the destination.
511          if ($Destination eq "TEXT") {          if ($Destination eq "TEXT") {
512                  # Write the message to the standard output.                  # Write the message to the standard output.
# Line 394  Line 529 
529                  open TRACING, $Destination;                  open TRACING, $Destination;
530                  print TRACING "$formatted\n";                  print TRACING "$formatted\n";
531                  close TRACING;                  close TRACING;
532                    # If the Tee flag is on, echo it to the standard output.
533                    if ($TeeFlag) {
534                            print "$formatted\n";
535                    }
536          }          }
537  }  }
538    
# Line 445  Line 584 
584                                  $category = $package;                                  $category = $package;
585                          }                          }
586                  }                  }
587                  # Use the package and tracelevel to compute the result.          # Save the category name.
588            $LastCategory = $category;
589                    # Use the category and tracelevel to compute the result.
590                  $retVal = ($traceLevel <= $TraceLevel && exists $Categories{$category});                  $retVal = ($traceLevel <= $TraceLevel && exists $Categories{$category});
591      }      }
592          # Return the computed result.          # Return the computed result.
# Line 528  Line 669 
669          return ($optionTable, @retVal);          return ($optionTable, @retVal);
670  }  }
671    
672    =head3 Escape
673    
674    C<< my $codedString = Tracer::Escape($realString); >>
675    
676    Escape a string for use in a command length. Spaces will be replaced by C<\b>,
677    tabs replaced by C<\t>, new-lines replaced by C<\n>, and backslashes will be
678    doubled. The effect is to exactly reverse the effect of L</UnEscape>.
679    
680    =over 4
681    
682    =item realString
683    
684    String to escape.
685    
686    =item RETURN
687    
688    Escaped equivalent of the real string.
689    
690    =back
691    
692    =cut
693    
694    sub Escape {
695            # Get the parameter.
696            my ($realString) = @_;
697            # Initialize the return variable.
698            my $retVal = "";
699            # Loop through the parameter string, looking for sequences to escape.
700            while (length $realString > 0) {
701                    # Look for the first sequence to escape.
702                    if ($realString =~ /^(.*?)([ \n\t\\])/) {
703                            # Here we found it. The text preceding the sequence is in $1. The sequence
704                            # itself is in $2. First, move the clear text to the return variable.
705                            $retVal .= $1;
706                            $realString = substr $realString, (length $2 + length $1);
707                            # Encode the escape sequence.
708                            my $char = $2;
709                            $char =~ tr/ \t\n/btn/;
710                            $retVal .= "\\" . $char;
711                    } else {
712                            # Here there are no more escape sequences. The rest of the string is
713                            # transferred unmodified.
714                            $retVal .= $realString;
715                            $realString = "";
716                    }
717            }
718            # Return the result.
719            return $retVal;
720    }
721    
722  =head3 UnEscape  =head3 UnEscape
723    
724  C<< my $realString = Tracer::UnEscape($codedString); >>  C<< my $realString = Tracer::UnEscape($codedString); >>
# Line 555  Line 746 
746          my ($codedString) = @_;          my ($codedString) = @_;
747          # Initialize the return variable.          # Initialize the return variable.
748          my $retVal = "";          my $retVal = "";
749            # Only proceed if the incoming string is nonempty.
750            if (defined $codedString) {
751          # Loop through the parameter string, looking for escape sequences. We can't do          # Loop through the parameter string, looking for escape sequences. We can't do
752          # translating because it causes problems with the escaped slash. ("\\b" becomes          # translating because it causes problems with the escaped slash. ("\\b" becomes
753          # "\ " no matter what we do.)          # "\ " no matter what we do.)
# Line 576  Line 769 
769                          $codedString = "";                          $codedString = "";
770                  }                  }
771          }          }
772            }
773          # Return the result.          # Return the result.
774          return $retVal;          return $retVal;
775  }  }
# Line 705  Line 899 
899                  # If we had an error, trace it. We will automatically return a null value.                  # If we had an error, trace it. We will automatically return a null value.
900                  Trace("Could not open \"$fileName\" for input.") if T(0);                  Trace("Could not open \"$fileName\" for input.") if T(0);
901          } else {          } else {
902                  # Read the whole file into the return variable, stripping off an terminator                  # Read the whole file into the return variable, stripping off any terminator
903          # characters.          # characters.
904          my $lineCount = 0;          my $lineCount = 0;
905                  while (my $line = <INPUTFILE>) {                  while (my $line = <INPUTFILE>) {
906              $lineCount++;              $lineCount++;
907              $line =~ s/(\r|\n)+$//g;              $line = Strip($line);
908                          push @retVal, $line;                          push @retVal, $line;
909                  }                  }
910                  # Close it.                  # Close it.
911                  close INPUTFILE;                  close INPUTFILE;
912          my $actualLines = @retVal;          my $actualLines = @retVal;
         Trace("$lineCount lines read from $fileName. $actualLines processed.") if T(0);  
913          }          }
914          # Return the file's contents in the desired format.          # Return the file's contents in the desired format.
915      if (wantarray) {      if (wantarray) {
# Line 958  Line 1151 
1151      }      }
1152  }  }
1153    
1154    =head3 DebugMode
1155    
1156    C<< if (Tracer::DebugMode) { ...code... } >>
1157    
1158    Return TRUE if debug mode has been turned on in FIG_Config, else output
1159    an error page and return FALSE.
1160    
1161    Certain CGI scripts are too dangerous to exist in the production
1162    environment. This method provides a simple way to prevent them
1163    from working unless they are explicitly turned on in the configuration
1164    file by setting C<$FIG_Config::debug_mode> to 1. If debugging mode
1165    is not turned on, an error web page will be output.
1166    
1167    =cut
1168    
1169    sub DebugMode {
1170            # Declare the return variable.
1171            my $retVal;
1172            # Check the debug configuration.
1173            if ($FIG_Config::debug_mode) {
1174                    $retVal = 1;
1175            } else {
1176                    # Here debug mode is off, so we generate an error page.
1177            my $pageString = PageBuilder::Build("<Html/ErrorPage.html", {}, "Html");
1178                    print $pageString;
1179            }
1180            # Return the determination indicator.
1181            return $retVal;
1182    }
1183    
1184    =head3 Strip
1185    
1186    C<< my $string = Tracer::Strip($line); >>
1187    
1188    Strip all line terminators off a string. This is necessary when dealing with files
1189    that may have been transferred back and forth several times among different
1190    operating environments.
1191    
1192    =over 4
1193    
1194    =item line
1195    
1196    Line of text to be stripped.
1197    
1198    =item RETURN
1199    
1200    The same line of text with all the line-ending characters chopped from the end.
1201    
1202    =back
1203    
1204    =cut
1205    
1206    sub Strip {
1207            # Get a copy of the parameter string.
1208            my ($string) = @_;
1209            my $retVal = $string;
1210        # Strip the line terminator characters.
1211        $retVal =~ s/(\r|\n)+$//g;
1212            # Return the result.
1213            return $retVal;
1214    }
1215    
1216    =head3 Pad
1217    
1218    C<< my $paddedString = Tracer::Pad($string, $len, $left, $padChar); >>
1219    
1220    Pad a string to a specified length. The pad character will be a
1221    space, and the padding will be on the right side unless specified
1222    in the third parameter.
1223    
1224    =over 4
1225    
1226    =item string
1227    
1228    String to be padded.
1229    
1230    =item len
1231    
1232    Desired length of the padded string.
1233    
1234    =item left (optional)
1235    
1236    TRUE if the string is to be left-padded; otherwise it will be padded on the right.
1237    
1238    =item padChar (optional)
1239    
1240    =item RETURN
1241    
1242    Returns a copy of the original string with the spaces added to the specified end so
1243    that it achieves the desired length.
1244    
1245    =back
1246    
1247    =cut
1248    
1249    sub Pad {
1250            # Get the parameters.
1251            my ($string, $len, $left, $padChar) = @_;
1252            # Compute the padding character.
1253            if (! defined $padChar) {
1254                    $padChar = " ";
1255            }
1256            # Compute the number of spaces needed.
1257            my $needed = $len - length $string;
1258            # Copy the string into the return variable.
1259            my $retVal = $string;
1260            # Only proceed if padding is needed.
1261            if ($needed > 0) {
1262                    # Create the pad string.
1263                    my $pad = $padChar x $needed;
1264                    # Affix it to the return value.
1265                    if ($left) {
1266                            $retVal = $pad . $retVal;
1267                    } else {
1268                            $retVal .= $pad;
1269                    }
1270            }
1271            # Return the result.
1272            return $retVal;
1273    }
1274    
1275  1;  1;

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.10

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3