[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.9, Wed May 4 03:05:12 2005 UTC revision 1.11, Mon Jun 13 09:34:52 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 OpenDir);
6          @EXPORT_OK = qw(GetFile GetOptions Merge MergeOptions ParseCommand ParseRecord UnEscape Escape);          @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);
# Line 20  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 38  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    
# Line 46  Line 46 
46    
47  sets the trace level to 3, activates 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 parameters are formatted  specifies that messages should be output as HTML paragraphs. The parameters are formatted
49  to make it easier to 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 61  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  my $LastCategory = "main";  # name of the last category interrogated
107    my $SetupCount = 0;         # number of times TSetup called
108    
109  =head2 Public Methods  =head2 Public Methods
110    
# Line 93  Line 126 
126    
127  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
128  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
129  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 ">"
130  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
131  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
132    cause tracing to the standard output with each line formatted as an HTML paragraph. C<TEXT>
133  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
134  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
135  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 118  Line 152 
152                  $Categories{$category} = 1;                  $Categories{$category} = 1;
153          }          }
154          # Now we need to process the destination information. The most important special          # Now we need to process the destination information. The most important special
155          # 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
156          # so, we tack on another ">" sign so that future trace messages are appended.          # "+" prefix which indicates a double echo.
157            if ($target =~ m/^\+?>>?/) {
158                    if ($target =~ m/^\+/) {
159                            $TeeFlag = 1;
160                            $target = substr($target, 1);
161                    }
162          if ($target =~ m/^>[^>]/) {          if ($target =~ m/^>[^>]/) {
163                  open TRACEFILE, $target;                  open TRACEFILE, $target;
164                  print TRACEFILE Now() . " Tracing initialized.\n";                  print TRACEFILE Now() . " Tracing initialized.\n";
165                  close TRACEFILE;                  close TRACEFILE;
166                  $Destination = ">$target";                  $Destination = ">$target";
167          } else {          } else {
168                            $Destination = $target;
169                    }
170            } else {
171                  $Destination = uc($target);                  $Destination = uc($target);
172          }          }
173            # Increment the setup counter.
174            $SetupCount++;
175    }
176    
177    =head3 Setups
178    
179    C<< my $count = Tracer::Setups(); >>
180    
181    Return the number of times L</TSetup> has been called.
182    
183    This method allows for the creation of conditional tracing setups where, for example, we
184    may want to set up tracing if nobody else has done it before us.
185    
186    =cut
187    
188    sub Setups {
189            return $SetupCount;
190    }
191    
192    =head3 Open
193    
194    C<< my $handle = Open($fileHandle, $fileSpec, $message); >>
195    
196    Open a file.
197    
198    The I<$fileSpec> is essentially the second argument of the PERL C<open>
199    function. The mode is specified using Unix-like shell information. So, for
200    example,
201    
202            Open(\*LOGFILE, '>>/usr/spool/news/twitlog', "Could not open twit log.");
203    
204    would open for output appended to the specified file, and
205    
206            Open(\*DATASTREAM, "| sort -u >$outputFile", "Could not open $outputFile.");
207    
208    would open a pipe that sorts the records written and removes duplicates. Note
209    the use of file handle syntax in the Open call. To use anonymous file handles,
210    code as follows.
211    
212            my $logFile = Open(undef, '>>/usr/spool/news/twitlog', "Could not open twit log.");
213    
214    The I<$message> parameter is used if the open fails. If it is set to C<0>, then
215    the open returns TRUE if successful and FALSE if an error occurred. Otherwise, a
216    failed open will throw an exception and the third parameter will be used to construct
217    an error message. If the parameter is omitted, a standard message is constructed
218    using the file spec.
219    
220            Could not open "/usr/spool/news/twitlog"
221    
222    Note that the mode characters are automatically cleaned from the file name.
223    The actual error message from the file system will be captured and appended to the
224    message in any case.
225    
226            Could not open "/usr/spool/news/twitlog": file not found.
227    
228    In some versions of PERL the only error message we get is a number, which
229    corresponds to the C++ C<errno> value.
230    
231            Could not open "/usr/spool/news/twitlog": 6.
232    
233    =over 4
234    
235    =item fileHandle
236    
237    File handle. If this parameter is C<undef>, a file handle will be generated
238    and returned as the value of this method.
239    
240    =item fileSpec
241    
242    File name and mode, as per the PERL C<open> function.
243    
244    =item message (optional)
245    
246    Error message to use if the open fails. If omitted, a standard error message
247    will be generated. In either case, the error information from the file system
248    is appended to the message. To specify a conditional open that does not throw
249    an error if it fails, use C<0>.
250    
251    =item RETURN
252    
253    Returns the name of the file handle assigned to the file, or C<undef> if the
254    open failed.
255    
256    =back
257    
258    =cut
259    
260    sub Open {
261            # Get the parameters.
262            my ($fileHandle, $fileSpec, $message) = @_;
263            # Attempt to open the file.
264            my $rv = open $fileHandle, $fileSpec;
265            # If the open failed, generate an error message.
266            if (! $rv) {
267                    # Save the system error message.
268                    my $sysMessage = $!;
269                    # See if we need a default message.
270                    if (!$message) {
271                            # Clean any obvious mode characters and leading spaces from the
272                            # filename.
273                            my ($fileName) = FindNamePart($fileSpec);
274                            $message = "Could not open \"$fileName\"";
275                    }
276                    # Terminate with an error using the supplied message and the
277                    # error message from the file system.
278                    Confess("$message: $!");
279            }
280            # Return the file handle.
281            return $fileHandle;
282    }
283    
284    =head3 FindNamePart
285    
286    C<< my ($fileName, $start, $len) = Tracer::FindNamePart($fileSpec); >>
287    
288    Extract the portion of a file specification that contains the file name.
289    
290    A file specification is the string passed to an C<open> call. It specifies the file
291    mode and name. In a truly complex situation, it can specify a pipe sequence. This
292    method assumes that the file name is whatever follows the first angle bracket
293    sequence.  So, for example, in the following strings the file name is
294    C</usr/fig/myfile.txt>.
295    
296        >>/usr/fig/myfile.txt
297        </usr/fig/myfile.txt
298        | sort -u > /usr/fig/myfile.txt
299    
300    If the method cannot find a file name using its normal methods, it will return the
301    whole incoming string.
302    
303    =over 4
304    
305    =item fileSpec
306    
307    File specification string from which the file name is to be extracted.
308    
309    =item RETURN
310    
311    Returns a three-element list. The first element contains the file name portion of
312    the specified string, or the whole string if a file name cannot be found via normal
313    methods. The second element contains the start position of the file name portion and
314    the third element contains the length.
315    
316    =back
317    
318    =cut
319    #: Return Type $;
320    sub FindNamePart {
321        # Get the parameters.
322        my ($fileSpec) = @_;
323            # Default to the whole input string.
324            my ($retVal, $pos, $len) = ($fileSpec, 0, length $fileSpec);
325        # Parse out the file name if we can.
326            if ($fileSpec =~ m/(<|>>?)(.+?)(\s*)$/) {
327                    $retVal = $2;
328                    $len = length $retVal;
329                    $pos = (length $fileSpec) - (length $3) - $len;
330            }
331        # Return the result.
332        return ($retVal, $pos, $len);
333    }
334    
335    =head3 OpenDir
336    
337    C<< my @files = OpenDir($dirName, $filtered); >>
338    
339    Open a directory and return all the file names. This function essentially performs
340    the functions of an C<opendir> and C<readdir>. If the I<$filtered> parameter is
341    set to TRUE, all filenames beginning with a period (C<.>) will be filtered out of
342    the return list. If the directory does not open, an exception is thrown. So,
343    for example,
344    
345            my @files = OpenDir("/Volumes/fig/contigs", 1);
346    
347    is effectively the same as
348    
349            opendir(TMP, "/Volumes/fig/contigs") || Confess("Could not open /Volumes/fig/contigs.");
350            my @files = grep { $_ !~ /^\./ } readdir(TMP);
351    
352    Similarly, the following code
353    
354            my @files = grep { $_ =~ /^\d/ } OpenDir("/Volumes/fig/orgs");
355    
356    Returns the names of all files in C</Volumes/fig/orgs> that begin with digits and
357    automatically throws an error if the directory fails to open.
358    
359    =over 4
360    
361    =item dirName
362    
363    Name of the directory to open.
364    
365    =item filtered
366    
367    TRUE if files whose names begin with a period (C<.>) should be automatically removed
368    from the list, else FALSE.
369    
370    =back
371    
372    =cut
373    #: Return Type @;
374    sub OpenDir {
375        # Get the parameters.
376        my ($dirName, $filtered) = @_;
377        # Declare the return variable.
378        my @retVal;
379            # Open the directory.
380            if (opendir(my $dirHandle, $dirName)) {
381                    # The directory opened successfully. Get the appropriate list according to the
382                    # strictures of the filter parameter.
383                    if ($filtered) {
384                            @retVal = grep { $_ !~ /^\./ } readdir $dirHandle;
385                    } else {
386                            @retVal = readdir $dirHandle;
387                    }
388            } else {
389                    # Here the directory would not open.
390                    Confess("Could not open directory $dirName.");
391            }
392        # Return the result.
393        return @retVal;
394  }  }
395    
396  =head3 SetLevel  =head3 SetLevel
# Line 397  Line 660 
660                  open TRACING, $Destination;                  open TRACING, $Destination;
661                  print TRACING "$formatted\n";                  print TRACING "$formatted\n";
662                  close TRACING;                  close TRACING;
663                    # If the Tee flag is on, echo it to the standard output.
664                    if ($TeeFlag) {
665                            print "$formatted\n";
666                    }
667          }          }
668  }  }
669    
# Line 774  Line 1041 
1041                  # Close it.                  # Close it.
1042                  close INPUTFILE;                  close INPUTFILE;
1043          my $actualLines = @retVal;          my $actualLines = @retVal;
         Trace("$lineCount lines read from $fileName. $actualLines processed.") if T(3);  
1044          }          }
1045          # Return the file's contents in the desired format.          # Return the file's contents in the desired format.
1046      if (wantarray) {      if (wantarray) {

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.11

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3