[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.8, Wed Apr 6 00:11:50 2005 UTC revision 1.9, Wed May 4 03:05:12 2005 UTC
# Line 3  Line 3 
3          require Exporter;          require Exporter;
4          @ISA = ('Exporter');          @ISA = ('Exporter');
5          @EXPORT = qw(Trace T TSetup QTrace Confess Cluck Min Max Assert);          @EXPORT = qw(Trace T TSetup QTrace Confess Cluck Min Max Assert);
6          @EXPORT_OK = qw(GetFile GetOptions Merge MergeOptions ParseCommand ParseRecord UnEscape);          @EXPORT_OK = qw(GetFile GetOptions Merge MergeOptions ParseCommand ParseRecord UnEscape Escape);
7          use strict;          use strict;
8          use Carp qw(longmess croak);          use Carp qw(longmess croak);
9          use CGI;          use CGI;
10          use FIG_Config;          use FIG_Config;
11        use PageBuilder;
 my $UsePageBuilder=1;  
 eval {  
  require PageBuilder;  
 };  
 undef $UsePageBuilder if ($@);  
12    
13  =head1 Tracing and Debugging Helpers  =head1 Tracing and Debugging Helpers
14    
# Line 378  Line 373 
373          my ($message) = @_;          my ($message) = @_;
374          # Get the timestamp.          # Get the timestamp.
375          my $timeStamp = Now();          my $timeStamp = Now();
376          # Format the message.          # Format the message. Note we strip off any line terminators at the end.
377          my $formatted = "$timeStamp <$LastCategory>: $message";          my $formatted = "$timeStamp <$LastCategory>: " . Strip($message);
378          # Process according to the destination.          # Process according to the destination.
379          if ($Destination eq "TEXT") {          if ($Destination eq "TEXT") {
380                  # Write the message to the standard output.                  # Write the message to the standard output.
# Line 538  Line 533 
533          return ($optionTable, @retVal);          return ($optionTable, @retVal);
534  }  }
535    
536    =head3 Escape
537    
538    C<< my $codedString = Tracer::Escape($realString); >>
539    
540    Escape a string for use in a command length. Spaces will be replaced by C<\b>,
541    tabs replaced by C<\t>, new-lines replaced by C<\n>, and backslashes will be
542    doubled. The effect is to exactly reverse the effect of L</UnEscape>.
543    
544    =over 4
545    
546    =item realString
547    
548    String to escape.
549    
550    =item RETURN
551    
552    Escaped equivalent of the real string.
553    
554    =back
555    
556    =cut
557    
558    sub Escape {
559            # Get the parameter.
560            my ($realString) = @_;
561            # Initialize the return variable.
562            my $retVal = "";
563            # Loop through the parameter string, looking for sequences to escape.
564            while (length $realString > 0) {
565                    # Look for the first sequence to escape.
566                    if ($realString =~ /^(.*?)([ \n\t\\])/) {
567                            # Here we found it. The text preceding the sequence is in $1. The sequence
568                            # itself is in $2. First, move the clear text to the return variable.
569                            $retVal .= $1;
570                            $realString = substr $realString, (length $2 + length $1);
571                            # Encode the escape sequence.
572                            my $char = $2;
573                            $char =~ tr/ \t\n/btn/;
574                            $retVal .= "\\" . $char;
575                    } else {
576                            # Here there are no more escape sequences. The rest of the string is
577                            # transferred unmodified.
578                            $retVal .= $realString;
579                            $realString = "";
580                    }
581            }
582            # Return the result.
583            return $retVal;
584    }
585    
586  =head3 UnEscape  =head3 UnEscape
587    
588  C<< my $realString = Tracer::UnEscape($codedString); >>  C<< my $realString = Tracer::UnEscape($codedString); >>
# Line 565  Line 610 
610          my ($codedString) = @_;          my ($codedString) = @_;
611          # Initialize the return variable.          # Initialize the return variable.
612          my $retVal = "";          my $retVal = "";
613            # Only proceed if the incoming string is nonempty.
614            if (defined $codedString) {
615          # Loop through the parameter string, looking for escape sequences. We can't do          # Loop through the parameter string, looking for escape sequences. We can't do
616          # translating because it causes problems with the escaped slash. ("\\b" becomes          # translating because it causes problems with the escaped slash. ("\\b" becomes
617          # "\ " no matter what we do.)          # "\ " no matter what we do.)
# Line 586  Line 633 
633                          $codedString = "";                          $codedString = "";
634                  }                  }
635          }          }
636            }
637          # Return the result.          # Return the result.
638          return $retVal;          return $retVal;
639  }  }
# Line 715  Line 763 
763                  # If we had an error, trace it. We will automatically return a null value.                  # If we had an error, trace it. We will automatically return a null value.
764                  Trace("Could not open \"$fileName\" for input.") if T(0);                  Trace("Could not open \"$fileName\" for input.") if T(0);
765          } else {          } else {
766                  # Read the whole file into the return variable, stripping off an terminator                  # Read the whole file into the return variable, stripping off any terminator
767          # characters.          # characters.
768          my $lineCount = 0;          my $lineCount = 0;
769                  while (my $line = <INPUTFILE>) {                  while (my $line = <INPUTFILE>) {
770              $lineCount++;              $lineCount++;
771              $line =~ s/(\r|\n)+$//g;              $line = Strip($line);
772                          push @retVal, $line;                          push @retVal, $line;
773                  }                  }
774                  # Close it.                  # Close it.
775                  close INPUTFILE;                  close INPUTFILE;
776          my $actualLines = @retVal;          my $actualLines = @retVal;
777          Trace("$lineCount lines read from $fileName. $actualLines processed.") if T(0);          Trace("$lineCount lines read from $fileName. $actualLines processed.") if T(3);
778          }          }
779          # Return the file's contents in the desired format.          # Return the file's contents in the desired format.
780      if (wantarray) {      if (wantarray) {
# Line 991  Line 1039 
1039                  $retVal = 1;                  $retVal = 1;
1040          } else {          } else {
1041                  # Here debug mode is off, so we generate an error page.                  # Here debug mode is off, so we generate an error page.
1042                  # RAE: PageBuilder is not part of the standard distro, and broke my machine          my $pageString = PageBuilder::Build("<Html/ErrorPage.html", {}, "Html");
                 if ($UsePageBuilder)  
                 {  
                   my $pageString = PageBuilder::Build(">Html/ErrorPage.html", {}, "Html");  
1043                    print $pageString;                    print $pageString;
1044                  }                  }
1045                  else          # Return the determination indicator.
1046                  {          return $retVal;
                   print STDERR "There was an error here in FiGKernelPackages/Tracer.pm\n";  
1047                  }                  }
1048    
1049    =head3 Strip
1050    
1051    C<< my $string = Tracer::Strip($line); >>
1052    
1053    Strip all line terminators off a string. This is necessary when dealing with files
1054    that may have been transferred back and forth several times among different
1055    operating environments.
1056    
1057    =over 4
1058    
1059    =item line
1060    
1061    Line of text to be stripped.
1062    
1063    =item RETURN
1064    
1065    The same line of text with all the line-ending characters chopped from the end.
1066    
1067    =back
1068    
1069    =cut
1070    
1071    sub Strip {
1072            # Get a copy of the parameter string.
1073            my ($string) = @_;
1074            my $retVal = $string;
1075        # Strip the line terminator characters.
1076        $retVal =~ s/(\r|\n)+$//g;
1077            # Return the result.
1078            return $retVal;
1079          }          }
1080          # Return the determination indicator.  
1081    =head3 Pad
1082    
1083    C<< my $paddedString = Tracer::Pad($string, $len, $left, $padChar); >>
1084    
1085    Pad a string to a specified length. The pad character will be a
1086    space, and the padding will be on the right side unless specified
1087    in the third parameter.
1088    
1089    =over 4
1090    
1091    =item string
1092    
1093    String to be padded.
1094    
1095    =item len
1096    
1097    Desired length of the padded string.
1098    
1099    =item left (optional)
1100    
1101    TRUE if the string is to be left-padded; otherwise it will be padded on the right.
1102    
1103    =item padChar (optional)
1104    
1105    =item RETURN
1106    
1107    Returns a copy of the original string with the spaces added to the specified end so
1108    that it achieves the desired length.
1109    
1110    =back
1111    
1112    =cut
1113    
1114    sub Pad {
1115            # Get the parameters.
1116            my ($string, $len, $left, $padChar) = @_;
1117            # Compute the padding character.
1118            if (! defined $padChar) {
1119                    $padChar = " ";
1120            }
1121            # Compute the number of spaces needed.
1122            my $needed = $len - length $string;
1123            # Copy the string into the return variable.
1124            my $retVal = $string;
1125            # Only proceed if padding is needed.
1126            if ($needed > 0) {
1127                    # Create the pad string.
1128                    my $pad = $padChar x $needed;
1129                    # Affix it to the return value.
1130                    if ($left) {
1131                            $retVal = $pad . $retVal;
1132                    } else {
1133                            $retVal .= $pad;
1134                    }
1135            }
1136            # Return the result.
1137          return $retVal;          return $retVal;
1138  }  }
1139    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3