[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.26, Wed Sep 14 13:09:53 2005 UTC revision 1.64, Thu Sep 14 23:06:00 2006 UTC
# Line 1  Line 1 
1    #
2    # Copyright (c) 2003-2006 University of Chicago and Fellowship
3    # for Interpretations of Genomes. All Rights Reserved.
4    #
5    # This file is part of the SEED Toolkit.
6    #
7    # The SEED Toolkit is free software. You can redistribute
8    # it and/or modify it under the terms of the SEED Toolkit
9    # Public License.
10    #
11    # You should have received a copy of the SEED Toolkit Public License
12    # along with this program; if not write to the University of Chicago
13    # at info@ci.uchicago.edu or the Fellowship for Interpretation of
14    # Genomes at veronika@thefig.info or download a copy from
15    # http://www.theseed.org/LICENSE.TXT.
16    #
17    
18  package Tracer;  package Tracer;
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);      @EXPORT = qw(Trace T TSetup QTrace Confess Cluck Min Max Assert Open OpenDir TICK StandardSetup ScriptSetup ScriptFinish Insure ChDir);
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);
26      use CGI;      use CGI;
27        use Cwd;
28      use FIG_Config;      use FIG_Config;
29      use PageBuilder;      use PageBuilder;
30      use Digest::MD5;      use Digest::MD5;
31        use File::Basename;
32        use File::Path;
33        use File::stat;
34        use LWP::UserAgent;
35        use Time::HiRes 'gettimeofday';
36    
37  =head1 Tracing and Debugging Helpers  =head1 Tracing and Debugging Helpers
38    
# Line 72  Line 95 
95    
96  =over 4  =over 4
97    
98  =item 0 Error  =item Error 0
99    
100  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
101  application entirely.  application entirely.
102    
103  =item 1 Warning  =item Warning 1
104    
105  Message indicates something that is unexpected but that probably did not interfere  Message indicates something that is unexpected but that probably did not interfere
106  with program execution.  with program execution.
107    
108  =item 2 Notice  =item Notice 2
109    
110  Message indicates the beginning or end of a major task.  Message indicates the beginning or end of a major task.
111    
112  =item 3 Information  =item Information 3
113    
114  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
115  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.
116    
117  =item 4 Detail  =item Detail 4
118    
119  Message indicates a low-level loop iteration.  Message indicates a low-level loop iteration.
120    
# Line 157  Line 180 
180      # Presume category-based tracing until we learn otherwise.      # Presume category-based tracing until we learn otherwise.
181      $AllTrace = 0;      $AllTrace = 0;
182      # 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
183      # tracing.      # tracing. We must also clear away any pre-existing data.
184        %Categories = ( main => 1 );
185      for my $category (@categoryData) {      for my $category (@categoryData) {
186          if ($category eq '*') {          if ($category eq '*') {
187              $AllTrace = 1;              $AllTrace = 1;
# Line 188  Line 212 
212      $SetupCount++;      $SetupCount++;
213  }  }
214    
215    =head3 StandardSetup
216    
217    C<< my ($options, @parameters) = StandardSetup(\@categories, \%options, $parmHelp, @ARGV); >>
218    
219    This method performs standard command-line parsing and tracing setup. The return
220    values are a hash of the command-line options and a list of the positional
221    parameters. Tracing is automatically set up and the command-line options are
222    validated.
223    
224    This is a complex method that does a lot of grunt work. The parameters can
225    be more easily understood, however, once they are examined individually.
226    
227    The I<categories> parameter is the most obtuse. It is a reference to a list of
228    special-purpose tracing categories. Most tracing categories are PERL package
229    names. So, for example, if you wanted to turn on tracing inside the B<Sprout>,
230    B<ERDB>, and B<SproutLoad> packages, you would specify the categories
231    
232        ["Sprout", "SproutLoad", "ERDB"]
233    
234    This would cause trace messages in the specified three packages to appear in
235    the output. There are threer special tracing categories that are automatically
236    handled by this method. In other words, if you used L</TSetup> you would need
237    to include these categories manually, but if you use this method they are turned
238    on automatically.
239    
240    =over 4
241    
242    =item FIG
243    
244    Turns on trace messages inside the B<FIG> package.
245    
246    =item SQL
247    
248    Traces SQL commands and activity.
249    
250    =item Tracer
251    
252    Traces error messages and call stacks.
253    
254    =back
255    
256    C<SQL> is only turned on if the C<-sql> option is specified in the command line.
257    The trace level is specified using the C<-trace> command-line option. For example,
258    the following command line for C<TransactFeatures> turns on SQL tracing and runs
259    all tracing at level 3.
260    
261        TransactFeatures -trace=3 -sql register ../xacts IDs.tbl
262    
263    Standard tracing is output to the standard output and echoed to the file
264    C<trace>I<$$>C<.log> in the FIG temporary directory, where I<$$> is the
265    process ID. You can also specify the C<user> parameter to put a user ID
266    instead of a process ID in the trace file name. So, for example
267    
268    The default trace level is 2. To get all messages, specify a trace level of 4.
269    For a genome-by-genome update, use 3.
270    
271        TransactFeatures -trace=3 -sql -user=Bruce register ../xacts IDs.tbl
272    
273    would send the trace output to C<traceBruce.log> in the temporary directory.
274    
275    The I<options> parameter is a reference to a hash containing the command-line
276    options, their default values, and an explanation of what they mean. Command-line
277    options may be in the form of switches or keywords. In the case of a switch, the
278    option value is 1 if it is specified and 0 if it is not specified. In the case
279    of a keyword, the value is separated from the option name by an equal sign. You
280    can see this last in the command-line example above.
281    
282    You can specify a different default trace level by setting C<$options->{trace}>
283    prior to calling this method.
284    
285    An example at this point would help. Consider, for example, the command-line utility
286    C<TransactFeatures>. It accepts a list of positional parameters plus the options
287    C<safe>, C<noAlias>, C<start>, and C<tblFiles>. To start up this command, we execute
288    the following code.
289    
290        my ($options, @parameters) = Tracer::StandardSetup(["DocUtils"],
291                            { safe => [0, "use database transactions"],
292                              noAlias => [0, "do not expect aliases in CHANGE transactions"],
293                              start => [' ', "start with this genome"],
294                              tblFiles => [0, "output TBL files containing the corrected IDs"] },
295                            "command transactionDirectory IDfile",
296                          @ARGV);
297    
298    
299    The call to C<ParseCommand> specifies the default values for the options and
300    stores the actual options in a hash that is returned as C<$options>. The
301    positional parameters are returned in C<@parameters>.
302    
303    The following is a sample command line for C<TransactFeatures>.
304    
305        TransactFeatures -trace=2 -noAlias register ../xacts IDs.tbl
306    
307    In this case, C<register>, C<../xacts>, and C<IDs.tbl> are the positional
308    parameters, and would find themselves in I<@parameters> after executing the
309    above code fragment. The tracing would be set to level 2, and the categories
310    would be C<FIG>, C<Tracer>, and <DocUtils>. C<FIG> and C<Tracer> are standard,
311    and C<DocUtils> was included because it came in within the first parameter
312    to this method. The I<$options> hash would be
313    
314        { trace => 2, sql => 0, safe => 0,
315          noAlias => 1, start => ' ', tblFiles => 0 }
316    
317    Use of C<StandardSetup> in this way provides a simple way of performing
318    standard tracing setup and command-line parsing. Note that the caller is
319    not even aware of the command-line switches C<-trace> and C<-sql>, which
320    are used by this method to control the tracing. If additional tracing features
321    need to be added in the future, they can be processed by this method without
322    upsetting the command-line utilities.
323    
324    If the C<background> option is specified on the command line, then the
325    standard and error outputs will be directed to files in the temporary
326    directory, using the same suffix as the trace file. So, if the command
327    line specified
328    
329        -user=Bruce -background
330    
331    then the trace output would go to C<traceBruce.log>, the standard output to
332    C<outBruce.log>, and the error output to C<errBruce.log>. This is designed to
333    simplify starting a command in the background.
334    
335    Finally, if the special option C<-h> is specified, the option names will
336    be traced at level 0 and the program will exit without processing.
337    This provides a limited help capability. For example, if the user enters
338    
339        TransactFeatures -h
340    
341    he would see the following output.
342    
343        TransactFeatures [options] command transactionDirectory IDfile
344            -trace    tracing level (default 2)
345            -sql      trace SQL commands
346            -safe     use database transactions
347            -noAlias  do not expect aliases in CHANGE transactions
348            -start    start with this genome
349            -tblFiles output TBL files containing the corrected IDs
350    
351    The caller has the option of modifying the tracing scheme by placing a value
352    for C<trace> in the incoming options hash. The default value can be overridden,
353    or the tracing to the standard output can be turned off by suffixing a minus
354    sign to the trace level. So, for example,
355    
356        { trace => [0, "tracing level (default 0)"],
357           ...
358    
359    would set the default trace level to 0 instead of 2, while
360    
361        { trace => ["2-", "tracing level (default 2)"],
362           ...
363    
364    would leave the default at 2, but trace only to the log file, not to the
365    standard output.
366    
367    The parameters to this method are as follows.
368    
369    =over 4
370    
371    =item categories
372    
373    Reference to a list of tracing category names. These should be names of
374    packages whose internal workings will need to be debugged to get the
375    command working.
376    
377    =item options
378    
379    Reference to a hash containing the legal options for the current command mapped
380    to their default values and descriptions. The user can override the defaults
381    by specifying the options as command-line switches prefixed by a hyphen.
382    Tracing-related options may be added to this hash. If the C<-h> option is
383    specified on the command line, the option descriptions will be used to
384    explain the options. To turn off tracing to the standard output, add a
385    minus sign to the value for C<trace> (see above).
386    
387    =item parmHelp
388    
389    A string that vaguely describes the positional parameters. This is used
390    if the user specifies the C<-h> option.
391    
392    =item argv
393    
394    List of command line parameters, including the option switches, which must
395    precede the positional parameters and be prefixed by a hyphen.
396    
397    =item RETURN
398    
399    Returns a list. The first element of the list is the reference to a hash that
400    maps the command-line option switches to their values. These will either be the
401    default values or overrides specified on the command line. The remaining
402    elements of the list are the position parameters, in order.
403    
404    =back
405    
406    =cut
407    
408    sub StandardSetup {
409        # Get the parameters.
410        my ($categories, $options, $parmHelp, @argv) = @_;
411        # Add the tracing options.
412        if (! exists $options->{trace}) {
413            $options->{trace} = [2, "tracing level"];
414        }
415        $options->{sql} = [0, "turn on SQL tracing"];
416        $options->{h} = [0, "display command-line options"];
417        $options->{user} = [$$, "trace log file name suffix"];
418        $options->{background} = [0, "spool standard and error output"];
419        # Create a parsing hash from the options hash. The parsing hash
420        # contains the default values rather than the default value
421        # and the description. While we're at it, we'll memorize the
422        # length of the longest option name.
423        my $longestName = 0;
424        my %parseOptions = ();
425        for my $key (keys %{$options}) {
426            if (length $key > $longestName) {
427                $longestName = length $key;
428            }
429            $parseOptions{$key} = $options->{$key}->[0];
430        }
431        # Parse the command line.
432        my ($retOptions, @retParameters) = ParseCommand(\%parseOptions, @argv);
433        # Get the logfile suffix.
434        my $suffix = $retOptions->{user};
435        # Check for background mode.
436        if ($retOptions->{background}) {
437            my $outFileName = "$FIG_Config::temp/out$suffix.log";
438            my $errFileName = "$FIG_Config::temp/err$suffix.log";
439            open STDOUT, ">$outFileName";
440            open STDERR, ">$errFileName";
441        }
442        # Now we want to set up tracing. First, we need to know if SQL is to
443        # be traced.
444        my @cats = @{$categories};
445        if ($retOptions->{sql}) {
446            push @cats, "SQL";
447        }
448        # Add the default categories.
449        push @cats, "Tracer", "FIG";
450        # Next, we create the category string by joining the categories.
451        my $cats = join(" ", @cats);
452        # Check to determine whether or not the caller wants to turn off tracing
453        # to the standard output.
454        my $traceLevel = $retOptions->{trace};
455        my $textOKFlag = 1;
456        if ($traceLevel =~ /^(.)-/) {
457            $traceLevel = $1;
458            $textOKFlag = 0;
459        }
460        # Now we set up the trace mode.
461        my $traceMode;
462        # Verify that we can open a file in the FIG temporary directory.
463        my $traceFileName = "$FIG_Config::temp/trace$suffix.log";
464        if (open TESTTRACE, ">$traceFileName") {
465            # Here we can trace to a file.
466            $traceMode = ">$traceFileName";
467            if ($textOKFlag) {
468                # Echo to standard output if the text-OK flag is set.
469                $traceMode = "+$traceMode";
470            }
471            # Close the test file.
472            close TESTTRACE;
473        } else {
474            # Here we can't trace to a file. We trace to the standard output if it's
475            # okay, and the error log otherwise.
476            if ($textOKFlag) {
477                $traceMode = "TEXT";
478            } else {
479                $traceMode = "WARN";
480            }
481        }
482        # Now set up the tracing.
483        TSetup("$traceLevel $cats", $traceMode);
484        # Check for the "h" option. If it is specified, dump the command-line
485        # options and exit the program.
486        if ($retOptions->{h}) {
487            $0 =~ m#[/\\](\w+)(\.pl)?$#i;
488            Trace("$1 [options] $parmHelp") if T(0);
489            for my $key (sort keys %{$options}) {
490                my $name = Pad($key, $longestName, 0, ' ');
491                my $desc = $options->{$key}->[1];
492                if ($options->{$key}->[0]) {
493                    $desc .= " (default " . $options->{$key}->[0] . ")";
494                }
495                Trace("  $name $desc") if T(0);
496            }
497            exit(0);
498        }
499        # Return the parsed parameters.
500        return ($retOptions, @retParameters);
501    }
502    
503  =head3 Setups  =head3 Setups
504    
505  C<< my $count = Tracer::Setups(); >>  C<< my $count = Tracer::Setups(); >>
# Line 348  Line 660 
660    
661  =head3 OpenDir  =head3 OpenDir
662    
663  C<< my @files = OpenDir($dirName, $filtered); >>  C<< my @files = OpenDir($dirName, $filtered, $flag); >>
664    
665  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
666  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
667  set to TRUE, all filenames beginning with a period (C<.>) will be filtered out of  set to TRUE, all filenames beginning with a period (C<.>), dollar sign (C<$>),
668  the return list. If the directory does not open, an exception is thrown. So,  or pound sign (C<#>) and all filenames ending with a tilde C<~>) will be
669  for example,  filtered out of the return list. If the directory does not open and I<$flag> is not
670    set, an exception is thrown. So, for example,
671    
672      my @files = OpenDir("/Volumes/fig/contigs", 1);      my @files = OpenDir("/Volumes/fig/contigs", 1);
673    
674  is effectively the same as  is effectively the same as
675    
676      opendir(TMP, "/Volumes/fig/contigs") || Confess("Could not open /Volumes/fig/contigs.");      opendir(TMP, "/Volumes/fig/contigs") || Confess("Could not open /Volumes/fig/contigs.");
677      my @files = grep { $_ !~ /^\./ } readdir(TMP);      my @files = grep { $_ !~ /^[\.\$\#]/ && $_ !~ /~$/ } readdir(TMP);
678    
679  Similarly, the following code  Similarly, the following code
680    
681      my @files = grep { $_ =~ /^\d/ } OpenDir("/Volumes/fig/orgs");      my @files = grep { $_ =~ /^\d/ } OpenDir("/Volumes/fig/orgs", 0, 1);
682    
683  Returns the names of all files in C</Volumes/fig/orgs> that begin with digits and  Returns the names of all files in C</Volumes/fig/orgs> that begin with digits and
684  automatically throws an error if the directory fails to open.  automatically returns an empty list if the directory fails to open.
685    
686  =over 4  =over 4
687    
# Line 381  Line 694 
694  TRUE if files whose names begin with a period (C<.>) should be automatically removed  TRUE if files whose names begin with a period (C<.>) should be automatically removed
695  from the list, else FALSE.  from the list, else FALSE.
696    
697    =item flag
698    
699    TRUE if a failure to open is okay, else FALSE
700    
701  =back  =back
702    
703  =cut  =cut
704  #: Return Type @;  #: Return Type @;
705  sub OpenDir {  sub OpenDir {
706      # Get the parameters.      # Get the parameters.
707      my ($dirName, $filtered) = @_;      my ($dirName, $filtered, $flag) = @_;
708      # Declare the return variable.      # Declare the return variable.
709      my @retVal;      my @retVal = ();
710      # Open the directory.      # Open the directory.
711      if (opendir(my $dirHandle, $dirName)) {      if (opendir(my $dirHandle, $dirName)) {
712          # The directory opened successfully. Get the appropriate list according to the          # The directory opened successfully. Get the appropriate list according to the
713          # strictures of the filter parameter.          # strictures of the filter parameter.
714          if ($filtered) {          if ($filtered) {
715              @retVal = grep { $_ !~ /^\./ } readdir $dirHandle;              @retVal = grep { $_ !~ /^[\.\$\#]/ && $_ !~ /~$/ } readdir $dirHandle;
716          } else {          } else {
717              @retVal = readdir $dirHandle;              @retVal = readdir $dirHandle;
718          }          }
719      } else {      } elsif (! $flag) {
720          # Here the directory would not open.          # Here the directory would not open and it's considered an error.
721          Confess("Could not open directory $dirName.");          Confess("Could not open directory $dirName.");
722      }      }
723      # Return the result.      # Return the result.
# Line 738  Line 1055 
1055          # Convert it to lower case before we hash it.          # Convert it to lower case before we hash it.
1056          $category = lc $category;          $category = lc $category;
1057          # Use the category and tracelevel to compute the result.          # Use the category and tracelevel to compute the result.
1058            if (ref $traceLevel) {
1059                Confess("Bad trace level.");
1060            } elsif (ref $TraceLevel) {
1061                Confess("Bad trace config.");
1062            }
1063          $retVal = ($traceLevel <= $TraceLevel && ($AllTrace || exists $Categories{$category}));          $retVal = ($traceLevel <= $TraceLevel && ($AllTrace || exists $Categories{$category}));
1064      }      }
1065      # Return the computed result.      # Return the computed result.
# Line 825  Line 1147 
1147  C<< my $codedString = Tracer::Escape($realString); >>  C<< my $codedString = Tracer::Escape($realString); >>
1148    
1149  Escape a string for use in a command length. Tabs will be replaced by C<\t>, new-lines  Escape a string for use in a command length. Tabs will be replaced by C<\t>, new-lines
1150  replaced by C<\n>, and backslashes will be doubled. The effect is to exactly reverse the  replaced by C<\n>, carriage returns will be deleted, and backslashes will be doubled. The
1151  effect of L</UnEscape>.  result is to reverse the effect of L</UnEscape>.
1152    
1153  =over 4  =over 4
1154    
# Line 850  Line 1172 
1172      # Loop through the parameter string, looking for sequences to escape.      # Loop through the parameter string, looking for sequences to escape.
1173      while (length $realString > 0) {      while (length $realString > 0) {
1174          # Look for the first sequence to escape.          # Look for the first sequence to escape.
1175          if ($realString =~ /^(.*?)([\n\t\\])/) {          if ($realString =~ /^(.*?)([\n\t\r\\])/) {
1176              # Here we found it. The text preceding the sequence is in $1. The sequence              # Here we found it. The text preceding the sequence is in $1. The sequence
1177              # itself is in $2. First, move the clear text to the return variable.              # itself is in $2. First, move the clear text to the return variable.
1178              $retVal .= $1;              $retVal .= $1;
1179              # Strip the processed section off the real string.              # Strip the processed section off the real string.
1180              $realString = substr $realString, (length $2) + (length $1);              $realString = substr $realString, (length $2) + (length $1);
1181              # Encode the escape sequence.              # Get the matched character.
1182              my $char = $2;              my $char = $2;
1183                # If we have a CR, we are done.
1184                if ($char ne "\r") {
1185                    # It's not a CR, so encode the escape sequence.
1186              $char =~ tr/\t\n/tn/;              $char =~ tr/\t\n/tn/;
1187              $retVal .= "\\" . $char;              $retVal .= "\\" . $char;
1188                }
1189          } else {          } else {
1190              # Here there are no more escape sequences. The rest of the string is              # Here there are no more escape sequences. The rest of the string is
1191              # transferred unmodified.              # transferred unmodified.
# Line 876  Line 1202 
1202  C<< my $realString = Tracer::UnEscape($codedString); >>  C<< my $realString = Tracer::UnEscape($codedString); >>
1203    
1204  Replace escape sequences with their actual equivalents. C<\t> will be replaced by  Replace escape sequences with their actual equivalents. C<\t> will be replaced by
1205  a tab, C<\n> by a new-line character, and C<\\> by a back-slash.  a tab, C<\n> by a new-line character, and C<\\> by a backslash. C<\r> codes will
1206    be deleted.
1207    
1208  =over 4  =over 4
1209    
# Line 905  Line 1232 
1232          # "\<tab>" no matter what we do.)          # "\<tab>" no matter what we do.)
1233          while (length $codedString > 0) {          while (length $codedString > 0) {
1234              # Look for the first escape sequence.              # Look for the first escape sequence.
1235              if ($codedString =~ /^(.*?)\\(\\|n|t)/) {              if ($codedString =~ /^(.*?)\\(\\|n|t|r)/) {
1236                  # Here we found it. The text preceding the sequence is in $1. The sequence                  # Here we found it. The text preceding the sequence is in $1. The sequence
1237                  # itself is in $2. First, move the clear text to the return variable.                  # itself is in $2. First, move the clear text to the return variable.
1238                  $retVal .= $1;                  $retVal .= $1;
1239                  $codedString = substr $codedString, (2 + length $1);                  $codedString = substr $codedString, (2 + length $1);
1240                  # Decode the escape sequence.                  # Get the escape value.
1241                  my $char = $2;                  my $char = $2;
1242                    # If we have a "\r", we are done.
1243                    if ($char ne 'r') {
1244                        # Here it's not an 'r', so we convert it.
1245                  $char =~ tr/\\tn/\\\t\n/;                  $char =~ tr/\\tn/\\\t\n/;
1246                  $retVal .= $char;                  $retVal .= $char;
1247                    }
1248              } else {              } else {
1249                  # Here there are no more escape sequences. The rest of the string is                  # Here there are no more escape sequences. The rest of the string is
1250                  # transferred unmodified.                  # transferred unmodified.
# Line 1019  Line 1350 
1350      return @inputList;      return @inputList;
1351  }  }
1352    
1353    =head3 Percent
1354    
1355    C<< my $percent = Tracer::Percent($number, $base); >>
1356    
1357    Returns the percent of the base represented by the given number. If the base
1358    is zero, returns zero.
1359    
1360    =over 4
1361    
1362    =item number
1363    
1364    Percent numerator.
1365    
1366    =item base
1367    
1368    Percent base.
1369    
1370    =item RETURN
1371    
1372    Returns the percentage of the base represented by the numerator.
1373    
1374    =back
1375    
1376    =cut
1377    
1378    sub Percent {
1379        # Get the parameters.
1380        my ($number, $base) = @_;
1381        # Declare the return variable.
1382        my $retVal = 0;
1383        # Compute the percent.
1384        if ($base != 0) {
1385            $retVal = $number * 100 / $base;
1386        }
1387        # Return the result.
1388        return $retVal;
1389    }
1390    
1391  =head3 GetFile  =head3 GetFile
1392    
1393  C<< my @fileContents = Tracer::GetFile($fileName); >>  C<< my @fileContents = Tracer::GetFile($fileName); >>
1394    
1395  Return the entire contents of a file.      or
1396    
1397    C<< my $fileContents = Tracer::GetFile($fileName); >>
1398    
1399    Return the entire contents of a file. In list context, line-ends are removed and
1400    each line is a list element. In scalar context, line-ends are replaced by C<\n>.
1401    
1402  =over 4  =over 4
1403    
# Line 1034  Line 1408 
1408  =item RETURN  =item RETURN
1409    
1410  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.
1411  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
1412    the file, an empty list will be returned.
1413    
1414  =back  =back
1415    
# Line 1046  Line 1421 
1421      # Declare the return variable.      # Declare the return variable.
1422      my @retVal = ();      my @retVal = ();
1423      # Open the file for input.      # Open the file for input.
1424      my $ok = open INPUTFILE, "<$fileName";      my $handle = Open(undef, "<$fileName");
     if (!$ok) {  
         # If we had an error, trace it. We will automatically return a null value.  
         Trace("Could not open \"$fileName\" for input: $!") if T(0);  
     } else {  
1425          # Read the whole file into the return variable, stripping off any terminator          # Read the whole file into the return variable, stripping off any terminator
1426          # characters.          # characters.
1427          my $lineCount = 0;          my $lineCount = 0;
1428          while (my $line = <INPUTFILE>) {      while (my $line = <$handle>) {
1429              $lineCount++;              $lineCount++;
1430              $line = Strip($line);              $line = Strip($line);
1431              push @retVal, $line;              push @retVal, $line;
1432          }          }
1433          # Close it.          # Close it.
1434          close INPUTFILE;      close $handle;
1435          my $actualLines = @retVal;          my $actualLines = @retVal;
     }  
1436      # Return the file's contents in the desired format.      # Return the file's contents in the desired format.
1437      if (wantarray) {      if (wantarray) {
1438          return @retVal;          return @retVal;
# Line 1071  Line 1441 
1441      }      }
1442  }  }
1443    
1444    =head3 PutFile
1445    
1446    C<< Tracer::PutFile($fileName, \@lines); >>
1447    
1448    Write out a file from a list of lines of text.
1449    
1450    =over 4
1451    
1452    =item fileName
1453    
1454    Name of the output file.
1455    
1456    =item lines
1457    
1458    Reference to a list of text lines. The lines will be written to the file in order, with trailing
1459    new-line characters.
1460    
1461    =back
1462    
1463    =cut
1464    
1465    sub PutFile {
1466        # Get the parameters.
1467        my ($fileName, $lines) = @_;
1468        # Open the output file.
1469        my $handle = Open(undef, ">$fileName");
1470        # Write the lines.
1471        for my $line (@{$lines}) {
1472            print $handle "$line\n";
1473        }
1474        # Close the output file.
1475        close $handle;
1476    }
1477    
1478  =head3 QTrace  =head3 QTrace
1479    
1480  C<< my $data = QTrace($format); >>  C<< my $data = QTrace($format); >>
# Line 1150  Line 1554 
1554  C<< Assert($condition1, $condition2, ... $conditionN); >>  C<< Assert($condition1, $condition2, ... $conditionN); >>
1555    
1556  Return TRUE if all the conditions are true. This method can be used in conjunction with  Return TRUE if all the conditions are true. This method can be used in conjunction with
1557  the OR operator and the L</Confess> method, B<Assert> can function as a debugging assert.  the OR operator and the L</Confess> method as a debugging assert.
1558  So, for example  So, for example
1559    
1560  C<< Assert($recNum >= 0) || Confess("Invalid record number $recNum."); >>  C<< Assert($recNum >= 0) || Confess("Invalid record number $recNum."); >>
# Line 1271  Line 1675 
1675    
1676  =head3 AddToListMap  =head3 AddToListMap
1677    
1678  C<< Tracer::AddToListMap(\%hash, $key, $value); >>  C<< Tracer::AddToListMap(\%hash, $key, $value1, $value2, ... valueN); >>
1679    
1680  Add a key-value pair to a hash of lists. If no value exists for the key, a singleton list  Add a key-value pair to a hash of lists. If no value exists for the key, a singleton list
1681  is created for the key. Otherwise, the new value is pushed onto the list.  is created for the key. Otherwise, the new value is pushed onto the list.
# Line 1286  Line 1690 
1690    
1691  Key for which the value is to be added.  Key for which the value is to be added.
1692    
1693  =item value  =item value1, value2, ... valueN
1694    
1695  Value to add to the key's value list.  List of values to add to the key's value list.
1696    
1697  =back  =back
1698    
# Line 1296  Line 1700 
1700    
1701  sub AddToListMap {  sub AddToListMap {
1702      # Get the parameters.      # Get the parameters.
1703      my ($hash, $key, $value) = @_;      my ($hash, $key, @values) = @_;
1704      # Process according to whether or not the key already has a value.      # Process according to whether or not the key already has a value.
1705      if (! exists $hash->{$key}) {      if (! exists $hash->{$key}) {
1706          $hash->{$key} = [$value];          $hash->{$key} = [@values];
1707      } else {      } else {
1708          push @{$hash->{$key}}, $value;          push @{$hash->{$key}}, @values;
1709      }      }
1710  }  }
1711    
# Line 1331  Line 1735 
1735          $retVal = 1;          $retVal = 1;
1736      } else {      } else {
1737          # Here debug mode is off, so we generate an error page.          # Here debug mode is off, so we generate an error page.
1738          my $pageString = PageBuilder::Build("<Html/ErrorPage.html", {}, "Html");          my $pageString = PageBuilder::Build("<<Html/ErrorPage.html", {}, "Html");
1739          print $pageString;          print $pageString;
1740      }      }
1741      # Return the determination indicator.      # Return the determination indicator.
# Line 1363  Line 1767 
1767  sub Strip {  sub Strip {
1768      # Get a copy of the parameter string.      # Get a copy of the parameter string.
1769      my ($string) = @_;      my ($string) = @_;
1770      my $retVal = $string;      my $retVal = (defined $string ? $string : "");
1771      # Strip the line terminator characters.      # Strip the line terminator characters.
1772      $retVal =~ s/(\r|\n)+$//g;      $retVal =~ s/(\r|\n)+$//g;
1773      # Return the result.      # Return the result.
# Line 1431  Line 1835 
1835      return $retVal;      return $retVal;
1836  }  }
1837    
1838    =head3 EOF
1839    
1840    This is a constant that is lexically greater than any useful string.
1841    
1842    =cut
1843    
1844    sub EOF {
1845        return "\xFF\xFF\xFF\xFF\xFF";
1846    }
1847    
1848  =head3 TICK  =head3 TICK
1849    
1850  C<< my @results = TICK($commandString); >>  C<< my @results = TICK($commandString); >>
# Line 1472  Line 1886 
1886      return `$commandString`;      return `$commandString`;
1887  }  }
1888    
1889    =head3 ScriptSetup
1890    
1891    C<< my ($query, $varHash) = ScriptSetup(); >>
1892    
1893    Perform standard tracing and debugging setup for scripts. The value returned is
1894    the CGI object followed by a pre-built variable hash.
1895    
1896    The C<Trace> query parameter is used to determine whether or not tracing is active and
1897    which trace modules (other than C<Tracer> and C<FIG>) should be turned on. Specifying
1898    the C<CGI> trace module will trace parameter and environment information. Parameters are
1899    traced at level 3 and environment variables at level 4. At the end of the script, the
1900    client should call L</ScriptFinish> to output the web page.
1901    
1902    =cut
1903    
1904    sub ScriptSetup {
1905        # Get the CGI query object.
1906        my $query = CGI->new();
1907        # Check for tracing. Set it up if the user asked for it.
1908        if ($query->param('Trace')) {
1909            # Set up tracing to be queued for display at the bottom of the web page.
1910            TSetup($query->param('Trace') . " FIG Tracer", "QUEUE");
1911            # Trace the parameter and environment data.
1912            if (T(CGI => 3)) {
1913                # Here we want to trace the parameter data.
1914                my @names = $query->param;
1915                for my $parmName (sort @names) {
1916                    # Note we skip "Trace", which is for our use only.
1917                    if ($parmName ne 'Trace') {
1918                        my @values = $query->param($parmName);
1919                        Trace("CGI: $parmName = " . join(", ", @values));
1920                    }
1921                }
1922            }
1923            if (T(CGI => 4)) {
1924                # Here we want the environment data too.
1925                for my $envName (sort keys %ENV) {
1926                    Trace("ENV: $envName = $ENV{$envName}");
1927                }
1928            }
1929        } else {
1930            # Here tracing is to be turned off. All we allow is errors traced into the
1931            # error log.
1932            TSetup("0", "WARN");
1933        }
1934        # Create the variable hash.
1935        my $varHash = { DebugData => '' };
1936        # If we're in DEBUG mode, set up the debug mode data for forms.
1937        if (Tracer::DebugMode) {
1938            $varHash->{DebugData} = GetFile("Html/DebugFragment.html");
1939        }
1940        # Return the query object and variable hash.
1941        return ($query, $varHash);
1942    }
1943    
1944    =head3 ScriptFinish
1945    
1946    C<< ScriptFinish($webData, $varHash); >>
1947    
1948    Output a web page at the end of a script. Either the string to be output or the
1949    name of a template file can be specified. If the second parameter is omitted,
1950    it is assumed we have a string to be output; otherwise, it is assumed we have the
1951    name of a template file. The template should have the variable C<DebugData>
1952    specified in any form that invokes a standard script. If debugging mode is turned
1953    on, a form field will be put in that allows the user to enter tracing data.
1954    Trace messages will be placed immediately before the terminal C<BODY> tag in
1955    the output, formatted as a list.
1956    
1957    A typical standard script would loook like the following.
1958    
1959        BEGIN {
1960            # Print the HTML header.
1961            print "CONTENT-TYPE: text/html\n\n";
1962        }
1963        use Tracer;
1964        use CGI;
1965        use FIG;
1966        # ... more uses ...
1967    
1968        my ($query, $varHash) = ScriptSetup();
1969        eval {
1970            # ... get data from $query, put it in $varHash ...
1971        };
1972        if ($@) {
1973            Trace("Script Error: $@") if T(0);
1974        }
1975        ScriptFinish("Html/MyTemplate.html", $varHash);
1976    
1977    The idea here is that even if the script fails, you'll see trace messages and
1978    useful output.
1979    
1980    =over 4
1981    
1982    =item webData
1983    
1984    A string containing either the full web page to be written to the output or the
1985    name of a template file from which the page is to be constructed. If the name
1986    of a template file is specified, then the second parameter must be present;
1987    otherwise, it must be absent.
1988    
1989    =item varHash (optional)
1990    
1991    If specified, then a reference to a hash mapping variable names for a template
1992    to their values. The template file will be read into memory, and variable markers
1993    will be replaced by data in this hash reference.
1994    
1995    =back
1996    
1997    =cut
1998    
1999    sub ScriptFinish {
2000        # Get the parameters.
2001        my ($webData, $varHash) = @_;
2002        # Check for a template file situation.
2003        my $outputString;
2004        if (defined $varHash) {
2005            # Here we have a template file. We need to determine the template type.
2006            my $template;
2007            if ($FIG_Config::template_url && $webData =~ /\.php$/) {
2008                $template = "$FIG_Config::template_url/$webData";
2009            } else {
2010                $template = "<<$webData";
2011            }
2012            $outputString = PageBuilder::Build($template, $varHash, "Html");
2013        } else {
2014            # Here the user gave us a raw string.
2015            $outputString = $webData;
2016        }
2017        # Check for trace messages.
2018        if ($Destination eq "QUEUE") {
2019            # We have trace messages, so we want to put them at the end of the body. This
2020            # is either at the end of the whole string or at the beginning of the BODY
2021            # end-tag.
2022            my $pos = length $outputString;
2023            if ($outputString =~ m#</body>#gi) {
2024                $pos = (pos $outputString) - 7;
2025            }
2026            substr $outputString, $pos, 0, QTrace('Html');
2027        }
2028        # Write the output string.
2029        print $outputString;
2030    }
2031    
2032    =head3 Insure
2033    
2034    C<< Insure($dirName); >>
2035    
2036    Insure a directory is present.
2037    
2038    =over 4
2039    
2040    =item dirName
2041    
2042    Name of the directory to check. If it does not exist, it will be created.
2043    
2044    =back
2045    
2046    =cut
2047    
2048    sub Insure {
2049        my ($dirName) = @_;
2050        if (! -d $dirName) {
2051            Trace("Creating $dirName directory.") if T(2);
2052            eval { mkpath $dirName; };
2053            if ($@) {
2054                Confess("Error creating $dirName: $@");
2055            }
2056        }
2057    }
2058    
2059    =head3 ChDir
2060    
2061    C<< ChDir($dirName); >>
2062    
2063    Change to the specified directory.
2064    
2065    =over 4
2066    
2067    =item dirName
2068    
2069    Name of the directory to which we want to change.
2070    
2071    =back
2072    
2073    =cut
2074    
2075    sub ChDir {
2076        my ($dirName) = @_;
2077        if (! -d $dirName) {
2078            Confess("Cannot change to directory $dirName: no such directory.");
2079        } else {
2080            Trace("Changing to directory $dirName.") if T(4);
2081            my $okFlag = chdir $dirName;
2082            if (! $okFlag) {
2083                Confess("Error switching to directory $dirName.");
2084            }
2085        }
2086    }
2087    
2088    =head3 SendSMS
2089    
2090    C<< my $msgID = Tracer::SendSMS($phoneNumber, $msg); >>
2091    
2092    Send a text message to a phone number using Clickatell. The FIG_Config file must contain the
2093    user name, password, and API ID for the relevant account in the hash reference variable
2094    I<$FIG_Config::phone>, using the keys C<user>, C<password>, and C<api_id>. For
2095    example, if the user name is C<BruceTheHumanPet>, the password is C<silly>, and the API ID
2096    is C<2561022>, then the FIG_Config file must contain
2097    
2098        $phone =  { user => 'BruceTheHumanPet',
2099                    password => 'silly',
2100                    api_id => '2561022' };
2101    
2102    The original purpose of this method was to insure Bruce would be notified immediately when the
2103    Sprout Load terminates. Care should be taken if you do not wish Bruce to be notified immediately
2104    when you call this method.
2105    
2106    The message ID will be returned if successful, and C<undef> if an error occurs.
2107    
2108    =over 4
2109    
2110    =item phoneNumber
2111    
2112    Phone number to receive the message, in international format. A United States phone number
2113    would be prefixed by "1". A British phone number would be prefixed by "44".
2114    
2115    =item msg
2116    
2117    Message to send to the specified phone.
2118    
2119    =item RETURN
2120    
2121    Returns the message ID if successful, and C<undef> if the message could not be sent.
2122    
2123    =back
2124    
2125    =cut
2126    
2127    sub SendSMS {
2128        # Get the parameters.
2129        my ($phoneNumber, $msg) = @_;
2130        # Declare the return variable. If we do not change it, C<undef> will be returned.
2131        my $retVal;
2132        # Only proceed if we have phone support.
2133        if (! defined $FIG_Config::phone) {
2134            Trace("Phone support not present in FIG_Config.") if T(1);
2135        } else {
2136            # Get the phone data.
2137            my $parms = $FIG_Config::phone;
2138            # Get the Clickatell URL.
2139            my $url = "http://api.clickatell.com/http/";
2140            # Create the user agent.
2141            my $ua = LWP::UserAgent->new;
2142            # Request a Clickatell session.
2143            my $resp = $ua->post("$url/sendmsg", { user => $parms->{user},
2144                                         password => $parms->{password},
2145                                         api_id => $parms->{api_id},
2146                                         to => $phoneNumber,
2147                                         text => $msg});
2148            # Check for an error.
2149            if (! $resp->is_success) {
2150                Trace("Alert failed.") if T(1);
2151            } else {
2152                # Get the message ID.
2153                my $rstring = $resp->content;
2154                if ($rstring =~ /^ID:\s+(.*)$/) {
2155                    $retVal = $1;
2156                } else {
2157                    Trace("Phone attempt failed with $rstring") if T(1);
2158                }
2159            }
2160        }
2161        # Return the result.
2162        return $retVal;
2163    }
2164    
2165    =head3 CommaFormat
2166    
2167    C<< my $formatted = Tracer::CommaFormat($number); >>
2168    
2169    Insert commas into a number.
2170    
2171    =over 4
2172    
2173    =item number
2174    
2175    A sequence of digits.
2176    
2177    =item RETURN
2178    
2179    Returns the same digits with commas strategically inserted.
2180    
2181    =back
2182    
2183    =cut
2184    
2185    sub CommaFormat {
2186        # Get the parameters.
2187        my ($number) = @_;
2188        # Pad the length up to a multiple of three.
2189        my $padded = "$number";
2190        $padded = " " . $padded while length($padded) % 3 != 0;
2191        # This is a fancy PERL trick. The parentheses in the SPLIT pattern
2192        # cause the delimiters to be included in the output stream. The
2193        # GREP removes the empty strings in between the delimiters.
2194        my $retVal = join(",", grep { $_ ne '' } split(/(...)/, $padded));
2195        # Clean out the spaces.
2196        $retVal =~ s/ //g;
2197        # Return the result.
2198        return $retVal;
2199    }
2200    =head3 SetPermissions
2201    
2202    C<< Tracer::SetPermissions($dirName, $group, $mask, %otherMasks); >>
2203    
2204    Set the permissions for a directory and all the files and folders inside it.
2205    In addition, the group ownership will be changed to the specified value.
2206    
2207    This method is more vulnerable than most to permission and compatability
2208    problems, so it does internal error recovery.
2209    
2210    =over 4
2211    
2212    =item dirName
2213    
2214    Name of the directory to process.
2215    
2216    =item group
2217    
2218    Name of the group to be assigned.
2219    
2220    =item mask
2221    
2222    Permission mask. Bits that are C<1> in this mask will be ORed into the
2223    permission bits of any file or directory that does not already have them
2224    set to 1.
2225    
2226    =item otherMasks
2227    
2228    Map of search patterns to permission masks. If a directory name matches
2229    one of the patterns, that directory and all its members and subdirectories
2230    will be assigned the new pattern. For example, the following would
2231    assign 01664 to most files, but would use 01777 for directories named C<tmp>.
2232    
2233        Tracer::SetPermissions($dirName, 'fig', 01664, '^tmp$' => 01777);
2234    
2235    The list is ordered, so the following would use 0777 for C<tmp1> and
2236    0666 for C<tmp>, C<tmp2>, or C<tmp3>.
2237    
2238        Tracer::SetPermissions($dirName, 'fig', 01664, '^tmp1' => 0777,
2239                                                       '^tmp' => 0666);
2240    
2241    Note that the pattern matches are all case-insensitive, and only directory
2242    names are matched, not file names.
2243    
2244    =back
2245    
2246    =cut
2247    
2248    sub SetPermissions {
2249        # Get the parameters.
2250        my ($dirName, $group, $mask, @otherMasks) = @_;
2251        # Set up for error recovery.
2252        eval {
2253            # Switch to the specified directory.
2254            ChDir($dirName);
2255            # Get the group ID.
2256            my $gid = getgrnam($group);
2257            # Get the mask for tracing.
2258            my $traceMask = sprintf("%04o", $mask) . "($mask)";
2259            Trace("Fixing permissions for directory $dirName using group $group($gid) and mask $traceMask.") if T(2);
2260            my $fixCount = 0;
2261            my $lookCount = 0;
2262            # @dirs will be a stack of directories to be processed.
2263            my @dirs = (getcwd());
2264            while (scalar(@dirs) > 0) {
2265                # Get the current directory.
2266                my $dir = pop @dirs;
2267                # Check for a match to one of the specified directory names. To do
2268                # that, we need to pull the individual part of the name off of the
2269                # whole path.
2270                my $simpleName = $dir;
2271                if ($dir =~ m!/([^/]+)$!) {
2272                    $simpleName = $1;
2273                }
2274                Trace("Simple directory name for $dir is $simpleName.") if T(4);
2275                # Search for a match.
2276                my $match = 0;
2277                my $i;
2278                for ($i = 0; $i < $#otherMasks && ! $match; $i += 2) {
2279                    my $pattern = $otherMasks[$i];
2280                    if ($simpleName =~ /$pattern/i) {
2281                        $match = 1;
2282                    }
2283                }
2284                # Check for a match. Note we use $i-1 because the loop added 2
2285                # before terminating due to the match.
2286                if ($match && $otherMasks[$i-1] != $mask) {
2287                    # This directory matches one of the incoming patterns, and it's
2288                    # a different mask, so we process it recursively with that mask.
2289                    SetPermissions($dir, $group, $otherMasks[$i-1], @otherMasks);
2290                } else {
2291                    # Here we can process normally. Get all of the non-hidden members.
2292                    my @submems = OpenDir($dir, 1);
2293                    for my $submem (@submems) {
2294                        # Get the full name.
2295                        my $thisMem = "$dir/$submem";
2296                        Trace("Checking member $thisMem.") if T(4);
2297                        $lookCount++;
2298                        if ($lookCount % 1000 == 0) {
2299                            Trace("$lookCount members examined. Current is $thisMem. Mask is $traceMask") if T(3);
2300                        }
2301                        # Fix the group.
2302                        chown -1, $gid, $thisMem;
2303                        # Insure this member is not a symlink.
2304                        if (! -l $thisMem) {
2305                            # Get its info.
2306                            my $fileInfo = stat $thisMem;
2307                            # Only proceed if we got the info. Otherwise, it's a hard link
2308                            # and we want to skip it anyway.
2309                            if ($fileInfo) {
2310                                my $fileMode = $fileInfo->mode;
2311                                if (($fileMode & $mask) != $mask) {
2312                                    # Fix this member.
2313                                    $fileMode |= $mask;
2314                                    chmod $fileMode, $thisMem;
2315                                    $fixCount++;
2316                                }
2317                                # If it's a subdirectory, stack it.
2318                                if (-d $thisMem) {
2319                                    push @dirs, $thisMem;
2320                                }
2321                            }
2322                        }
2323                    }
2324                }
2325            }
2326            Trace("$lookCount files and directories processed, $fixCount fixed.") if T(2);
2327        };
2328        # Check for an error.
2329        if ($@) {
2330            Confess("SetPermissions error: $@");
2331        }
2332    }
2333    
2334    =head3 CompareLists
2335    
2336    C<< my ($inserted, $deleted) = Tracer::CompareLists(\@newList, \@oldList, $keyIndex); >>
2337    
2338    Compare two lists of tuples, and return a hash analyzing the differences. The lists
2339    are presumed to be sorted alphabetically by the value in the $keyIndex column.
2340    The return value contains a list of items that are only in the new list
2341    (inserted) and only in the old list (deleted).
2342    
2343    =over 4
2344    
2345    =item newList
2346    
2347    Reference to a list of new tuples.
2348    
2349    =item oldList
2350    
2351    Reference to a list of old tuples.
2352    
2353    =item keyIndex (optional)
2354    
2355    Index into each tuple of its key field. The default is 0.
2356    
2357    =item RETURN
2358    
2359    Returns a 2-tuple consisting of a reference to the list of items that are only in the new
2360    list (inserted) followed by a reference to the list of items that are only in the old
2361    list (deleted).
2362    
2363    =back
2364    
2365    =cut
2366    
2367    sub CompareLists {
2368        # Get the parameters.
2369        my ($newList, $oldList, $keyIndex) = @_;
2370        if (! defined $keyIndex) {
2371            $keyIndex = 0;
2372        }
2373        # Declare the return variables.
2374        my ($inserted, $deleted) = ([], []);
2375        # Loop through the two lists simultaneously.
2376        my ($newI, $oldI) = (0, 0);
2377        my ($newN, $oldN) = (scalar @{$newList}, scalar @{$oldList});
2378        while ($newI < $newN || $oldI < $oldN) {
2379            # Get the current object in each list. Note that if one
2380            # of the lists is past the end, we'll get undef.
2381            my $newItem = $newList->[$newI];
2382            my $oldItem = $oldList->[$oldI];
2383            if (! defined($newItem) || defined($oldItem) && $newItem->[$keyIndex] gt $oldItem->[$keyIndex]) {
2384                # The old item is not in the new list, so mark it deleted.
2385                push @{$deleted}, $oldItem;
2386                $oldI++;
2387            } elsif (! defined($oldItem) || $oldItem->[$keyIndex] gt $newItem->[$keyIndex]) {
2388                # The new item is not in the old list, so mark it inserted.
2389                push @{$inserted}, $newItem;
2390                $newI++;
2391            } else {
2392                # The item is in both lists, so push forward.
2393                $oldI++;
2394                $newI++;
2395            }
2396        }
2397        # Return the result.
2398        return ($inserted, $deleted);
2399    }
2400    
2401  1;  1;

Legend:
Removed from v.1.26  
changed lines
  Added in v.1.64

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3