[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.15, Mon Aug 8 20:06:25 2005 UTC revision 1.26, Wed Sep 14 13:09:53 2005 UTC
# Line 9  Line 9 
9      use CGI;      use CGI;
10      use FIG_Config;      use FIG_Config;
11      use PageBuilder;      use PageBuilder;
12        use Digest::MD5;
13    
14  =head1 Tracing and Debugging Helpers  =head1 Tracing and Debugging Helpers
15    
# Line 823  Line 824 
824    
825  C<< my $codedString = Tracer::Escape($realString); >>  C<< my $codedString = Tracer::Escape($realString); >>
826    
827  Escape a string for use in a command length. Spaces will be replaced by C<\b>,  Escape a string for use in a command length. Tabs will be replaced by C<\t>, new-lines
828  tabs replaced by C<\t>, new-lines replaced by C<\n>, and backslashes will be  replaced by C<\n>, and backslashes will be doubled. The effect is to exactly reverse the
829  doubled. The effect is to exactly reverse the effect of L</UnEscape>.  effect of L</UnEscape>.
830    
831  =over 4  =over 4
832    
# Line 857  Line 858 
858              $realString = substr $realString, (length $2) + (length $1);              $realString = substr $realString, (length $2) + (length $1);
859              # Encode the escape sequence.              # Encode the escape sequence.
860              my $char = $2;              my $char = $2;
861              $char =~ tr/ \t\n/btn/;              $char =~ tr/\t\n/tn/;
862              $retVal .= "\\" . $char;              $retVal .= "\\" . $char;
863          } else {          } else {
864              # 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
# Line 874  Line 875 
875    
876  C<< my $realString = Tracer::UnEscape($codedString); >>  C<< my $realString = Tracer::UnEscape($codedString); >>
877    
878  Replace escape sequences with their actual equivalents. C<\b> will be replaced by a space,  Replace escape sequences with their actual equivalents. C<\t> will be replaced by
879  C<\t> by 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 back-slash.
880    
881  =over 4  =over 4
882    
# Line 900  Line 901 
901      # Only proceed if the incoming string is nonempty.      # Only proceed if the incoming string is nonempty.
902      if (defined $codedString) {      if (defined $codedString) {
903          # 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
904          # translating because it causes problems with the escaped slash. ("\\b" becomes          # translating because it causes problems with the escaped slash. ("\\t" becomes
905          # "\ " no matter what we do.)          # "\<tab>" no matter what we do.)
906          while (length $codedString > 0) {          while (length $codedString > 0) {
907              # Look for the first escape sequence.              # Look for the first escape sequence.
908              if ($codedString =~ /^(.*?)\\(\\|b|n|t)/) {              if ($codedString =~ /^(.*?)\\(\\|n|t)/) {
909                  # 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
910                  # 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.
911                  $retVal .= $1;                  $retVal .= $1;
912                  $codedString = substr $codedString, (2 + length $1);                  $codedString = substr $codedString, (2 + length $1);
913                  # Decode the escape sequence.                  # Decode the escape sequence.
914                  my $char = $2;                  my $char = $2;
915                  $char =~ tr/\\btn/\\ \t\n/;                  $char =~ tr/\\tn/\\\t\n/;
916                  $retVal .= $char;                  $retVal .= $char;
917              } else {              } else {
918                  # 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
# Line 1048  Line 1049 
1049      my $ok = open INPUTFILE, "<$fileName";      my $ok = open INPUTFILE, "<$fileName";
1050      if (!$ok) {      if (!$ok) {
1051          # 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.
1052          Trace("Could not open \"$fileName\" for input.") if T(0);          Trace("Could not open \"$fileName\" for input: $!") if T(0);
1053      } else {      } else {
1054          # Read the whole file into the return variable, stripping off any terminator          # Read the whole file into the return variable, stripping off any terminator
1055          # characters.          # characters.
# Line 1117  Line 1118 
1118    
1119  C<< Confess($message); >>  C<< Confess($message); >>
1120    
1121  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. When used with
 trace will only appear if the trace level for this package is 1 or more. When used with  
1122  the OR operator and the L</Assert> method, B<Confess> can function as a debugging assert.  the OR operator and the L</Assert> method, B<Confess> can function as a debugging assert.
1123  So, for example  So, for example
1124    
# Line 1140  Line 1140 
1140      # Get the parameters.      # Get the parameters.
1141      my ($message) = @_;      my ($message) = @_;
1142      # Trace the call stack.      # Trace the call stack.
1143      Cluck($message) if T(1);      Cluck($message);
1144      # Abort the program.      # Abort the program.
1145      croak(">>> $message");      croak(">>> $message");
1146  }  }
# Line 1309  Line 1309 
1309    
1310  C<< if (Tracer::DebugMode) { ...code... } >>  C<< if (Tracer::DebugMode) { ...code... } >>
1311    
1312  Return TRUE if debug mode has been turned on in FIG_Config, else output  Return TRUE if debug mode has been turned on, else output an error
1313  an error page and return FALSE.  page and return FALSE.
1314    
1315  Certain CGI scripts are too dangerous to exist in the production  Certain CGI scripts are too dangerous to exist in the production
1316  environment. This method provides a simple way to prevent them  environment. This method provides a simple way to prevent them
1317  from working unless they are explicitly turned on in the configuration  from working unless they are explicitly turned on by creating a password
1318  file by setting C<$FIG_Config::debug_mode> to 1. If debugging mode  cookie via the B<SetPassword> script.  If debugging mode
1319  is not turned on, an error web page will be output.  is not turned on, an error web page will be output directing the
1320    user to enter in the correct password.
1321    
1322  =cut  =cut
1323    
1324  sub DebugMode {  sub DebugMode {
1325      # Declare the return variable.      # Declare the return variable.
1326      my $retVal;      my $retVal = 0;
1327      # Check the debug configuration.      # Check the debug configuration.
1328      if ($FIG_Config::debug_mode) {      my $password = CGI::cookie("DebugMode");
1329        my $encrypted = Digest::MD5::md5_hex($password);
1330        if ($encrypted eq "252dec43280e0c0d6a75ffcec486e61d") {
1331          $retVal = 1;          $retVal = 1;
1332      } else {      } else {
1333          # Here debug mode is off, so we generate an error page.          # Here debug mode is off, so we generate an error page.
# Line 1391  Line 1394 
1394    
1395  =item padChar (optional)  =item padChar (optional)
1396    
1397    Character to use for padding. The default is a space.
1398    
1399  =item RETURN  =item RETURN
1400    
1401  Returns a copy of the original string with the spaces added to the specified end so  Returns a copy of the original string with the pad character added to the
1402  that it achieves the desired length.  specified end so that it achieves the desired length.
1403    
1404  =back  =back
1405    

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3