[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.3, Mon Jan 24 07:05:56 2005 UTC revision 1.6, Mon Mar 7 02:01:51 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);          @EXPORT = qw(Trace T TSetup QTrace Confess Cluck Min Max Assert);
6          @EXPORT_OK = qw(GetFile GetOptions Merge MergeOptions ParseCommand ParseRecord UnEscape);          @EXPORT_OK = qw(GetFile GetOptions Merge MergeOptions ParseCommand ParseRecord UnEscape);
7          use strict;          use strict;
8          use Carp qw(longmess croak);          use Carp qw(longmess croak);
# Line 52  Line 52 
52  the page output, they can be gathered together and displayed at the end of the page. This makes  the page output, they can be gathered together and displayed at the end of the page. This makes
53  it easier to debug page formatting problems.  it easier to debug page formatting problems.
54    
55    Finally, you can specify that all trace messages be emitted as warnings.
56    
57  The flexibility of tracing makes it superior to simple use of directives like C<die> and C<warn>.  The flexibility of tracing makes it superior to simple use of directives like C<die> and C<warn>.
58  Tracer calls can be left in the code with minimal overhead and then turned on only when needed.  Tracer calls can be left in the code with minimal overhead and then turned on only when needed.
59  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
# Line 89  Line 91 
91  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
92  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
93  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. In addition to sending
94  the trace messages to a file, you can specify XX special destinations. C<HTML> will  the trace messages to a file, you can specify a special destination. C<HTML> will cause
95  cause tracing to the standard output with each line formatted as an HTML paragraph. C<TEXT>  tracing to the standard output with each line formatted as an HTML paragraph. C<TEXT>
96  will cause tracing to the standard output as ordinary text. C<QUEUE> will cause trace messages  will cause tracing to the standard output as ordinary text. C<ERROR> will cause trace
97  to be stored in a queue for later retrieval by the L</QTrace> method. C<NONE> will cause  messages to be sent to the standard error output as ordinary text. C<QUEUE> will cause trace
98  tracing to be suppressed.  messages to be stored in a queue for later retrieval by the L</QTrace> method. C<WARN> will
99    cause trace messages to be emitted as warnings using the B<warn> directive.  C<NONE> will
100    cause tracing to be suppressed.
101    
102  =back  =back
103    
# Line 123  Line 127 
127          }          }
128  }  }
129    
130    =head3 SetLevel
131    
132    C<< Tracer::SetLevel($newLevel); >>
133    
134    Modify the trace level. A higher trace level will cause more messages to appear.
135    
136    =over 4
137    
138    =item newLevel
139    
140    Proposed new trace level.
141    
142    =back
143    
144    =cut
145    
146    sub SetLevel {
147        $TraceLevel = $_[0];
148    }
149    
150  =head3 Now  =head3 Now
151    
152  C<< my $string = Tracer::Now(); >>  C<< my $string = Tracer::Now(); >>
# Line 168  Line 192 
192          open STDERR, '>', $fileName;          open STDERR, '>', $fileName;
193  }  }
194    
195    =head3 ReadOptions
196    
197    C<< my %options = Tracer::ReadOptions($fileName); >>
198    
199    Read a set of options from a file. Each option is encoded in a line of text that has the
200    format
201    
202    I<optionName>C<=>I<optionValue>C<; >I<comment>
203    
204    The option name must consist entirely of letters, digits, and the punctuation characters
205    C<.> and C<_>, and is case sensitive. Blank lines and lines in which the first nonblank
206    character is a semi-colon will be ignored. The return hash will map each option name to
207    the corresponding option value.
208    
209    =over 4
210    
211    =item fileName
212    
213    Name of the file containing the option data.
214    
215    =item RETURN
216    
217    Returns a hash mapping the option names specified in the file to their corresponding option
218    value.
219    
220    =back
221    
222    =cut
223    
224    sub ReadOptions {
225            # Get the parameters.
226            my ($fileName) = @_;
227            # Open the file.
228            (open CONFIGFILE, "<$fileName") || Confess("Could not open option file $fileName.");
229            # Count the number of records read.
230            my ($records, $comments) = 0;
231            # Create the return hash.
232            my %retVal = ();
233            # Loop through the file, accumulating key-value pairs.
234            while (my $line = <CONFIGFILE>) {
235                    # Denote we've read a line.
236                    $records++;
237                    # Determine the line type.
238                    if ($line =~ /^\s*[\n\r]/) {
239                            # A blank line is a comment.
240                            $comments++;
241                    } elsif ($line =~ /^\s*([A-Za-z0-9_\.]+)=([^;]*);/) {
242                            # Here we have an option assignment.
243                            retVal{$1} = $2;
244                    } elsif ($line =~ /^\s*;/) {
245                            # Here we have a text comment.
246                            $comments++;
247                    } else {
248                            # Here we have an invalid line.
249                            Trace("Invalid option statement in record $records.") if T(0);
250                    }
251            }
252            # Return the hash created.
253            return %retVal;
254    }
255    
256  =head3 GetOptions  =head3 GetOptions
257    
258  C<< Tracer::GetOptions(\%defaults, \%options); >>  C<< Tracer::GetOptions(\%defaults, \%options); >>
# Line 285  Line 370 
370          my ($message) = @_;          my ($message) = @_;
371          # Get the timestamp.          # Get the timestamp.
372          my $timeStamp = Now();          my $timeStamp = Now();
373            # Format the message.
374            my $formatted = "$timeStamp $message";
375          # Process according to the destination.          # Process according to the destination.
376          if ($Destination eq "TEXT") {          if ($Destination eq "TEXT") {
377                  # Write the message to the standard output.                  # Write the message to the standard output.
378                  print "$timeStamp $message\n";                  print "$formatted\n";
379            } elsif ($Destination eq "ERROR") {
380                    # Write the message to the error output.
381                    print STDERR "$formatted\n";
382          } elsif ($Destination eq "QUEUE") {          } elsif ($Destination eq "QUEUE") {
383                  # Push the message into the queue.                  # Push the message into the queue.
384                  push @Queue, "$timeStamp $message";                  push @Queue, "$formatted";
385          } elsif ($Destination eq "HTML") {          } elsif ($Destination eq "HTML") {
386                  # Convert the message to HTML and write it to the standard output.                  # Convert the message to HTML and write it to the standard output.
387                  my $escapedMessage = CGI::escapeHTML($message);                  my $escapedMessage = CGI::escapeHTML($message);
388                  print "<p>$timeStamp $message</p>\n";                  print "<p>$formatted</p>\n";
389        } elsif ($Destination eq "WARN") {
390           # Emit the message as a warning.
391           warn $message;
392          } elsif ($Destination =~ m/^>>/) {          } elsif ($Destination =~ m/^>>/) {
393                  # Write the trace message to an output file.                  # Write the trace message to an output file.
394                  open TRACING, $Destination;                  open TRACING, $Destination;
395                  print TRACING "$timeStamp $message\n";                  print TRACING "$formatted\n";
396                  close TRACING;                  close TRACING;
397          }          }
398  }  }
# Line 582  Line 675 
675    
676  =head3 GetFile  =head3 GetFile
677    
678  C<< my $fileContents = Tracer::GetFile($fileName); >>  C<< my @fileContents = Tracer::GetFile($fileName); >>
679    
680  Return the entire contents of a file.  Return the entire contents of a file.
681    
# Line 594  Line 687 
687    
688  =item RETURN  =item RETURN
689    
690  Returns the entire file as a single string. If an error occurs, will return  In a list context, returns the entire file as a list with the line terminators removed.
691  an empty string.  In a scalar context, returns the entire file as a string.
692    
693  =back  =back
694    
# Line 605  Line 698 
698          # Get the parameters.          # Get the parameters.
699          my ($fileName) = @_;          my ($fileName) = @_;
700          # Declare the return variable.          # Declare the return variable.
701          my $retVal = "";          my @retVal = ();
702          # Open the file for input.          # Open the file for input.
703          my $ok = open INPUTFILE, "<$fileName";          my $ok = open INPUTFILE, "<$fileName";
704          if (!$ok) {          if (!$ok) {
705                  # If we had an error, trace it. We will automatically return a null string.                  # If we had an error, trace it. We will automatically return a null value.
706                  Trace(0, "Could not open \"$fileName\" for input.");                  Trace("Could not open \"$fileName\" for input.") if T(0);
707          } else {          } else {
708                  # Read the whole file into the return variable.                  # Read the whole file into the return variable, stripping off an terminator
709                  while (<INPUTFILE>) {          # characters.
710                          $retVal .= $_;          my $lineCount = 0;
711                    while (my $line = <INPUTFILE>) {
712                $lineCount++;
713                $line =~ s/(\r|\n)+$//g;
714                            push @retVal, $line;
715                  }                  }
716                  # Close it.                  # Close it.
717                  close INPUTFILE;                  close INPUTFILE;
718            my $actualLines = @retVal;
719            Trace("$lineCount lines read from $fileName. $actualLines processed.") if T(0);
720            }
721            # Return the file's contents in the desired format.
722        if (wantarray) {
723                return @retVal;
724        } else {
725            return join "\n", @retVal;
726          }          }
         # Return the file's contents.  
         return $retVal;  
