[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.10, Thu Jun 9 05:36:30 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 Open);          @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 104  Line 104 
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 169  Line 170 
170          } else {          } 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  =head3 Open
193    
194  C<< my $handle = Open($fileHandle, $fileSpec, $message); >>  C<< my $handle = Open($fileHandle, $fileSpec, $message); >>
195    
196  Open a file and throw an exception if the open fails.  Open a file.
197    
198  The I<$fileSpec> is essentially the second argument of the PERL C<open>  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  function. The mode is specified using Unix-like shell information. So, for
# Line 188  Line 206 
206          Open(\*DATASTREAM, "| sort -u >$outputFile", "Could not open $outputFile.");          Open(\*DATASTREAM, "| sort -u >$outputFile", "Could not open $outputFile.");
207    
208  would open a pipe that sorts the records written and removes duplicates. Note  would open a pipe that sorts the records written and removes duplicates. Note
209  that the file handle is specified as a string. Note the use of file handle  the use of file handle syntax in the Open call. To use anonymous file handles,
210  syntax in the Open call. To use anonymous file handles, code as follows.  code as follows.
211    
212          my $logFile = Open(undef, '>>/usr/spool/news/twitlog', "Could not open twit log.");          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 to construct an error message.  The I<$message> parameter is used if the open fails. If it is set to C<0>, then
215  If the parameter is omitted, a standard message is constructed using the file spec.  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"          Could not open "/usr/spool/news/twitlog"
221    
# Line 209  Line 230 
230    
231          Could not open "/usr/spool/news/twitlog": 6.          Could not open "/usr/spool/news/twitlog": 6.
232    
 This method has no provision for passing back error information. Its purpose is  
 to simplify the standard coding practice of opening files and killing the process  
 if the open doesn't work. If the trace level for C<Tracer> is set to level 1,  
 it will automatically show a stack trace as well.  
   
233  =over 4  =over 4
234    
235  =item fileHandle  =item fileHandle
# Line 229  Line 245 
245    
246  Error message to use if the open fails. If omitted, a standard error message  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  will be generated. In either case, the error information from the file system
248  is appended to the message.  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  =item RETURN
252    
253  Returns the name of the file handle assigned to the file.  Returns the name of the file handle assigned to the file, or C<undef> if the
254    open failed.
255    
256  =back  =back
257    
# Line 248  Line 266 
266          if (! $rv) {          if (! $rv) {
267                  # Save the system error message.                  # Save the system error message.
268                  my $sysMessage = $!;                  my $sysMessage = $!;
269                    # See if we need a default message.
270                    if (!$message) {
271                  # Clean any obvious mode characters and leading spaces from the                  # Clean any obvious mode characters and leading spaces from the
272                  # filename.                  # filename.
273                  $fileSpec =~ s/^(<|>*)\s*//;                          my ($fileName) = FindNamePart($fileSpec);
274                  if (!$message) {                          $message = "Could not open \"$fileName\"";
                         $message = "Could not open \"$fileSpec\"";  
275                  }                  }
276                  # Terminate with an error using the supplied message and the                  # Terminate with an error using the supplied message and the
277                  # error message from the file system.                  # error message from the file system.
# Line 262  Line 281 
281          return $fileHandle;          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
397    
398  C<< Tracer::SetLevel($newLevel); >>  C<< Tracer::SetLevel($newLevel); >>

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3