[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.14, Tue Jul 26 20:12:33 2005 UTC revision 1.23, Tue Sep 13 05:36:12 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 Min Max Assert Open OpenDir);      @EXPORT = qw(Trace T TSetup QTrace Confess Cluck Min Max Assert Open OpenDir TICK);
6      @EXPORT_OK = qw(GetFile GetOptions Merge MergeOptions ParseCommand ParseRecord UnEscape Escape);      @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;      use PageBuilder;
12        use Digest::MD5;
13    
14  =head1 Tracing and Debugging Helpers  =head1 Tracing and Debugging Helpers
15    
# Line 895  Line 896 
896  sub UnEscape {  sub UnEscape {
897      # Get the parameter.      # Get the parameter.
898      my ($codedString) = @_;      my ($codedString) = @_;
899        Tracer("Coded string is \"$codedString\".") if T(4);
900      # Initialize the return variable.      # Initialize the return variable.
901      my $retVal = "";      my $retVal = "";
902      # Only proceed if the incoming string is nonempty.      # Only proceed if the incoming string is nonempty.
# Line 1048  Line 1050 
1050      my $ok = open INPUTFILE, "<$fileName";      my $ok = open INPUTFILE, "<$fileName";
1051      if (!$ok) {      if (!$ok) {
1052          # 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.
1053          Trace("Could not open \"$fileName\" for input.") if T(0);          Trace("Could not open \"$fileName\" for input: $!") if T(0);
1054      } else {      } else {
1055          # Read the whole file into the return variable, stripping off any terminator          # Read the whole file into the return variable, stripping off any terminator
1056          # characters.          # characters.
# Line 1117  Line 1119 
1119    
1120  C<< Confess($message); >>  C<< Confess($message); >>
1121    
1122  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  
1123  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.
1124  So, for example  So, for example
1125    
# Line 1140  Line 1141 
1141      # Get the parameters.      # Get the parameters.
1142      my ($message) = @_;      my ($message) = @_;
1143      # Trace the call stack.      # Trace the call stack.
1144      Cluck($message) if T(1);      Cluck($message);
1145      # Abort the program.      # Abort the program.
1146      croak(">>> $message");      croak(">>> $message");
1147  }  }
# Line 1309  Line 1310 
1310    
1311  C<< if (Tracer::DebugMode) { ...code... } >>  C<< if (Tracer::DebugMode) { ...code... } >>
1312    
1313  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
1314  an error page and return FALSE.  page and return FALSE.
1315    
1316  Certain CGI scripts are too dangerous to exist in the production  Certain CGI scripts are too dangerous to exist in the production
1317  environment. This method provides a simple way to prevent them  environment. This method provides a simple way to prevent them
1318  from working unless they are explicitly turned on in the configuration  from working unless they are explicitly turned on by creating a password
1319  file by setting C<$FIG_Config::debug_mode> to 1. If debugging mode  cookie via the B<SetPassword> script.  If debugging mode
1320  is not turned on, an error web page will be output.  is not turned on, an error web page will be output directing the
1321    user to enter in the correct password.
1322    
1323  =cut  =cut
1324    
1325  sub DebugMode {  sub DebugMode {
1326      # Declare the return variable.      # Declare the return variable.
1327      my $retVal;      my $retVal = 0;
1328      # Check the debug configuration.      # Check the debug configuration.
1329      if ($FIG_Config::debug_mode) {      my $password = CGI::cookie("DebugMode");
1330        my $encrypted = Digest::MD5::md5_hex($password);
1331        if ($encrypted eq "252dec43280e0c0d6a75ffcec486e61d") {
1332          $retVal = 1;          $retVal = 1;
1333      } else {      } else {
1334          # 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 1395 
1395    
1396  =item padChar (optional)  =item padChar (optional)
1397    
1398    Character to use for padding. The default is a space.
1399    
1400  =item RETURN  =item RETURN
1401    
1402  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
1403  that it achieves the desired length.  specified end so that it achieves the desired length.
1404    
1405  =back  =back
1406    
# Line 1426  Line 1432 
1432      return $retVal;      return $retVal;
1433  }  }
1434    
1435    =head3 TICK
1436    
1437    C<< my @results = TICK($commandString); >>
1438    
1439    Perform a back-tick operation on a command. If this is a Windows environment, any leading
1440    dot-slash (C<./> will be removed. So, for example, if you were doing
1441    
1442        `./protein.cgi`
1443    
1444    from inside a CGI script, it would work fine in Unix, but would issue an error message
1445    in Windows complaining that C<'.'> is not a valid command. If instead you code
1446    
1447        TICK("./protein.cgi")
1448    
1449    it will work correctly in both environments.
1450    
1451    =over 4
1452    
1453    =item commandString
1454    
1455    The command string to pass to the system.
1456    
1457    =item RETURN
1458    
1459    Returns the standard output from the specified command, as a list.
1460    
1461    =back
1462    
1463    =cut
1464    #: Return Type @;
1465    sub TICK {
1466        # Get the parameters.
1467        my ($commandString) = @_;
1468        # Chop off the dot-slash if this is Windows.
1469        if ($FIG_Config::win_mode) {
1470            $commandString =~ s!^\./!!;
1471        }
1472        # Activate the command and return the result.
1473        return `$commandString`;
1474    }
1475    
1476  1;  1;

Legend:
Removed from v.1.14  
changed lines
  Added in v.1.23

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3