[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.31, Thu Jan 5 21:41:14 2006 UTC revision 1.39, Fri Feb 24 19:45:29 2006 UTC
# Line 19  Line 19 
19    
20      require Exporter;      require Exporter;
21      @ISA = ('Exporter');      @ISA = ('Exporter');
22      @EXPORT = qw(Trace T TSetup QTrace Confess Cluck Min Max Assert Open OpenDir TICK StandardSetup);      @EXPORT = qw(Trace T TSetup QTrace Confess Cluck Min Max Assert Open OpenDir TICK StandardSetup ScriptSetup ScriptFinish Insure);
23      @EXPORT_OK = qw(GetFile GetOptions Merge MergeOptions ParseCommand ParseRecord UnEscape Escape);      @EXPORT_OK = qw(GetFile GetOptions Merge MergeOptions ParseCommand ParseRecord UnEscape Escape);
24      use strict;      use strict;
25      use Carp qw(longmess croak);      use Carp qw(longmess croak);
# Line 27  Line 27 
27      use FIG_Config;      use FIG_Config;
28      use PageBuilder;      use PageBuilder;
29      use Digest::MD5;      use Digest::MD5;
30        use File::Basename;
31        use File::Path;
32    
33  =head1 Tracing and Debugging Helpers  =head1 Tracing and Debugging Helpers
34    
# Line 89  Line 91 
91    
92  =over 4  =over 4
93    
94  =item 0 Error  =item Error 0
95    
96  Message indicates an error that may lead to incorrect results or that has stopped the  Message indicates an error that may lead to incorrect results or that has stopped the
97  application entirely.  application entirely.
98    
99  =item 1 Warning  =item Warning 1
100    
101  Message indicates something that is unexpected but that probably did not interfere  Message indicates something that is unexpected but that probably did not interfere
102  with program execution.  with program execution.
103    
104  =item 2 Notice  =item Notice 2
105    
106  Message indicates the beginning or end of a major task.  Message indicates the beginning or end of a major task.
107    
108  =item 3 Information  =item Information 3
109    
110  Message indicates a subtask. In the FIG system, a subtask generally relates to a single  Message indicates a subtask. In the FIG system, a subtask generally relates to a single
111  genome. This would be a big loop that is not expected to execute more than 500 times or so.  genome. This would be a big loop that is not expected to execute more than 500 times or so.
112    
113  =item 4 Detail  =item Detail 4
114    
115  Message indicates a low-level loop iteration.  Message indicates a low-level loop iteration.
116    
# Line 174  Line 176 
176      # Presume category-based tracing until we learn otherwise.      # Presume category-based tracing until we learn otherwise.
177      $AllTrace = 0;      $AllTrace = 0;
178      # Build the category hash. Note that if we find a "*", we turn on non-category      # Build the category hash. Note that if we find a "*", we turn on non-category
179      # tracing.      # tracing. We must also clear away any pre-existing data.
180        %Categories = ( main => 1 );
181      for my $category (@categoryData) {      for my $category (@categoryData) {
182          if ($category eq '*') {          if ($category eq '*') {
183              $AllTrace = 1;              $AllTrace = 1;
# Line 207  Line 210 
210    
211  =head3 StandardSetup  =head3 StandardSetup
212    
213  C<< my ($options, @parameters) = StandardSetup(\@categories, \%options, @ARGV); >>  C<< my ($options, @parameters) = StandardSetup(\@categories, \%options, $parmHelp, @ARGV); >>
214    
215  This method performs standard command-line parsing and tracing setup. The return  This method performs standard command-line parsing and tracing setup. The return
216  values are a hash of the command-line options and a list of the positional  values are a hash of the command-line options and a list of the positional
# Line 254  Line 257 
257      TransactFeatures -trace=3 -sql register ../xacts IDs.tbl      TransactFeatures -trace=3 -sql register ../xacts IDs.tbl
258    
259  Standard tracing is output to the standard output and echoed to the file  Standard tracing is output to the standard output and echoed to the file
260  C<trace.log> in the FIG temporary directory.  C<trace>I<$$>C<.log> in the FIG temporary directory, where I<$$> is the
261    process ID. You can also specify the C<user> parameter to put a user ID
262    instead of a process ID in the trace file name. So, for example
263    
264  The default trace level is 3. This dumps out all SQL commands if SQL tracing  The default trace level is 2. To get all messages, specify a trace level of 4.
265  is turned on and tends to produce one flurry of messages per genome. To get all  For a genome-by-genome update, use 3.
266  messages, specify a trace level of 4. For generally quiet output, use 2.  
267        TransactFeatures -trace=3 -sql -user=Bruce register ../xacts IDs.tbl
268    
269    would send the trace output to C<traceBruce.log> in the temporary directory.
270    
271  The I<options> parameter is a reference to a hash containing the command-line  The I<options> parameter is a reference to a hash containing the command-line
272  options and their default values. Command-line options may be in the form of switches  options, their default values, and an explanation of what they mean. Command-line
273  or keywords. In the case of a switch, the option value is 1 if it is specified and  options may be in the form of switches or keywords. In the case of a switch, the
274  0 if it is not specified. In the case of a keyword, the value is separated from the  option value is 1 if it is specified and 0 if it is not specified. In the case
275  option name by an equal sign. You can see this last in the command-line example above.  of a keyword, the value is separated from the option name by an equal sign. You
276    can see this last in the command-line example above.
277    
278  An example at this point would help. Consider, for example, the command-line utility  An example at this point would help. Consider, for example, the command-line utility
279  C<TransactFeatures>. It accepts a list of positional parameters plus the options  C<TransactFeatures>. It accepts a list of positional parameters plus the options
# Line 272  Line 281 
281  the following code.  the following code.
282    
283      my ($options, @parameters) = Tracer::StandardSetup(["DocUtils"],      my ($options, @parameters) = Tracer::StandardSetup(["DocUtils"],
284                                                        { trace => 3, sql => 0,                          { safe => [0, "use database transactions"],
285                                                          safe => 0, noAlias => 0,                            noAlias => [0, "do not expect aliases in CHANGE transactions"],
286                                                          start => ' ', tblFiles => 0},                            start => [' ', "start with this genome"],
287                              tblFiles => [0, "output TBL files containing the corrected IDs"] },
288                            "command transactionDirectory IDfile",
289                                                      @ARGV);                                                      @ARGV);
290    
291    
# Line 303  Line 314 
314  need to be added in the future, they can be processed by this method without  need to be added in the future, they can be processed by this method without
315  upsetting the command-line utilities.  upsetting the command-line utilities.
316    
317    Finally, if the special option C<-h> is specified, the option names will
318    be traced at level 0 and the program will exit without processing.
319    This provides a limited help capability. For example, if the user enters
320    
321        TransactFeatures -h
322    
323    he would see the following output.
324    
325        TransactFeatures [options] command transactionDirectory IDfile
326            -trace    tracing level (default 2)
327            -sql      trace SQL commands
328            -safe     use database transactions
329            -noAlias  do not expect aliases in CHANGE transactions
330            -start    start with this genome
331            -tblFiles output TBL files containing the corrected IDs
332    
333  The parameters to this method are as follows.  The parameters to this method are as follows.
334    
335  =over 4  =over 4
# Line 316  Line 343 
343  =item options  =item options
344    
345  Reference to a hash containing the legal options for the current command mapped  Reference to a hash containing the legal options for the current command mapped
346  to their default values. The use can override the defaults by specifying the  to their default values and descriptions. The user can override the defaults
347  options as command-line switches prefixed by a hyphen. Tracing-related options  by specifying the options as command-line switches prefixed by a hyphen.
348  may be added to this hash.  Tracing-related options may be added to this hash. If the C<-h> option is
349    specified on the command line, the option descriptions will be used to
350    explain the options.
351    
352    =item parmHelp
353    
354    A string that vaguely describes the positional parameters. This is used
355    if the user specifies the C<-h> option.
356    
357  =item ARGV  =item ARGV
358    
# Line 338  Line 372 
372    
373  sub StandardSetup {  sub StandardSetup {
374      # Get the parameters.      # Get the parameters.
375      my ($categories, $options, @argv) = @_;      my ($categories, $options, $parmHelp, @argv) = @_;
376      # Add the tracing options.      # Add the tracing options.
377      $options->{trace} = 3;      $options->{trace} = [2, "tracing level"];
378      $options->{sql} = 0;      $options->{sql} = [0, "turn on SQL tracing"];
379        $options->{h} = [0, "display command-line options"];
380        $options->{user} = [$$, "trace log file name suffix"];
381        # Create a parsing hash from the options hash. The parsing hash
382        # contains the default values rather than the default value
383        # and the description. While we're at it, we'll memorize the
384        # length of the longest option name.
385        my $longestName = 0;
386        my %parseOptions = ();
387        for my $key (keys %{$options}) {
388            if (length $key > $longestName) {
389                $longestName = length $key;
390            }
391            $parseOptions{$key} = $options->{$key}->[0];
392        }
393      # Parse the command line.      # Parse the command line.
394      my ($retOptions, @retParameters) = ParseCommand($options, @argv);      my ($retOptions, @retParameters) = ParseCommand(\%parseOptions, @argv);
395      # Now we want to set up tracing. First, we need to know if SQL is to      # Now we want to set up tracing. First, we need to know if SQL is to
396      # be traced.      # be traced.
397      my @cats = @{$categories};      my @cats = @{$categories};
# Line 354  Line 402 
402      push @cats, "Tracer", "FIG";      push @cats, "Tracer", "FIG";
403      # Next, we create the category string by prefixing the trace level      # Next, we create the category string by prefixing the trace level
404      # and joining the categories.      # and joining the categories.
405      my $cats = join(" ", $options->{trace}, @cats);      my $cats = join(" ", $parseOptions{trace}, @cats);
406      # Now set up the tracing.      # Now set up the tracing.
407      TSetup($cats, "+>$FIG_Config::temp/trace.log");      my $suffix = $retOptions->{user};
408        TSetup($cats, "+>$FIG_Config::temp/trace$suffix.log");
409        # Check for the "h" option. If it is specified, dump the command-line
410        # options and exit the program.
411        if ($retOptions->{h}) {
412            $0 =~ m#[/\\](\w+)(\.pl)?$#i;
413            Trace("$1 [options] $parmHelp") if T(0);
414            for my $key (sort keys %{$options}) {
415                my $name = Pad($key, $longestName, 0, ' ');
416                my $desc = $options->{$key}->[1];
417                if ($options->{$key}->[0]) {
418                    $desc .= " (default " . $options->{$key}->[0] . ")";
419                }
420                Trace("  $name $desc") if T(0);
421            }
422            exit(0);
423        }
424      # Return the parsed parameters.      # Return the parsed parameters.
425      return ($retOptions, @retParameters);      return ($retOptions, @retParameters);
426  }  }
# Line 526  Line 590 
590  Open a directory and return all the file names. This function essentially performs  Open a directory and return all the file names. This function essentially performs
591  the functions of an C<opendir> and C<readdir>. If the I<$filtered> parameter is  the functions of an C<opendir> and C<readdir>. If the I<$filtered> parameter is
592  set to TRUE, all filenames beginning with a period (C<.>), dollar sign (C<$>),  set to TRUE, all filenames beginning with a period (C<.>), dollar sign (C<$>),
593  or pound sign (C<#>) will be filtered out of the return list. If the directory  or pound sign (C<#>) and all filenames ending with a tilde C<~>) will be
594  does not open and I<$flag> is not set, an exception is thrown. So,  filtered out of the return list. If the directory does not open and I<$flag> is not
595  for example,  set, an exception is thrown. So, for example,
596    
597      my @files = OpenDir("/Volumes/fig/contigs", 1);      my @files = OpenDir("/Volumes/fig/contigs", 1);
598    
599  is effectively the same as  is effectively the same as
600    
601      opendir(TMP, "/Volumes/fig/contigs") || Confess("Could not open /Volumes/fig/contigs.");      opendir(TMP, "/Volumes/fig/contigs") || Confess("Could not open /Volumes/fig/contigs.");
602      my @files = grep { $_ !~ /^[\.\$\#]/ } readdir(TMP);      my @files = grep { $_ !~ /^[\.\$\#]/ && $_ !~ /~$/ } readdir(TMP);
603    
604  Similarly, the following code  Similarly, the following code
605    
# Line 573  Line 637 
637          # The directory opened successfully. Get the appropriate list according to the          # The directory opened successfully. Get the appropriate list according to the
638          # strictures of the filter parameter.          # strictures of the filter parameter.
639          if ($filtered) {          if ($filtered) {
640              @retVal = grep { $_ !~ /^[\.\$\#]/ } readdir $dirHandle;              @retVal = grep { $_ !~ /^[\.\$\#]/ && $_ !~ /~$/ } readdir $dirHandle;
641          } else {          } else {
642              @retVal = readdir $dirHandle;              @retVal = readdir $dirHandle;
643          }          }
# Line 916  Line 980 
980          # Convert it to lower case before we hash it.          # Convert it to lower case before we hash it.
981          $category = lc $category;          $category = lc $category;
982          # Use the category and tracelevel to compute the result.          # Use the category and tracelevel to compute the result.
983            if (ref $traceLevel) {
984                Confess("Bad trace level.");
985            } elsif (ref $TraceLevel) {
986                Confess("Bad trace config.");
987            }
988          $retVal = ($traceLevel <= $TraceLevel && ($AllTrace || exists $Categories{$category}));          $retVal = ($traceLevel <= $TraceLevel && ($AllTrace || exists $Categories{$category}));
989      }      }
990      # Return the computed result.      # Return the computed result.
# Line 1210  Line 1279 
1279    
1280  C<< my @fileContents = Tracer::GetFile($fileName); >>  C<< my @fileContents = Tracer::GetFile($fileName); >>
1281    
1282  Return the entire contents of a file.      or
1283    
1284    C<< my $fileContents = Tracer::GetFile($fileName); >>
1285    
1286    Return the entire contents of a file. In list context, line-ends are removed and
1287    each line is a list element. In scalar context, line-ends are replaced by C<\n>.
1288    
1289  =over 4  =over 4
1290    
# Line 1221  Line 1295 
1295  =item RETURN  =item RETURN
1296    
1297  In a list context, returns the entire file as a list with the line terminators removed.  In a list context, returns the entire file as a list with the line terminators removed.
1298  In a scalar context, returns the entire file as a string.  In a scalar context, returns the entire file as a string. If an error occurs opening
1299    the file, an empty list will be returned.
1300    
1301  =back  =back
1302    
# Line 1669  Line 1744 
1744      return `$commandString`;      return `$commandString`;
1745  }  }
1746    
1747    =head3 ScriptSetup
1748    
1749    C<< my ($query, $varHash) = ScriptSetup(); >>
1750    
1751    Perform standard tracing and debugging setup for scripts. The value returned is
1752    the CGI object followed by a pre-built variable hash.
1753    
1754    The C<Trace> query parameter is used to determine whether or not tracing is active and
1755    which trace modules (other than C<Tracer> and C<FIG>) should be turned on. Specifying
1756    the C<CGI> trace module will trace parameter and environment information. Parameters are
1757    traced at level 3 and environment variables at level 4. At the end of the script, the
1758    client should call L</ScriptFinish> to output the web page.
1759    
1760    =cut
1761    
1762    sub ScriptSetup {
1763        # Get the CGI query object.
1764        my $query = CGI->new();
1765        # Check for tracing. Set it up if the user asked for it.
1766        if ($query->param('Trace')) {
1767            # Set up tracing to be queued for display at the bottom of the web page.
1768            TSetup($query->param('Trace') . " FIG Tracer", "QUEUE");
1769            # Trace the parameter and environment data.
1770            if (T(CGI => 3)) {
1771                # Here we want to trace the parameter data.
1772                my @names = $query->param;
1773                for my $parmName (sort @names) {
1774                    # Note we skip "Trace", which is for our use only.
1775                    if ($parmName ne 'Trace') {
1776                        my @values = $query->param($parmName);
1777                        Trace("CGI: $parmName = " . join(", ", @values));
1778                    }
1779                }
1780            }
1781            if (T(CGI => 4)) {
1782                # Here we want the environment data too.
1783                for my $envName (sort keys %ENV) {
1784                    Trace("ENV: $envName = $ENV{$envName}");
1785                }
1786            }
1787        } else {
1788            # Here tracing is to be turned off. All we allow is errors traced into the
1789            # error log.
1790            TSetup("0", "WARN");
1791        }
1792        # Create the variable hash.
1793        my $varHash = { DebugData => '' };
1794        # If we're in DEBUG mode, set up the debug mode data for forms.
1795        if (Tracer::DebugMode) {
1796            $varHash->{DebugData} = GetFile("Html/DebugFragment.html");
1797        }
1798        # Return the query object and variable hash.
1799        return ($query, $varHash);
1800    }
1801    
1802    =head3 ScriptFinish
1803    
1804    C<< ScriptFinish($webData, $varHash); >>
1805    
1806    Output a web page at the end of a script. Either the string to be output or the
1807    name of a template file can be specified. If the second parameter is omitted,
1808    it is assumed we have a string to be output; otherwise, it is assumed we have the
1809    name of a template file. The template should have the variable C<DebugData>
1810    specified in any form that invokes a standard script. If debugging mode is turned
1811    on, a form field will be put in that allows the user to enter tracing data.
1812    Trace messages will be placed immediately before the terminal C<BODY> tag in
1813    the output, formatted as a list.
1814    
1815    A typical standard script would loook like the following.
1816    
1817        BEGIN {
1818            # Print the HTML header.
1819            print "CONTENT-TYPE: text/html\n\n";
1820        }
1821        use Tracer;
1822        use CGI;
1823        use FIG;
1824        # ... more uses ...
1825    
1826        my ($query, $varHash) = ScriptSetup();
1827        eval {
1828            # ... get data from $query, put it in $varHash ...
1829        };
1830        if ($@) {
1831            Trace("Script Error: $@") if T(0);
1832        }
1833        ScriptFinish("Html/MyTemplate.html", $varHash);
1834    
1835    The idea here is that even if the script fails, you'll see trace messages and
1836    useful output.
1837    
1838    =over 4
1839    
1840    =item webData
1841    
1842    A string containing either the full web page to be written to the output or the
1843    name of a template file from which the page is to be constructed. If the name
1844    of a template file is specified, then the second parameter must be present;
1845    otherwise, it must be absent.
1846    
1847    =item varHash (optional)
1848    
1849    If specified, then a reference to a hash mapping variable names for a template
1850    to their values. The template file will be read into memory, and variable markers
1851    will be replaced by data in this hash reference.
1852    
1853    =back
1854    
1855    =cut
1856    
1857    sub ScriptFinish {
1858        # Get the parameters.
1859        my ($webData, $varHash) = @_;
1860        # Check for a template file situation.
1861        my $outputString;
1862        if (defined $varHash) {
1863            # Here we have a template file. We need to apply the variables to the template.
1864            $outputString = PageBuilder::Build("<$webData", $varHash, "Html");
1865        } else {
1866            # Here the user gave us a raw string.
1867            $outputString = $webData;
1868        }
1869        # Check for trace messages.
1870        if ($Destination eq "QUEUE") {
1871            # We have trace messages, so we want to put them at the end of the body. This
1872            # is either at the end of the whole string or at the beginning of the BODY
1873            # end-tag.
1874            my $pos = length $outputString;
1875            if ($outputString =~ m#</body>#gi) {
1876                $pos = (pos $outputString) - 7;
1877            }
1878            substr $outputString, $pos, 0, QTrace('Html');
1879        }
1880        # Write the output string.
1881        print $outputString;
1882    }
1883    
1884    =head3 Insure
1885    
1886    C<< Insure($dirName); >>
1887    
1888    Insure a directory is present.
1889    
1890    =over 4
1891    
1892    =item dirName
1893    
1894    Name of the directory to check. If it does not exist, it will be created.
1895    
1896    =back
1897    
1898    =cut
1899    
1900    sub Insure {
1901        my ($dirName) = @_;
1902        if (! -d $dirName) {
1903            Trace("Creating $dirName directory.") if T(2);
1904            mkpath $dirName;
1905        }
1906    }
1907    
1908  1;  1;

Legend:
Removed from v.1.31  
changed lines
  Added in v.1.39

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3