727  }  }
728    
729  =head3 QTrace  =head3 QTrace
# Line 669  Line 772 
772    
773  Trace the call stack and abort the program with the specified message. The stack  Trace the call stack and abort the program with the specified message. The stack
774  trace will only appear if the trace level for this package is 1 or more. When used with  trace will only appear if the trace level for this package is 1 or more. When used with
775  the OR operator, this method can function as a debugging assert. So, for example  the OR operator and the L</Assert> method, B<Confess> can function as a debugging assert.
776    So, for example
777    
778  C<< ($recNum >= 0) || Confess("Invalid record number $recNum."); >>  C<< Assert($recNum >= 0) || Confess("Invalid record number $recNum."); >>
779    
780  Will abort the program with a stack trace if the value of C<$recNum> is negative.  Will abort the program with a stack trace if the value of C<$recNum> is negative.
781    
# Line 691  Line 795 
795          # Trace the call stack.          # Trace the call stack.
796          Cluck($message) if T(1);          Cluck($message) if T(1);
797          # Abort the program.          # Abort the program.
798          die $message;          croak(">>> $message");
799    }
800    
801    =head3 Assert
802    
803    C<< Assert($condition1, $condition2, ... $conditionN); >>
804    
805    Return TRUE if all the conditions are true. This method can be used in conjunction with
806    the OR operator and the L</Confess> method, B<Assert> can function as a debugging assert.
807    So, for example
808    
809    C<< Assert($recNum >= 0) || Confess("Invalid record number $recNum."); >>
810    
811    Will abort the program with a stack trace if the value of C<$recNum> is negative.
812    
813    =cut
814    sub Assert {
815        my $retVal = 1;
816        LOOP: for my $condition (@_) {
817            if (! $condition) {
818                $retVal = 0;
819                last LOOP;
820            }
821        }
822        return $retVal;
823  }  }
824    
825  =head3 Cluck  =head3 Cluck
# Line 718  Line 846 
846  sub Cluck {  sub Cluck {
847          # Get the parameters.          # Get the parameters.
848          my ($message) = @_;          my ($message) = @_;
849        # Trace what's happening.
850        Trace("Stack trace for event: $message");
851          my $confession = longmess($message);          my $confession = longmess($message);
852          # Convert the confession to a series of trace messages.          # Convert the confession to a series of trace messages. Note we skip any
853        # messages relating to calls into Tracer.
854          for my $line (split /\s*\n/, $confession) {          for my $line (split /\s*\n/, $confession) {
855                  Trace($line);                  Trace($line) if ($line !~ /Tracer\.pm/);
856          }          }
857  }  }
858    
859    =head3 Min
860    
861    C<< my $min = Min($value1, $value2, ... $valueN); >>
862    
863    Return the minimum argument. The arguments are treated as numbers.
864    
865    =over 4
866    
867    =item $value1, $value2, ... $valueN
868    
869    List of numbers to compare.
870    
871    =item RETURN
872    
873    Returns the lowest number in the list.
874    
875    =back
876    
877    =cut
878    
879    sub Min {
880            # Get the parameters. Note that we prime the return value with the first parameter.
881            my ($retVal, @values) = @_;
882            # Loop through the remaining parameters, looking for the lowest.
883            for my $value (@values) {
884                    if ($value < $retVal) {
885                            $retVal = $value;
886                    }
887            }
888            # Return the minimum found.
889            return $retVal;
890    }
891    
892    =head3 Max
893    
894    C<< my $max = Max($value1, $value2, ... $valueN); >>
895    
896    Return the maximum argument. The arguments are treated as numbers.
897    
898    =over 4
899    
900    =item $value1, $value2, ... $valueN
901    
902    List of numbers to compare.
903    
904    =item RETURN
905    
906    Returns the highest number in the list.
907    
908    =back
909    
910    =cut
911    
912    sub Max {
913            # Get the parameters. Note that we prime the return value with the first parameter.
914            my ($retVal, @values) = @_;
915            # Loop through the remaining parameters, looking for the highest.
916            for my $value (@values) {
917                    if ($value > $retVal) {
918                            $retVal = $value;
919                    }
920            }
921            # Return the maximum found.
922            return $retVal;
923    }
924    
925    =head3 AddToListMap
926    
927    C<< Tracer::AddToListMap(\%hash, $key, $value); >>
928    
929    Add a key-value pair to a hash of lists. If no value exists for the key, a singleton list
930    is created for the key. Otherwise, the new value is pushed onto the list.
931    
932    =over 4
933    
934    =item hash
935    
936    Reference to the target hash.
937    
938    =item key
939    
940    Key for which the value is to be added.
941    
942    =item value
943    
944    Value to add to the key's value list.
945    
946    =back
947    
948    =cut
949    
950    sub AddToListMap {
951        # Get the parameters.
952        my ($hash, $key, $value) = @_;
953        # Process according to whether or not the key already has a value.
954        if (! exists $hash->{$key}) {
955            $hash->{$key} = [$value];
956        } else {
957            push @{$hash->{$key}}, $value;
958        }
959    }
960    
961  1;  1;

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3