[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.104, Fri May 9 06:22:49 2008 UTC revision 1.105, Wed May 14 09:09:25 2008 UTC
# Line 924  Line 924 
924      return @retVal;      return @retVal;
925  }  }
926    
 =head3 ScriptSetup (deprecated)  
   
     my ($cgi, $varHash) = ScriptSetup($noTrace);  
   
 Perform standard tracing and debugging setup for scripts. The value returned is  
 the CGI object followed by a pre-built variable hash. At the end of the script,  
 the client should call L</ScriptFinish> to output the web page.  
   
 This method calls L</ETracing> to configure tracing, which allows the tracing  
 to be configured via the emergency tracing form on the debugging control panel.  
 Tracing will then be turned on automatically for all programs that use the L</ETracing>  
 method, which includes every program that uses this method or L</StandardSetup>.  
   
 =over 4  
   
 =item noTrace (optional)  
   
 If specified, tracing will be suppressed. This is useful if the script wants to set up  
 tracing manually.  
   
 =item RETURN  
   
 Returns a two-element list consisting of a CGI query object and a variable hash for  
 the output page.  
   
 =back  
   
 =cut  
   
 sub ScriptSetup {  
     # Get the parameters.  
     my ($noTrace) = @_;  
     # Get the CGI query object.  
     my $cgi = CGI->new();  
     # Set up tracing if it's not suppressed.  
     ETracing($cgi) unless $noTrace;  
     # Create the variable hash.  
     my $varHash = { results => '' };  
     # Return the query object and variable hash.  
     return ($cgi, $varHash);  
 }  
   
927  =head3 ETracing  =head3 ETracing
928    
929      ETracing($parameter);      ETracing($parameter);
# Line 1359  Line 1317 
1317      }      }
1318  }  }
1319    
   
 =head3 ScriptFinish (deprecated)  
   
     ScriptFinish($webData, $varHash);  
   
 Output a web page at the end of a script. Either the string to be output or the  
 name of a template file can be specified. If the second parameter is omitted,  
 it is assumed we have a string to be output; otherwise, it is assumed we have the  
 name of a template file. The template should have the variable C<DebugData>  
 specified in any form that invokes a standard script. If debugging mode is turned  
 on, a form field will be put in that allows the user to enter tracing data.  
 Trace messages will be placed immediately before the terminal C<BODY> tag in  
 the output, formatted as a list.  
   
 A typical standard script would loook like the following.  
   
     BEGIN {  
         # Print the HTML header.  
         print "CONTENT-TYPE: text/html\n\n";  
     }  
     use Tracer;  
     use CGI;  
     use FIG;  
     # ... more uses ...  
   
     my ($cgi, $varHash) = ScriptSetup();  
     eval {  
         # ... get data from $cgi, put it in $varHash ...  
     };  
     if ($@) {  
         Trace("Script Error: $@") if T(0);  
     }  
     ScriptFinish("Html/MyTemplate.html", $varHash);  
   
 The idea here is that even if the script fails, you'll see trace messages and  
 useful output.  
   
 =over 4  
   
 =item webData  
   
 A string containing either the full web page to be written to the output or the  
 name of a template file from which the page is to be constructed. If the name  
 of a template file is specified, then the second parameter must be present;  
 otherwise, it must be absent.  
   
 =item varHash (optional)  
   
 If specified, then a reference to a hash mapping variable names for a template  
 to their values. The template file will be read into memory, and variable markers  
 will be replaced by data in this hash reference.  
   
 =back  
   
 =cut  
   
 sub ScriptFinish {  
     # Get the parameters.  
     my ($webData, $varHash) = @_;  
     # Check for a template file situation.  
     my $outputString;  
     if (defined $varHash) {  
         # Here we have a template file. We need to determine the template type.  
         my $template;  
         if ($FIG_Config::template_url && $webData =~ /\.php$/) {  
             $template = "$FIG_Config::template_url/$webData";  
         } else {  
             $template = "<<$webData";  
         }  
         $outputString = PageBuilder::Build($template, $varHash, "Html");  
     } else {  
         # Here the user gave us a raw string.  
         $outputString = $webData;  
     }  
     # Check for trace messages.  
     if ($Destination ne "NONE" && $TraceLevel > 0) {  
         # We have trace messages, so we want to put them at the end of the body. This  
         # is either at the end of the whole string or at the beginning of the BODY  
         # end-tag.  
         my $pos = length $outputString;  
         if ($outputString =~ m#</body>#gi) {  
             $pos = (pos $outputString) - 7;  
         }  
         # If the trace messages were queued, we unroll them. Otherwise, we display the  
         # destination.  
         my $traceHtml;  
         if ($Destination eq "QUEUE") {  
             $traceHtml = QTrace('Html');  
         } elsif ($Destination =~ /^>>(.+)$/) {  
             # Here the tracing output it to a file. We code it as a hyperlink so the user  
             # can copy the file name into the clipboard easily.  
             my $actualDest = $1;  
             $traceHtml = "<p>Tracing output to $actualDest.</p>\n";  
         } else {  
             # Here we have one of the special destinations.  
             $traceHtml = "<P>Tracing output type is $Destination.</p>\n";  
         }  
         substr $outputString, $pos, 0, $traceHtml;  
     }  
     # Write the output string.  
     print $outputString;  
 }  
   
1320  =head2 Command-Line Utility Methods  =head2 Command-Line Utility Methods
1321    
1322  =head3 SendSMS  =head3 SendSMS
# Line 3176  Line 3031 
3031      return $retVal;      return $retVal;
3032  }  }
3033    
   
3034  =head3 Strip  =head3 Strip
3035    
3036      my $string = Tracer::Strip($line);      my $string = Tracer::Strip($line);
# Line 3426  Line 3280 
3280      return ($inserted, $deleted);      return ($inserted, $deleted);
3281  }  }
3282    
3283    =head3 Cmp
3284    
3285        my $cmp = Tracer::Cmp($a, $b);
3286    
3287    This method performs a universal sort comparison. Each value coming in is
3288    separated into a leading text part and a trailing number part. The text
3289    part is string compared, and if both parts are equal, then the number
3290    parts are compared numerically. A stream of just numbers or a stream of
3291    just strings will sort correctly, and a mixed stream will sort with the
3292    numbers first. Strings with a label and a number will sort in the
3293    expected manner instead of lexically.
3294    
3295    =over 4
3296    
3297    =item a
3298    
3299    First item to compare.
3300    
3301    =item b
3302    
3303    Second item to compare.
3304    
3305    =item RETURN
3306    
3307    Returns a negative number if the first item should sort first (is less), a positive
3308    number if the first item should sort second (is greater), and a zero if the items are
3309    equal.
3310    
3311    =back
3312    
3313    =cut
3314    
3315    sub Cmp {
3316        # Get the parameters.
3317        my ($a, $b) = @_;
3318        # Declare the return value.
3319        my $retVal;
3320        # Check for nulls.
3321        if (! defined($a)) {
3322            $retVal = (! defined($b) ? 0 : -1);
3323        } elsif (! defined($b)) {
3324            $retVal = 1;
3325        } else {
3326            # Here we have two real values. Parse the two strings.
3327            $a =~ /^(\D*)(\d*)$/;
3328            my $aParsed = [$1, $2];
3329            $b =~ /^(\D*)(\d*)$/;
3330            my $bParsed = [$1, $2];
3331            # Compare the string parts.
3332            $retVal = $aParsed->[0] cmp $bParsed->[0];
3333            if (! $retVal) {
3334                $retVal = $aParsed->[1] <=> $bParsed->[1];
3335            }
3336        }
3337        # Return the result.
3338        return $retVal;
3339    }
3340    
3341    =head2 CGI Script Utilities
3342    
3343    =head3 ScriptSetup (deprecated)
3344    
3345        my ($cgi, $varHash) = ScriptSetup($noTrace);
3346    
3347    Perform standard tracing and debugging setup for scripts. The value returned is
3348    the CGI object followed by a pre-built variable hash. At the end of the script,
3349    the client should call L</ScriptFinish> to output the web page.
3350    
3351    This method calls L</ETracing> to configure tracing, which allows the tracing
3352    to be configured via the emergency tracing form on the debugging control panel.
3353    Tracing will then be turned on automatically for all programs that use the L</ETracing>
3354    method, which includes every program that uses this method or L</StandardSetup>.
3355    
3356    =over 4
3357    
3358    =item noTrace (optional)
3359    
3360    If specified, tracing will be suppressed. This is useful if the script wants to set up
3361    tracing manually.
3362    
3363    =item RETURN
3364    
3365    Returns a two-element list consisting of a CGI query object and a variable hash for
3366    the output page.
3367    
3368    =back
3369    
3370    =cut
3371    
3372    sub ScriptSetup {
3373        # Get the parameters.
3374        my ($noTrace) = @_;
3375        # Get the CGI query object.
3376        my $cgi = CGI->new();
3377        # Set up tracing if it's not suppressed.
3378        ETracing($cgi) unless $noTrace;
3379        # Create the variable hash.
3380        my $varHash = { results => '' };
3381        # Return the query object and variable hash.
3382        return ($cgi, $varHash);
3383    }
3384    
3385    =head3 ScriptFinish (deprecated)
3386    
3387        ScriptFinish($webData, $varHash);
3388    
3389    Output a web page at the end of a script. Either the string to be output or the
3390    name of a template file can be specified. If the second parameter is omitted,
3391    it is assumed we have a string to be output; otherwise, it is assumed we have the
3392    name of a template file. The template should have the variable C<DebugData>
3393    specified in any form that invokes a standard script. If debugging mode is turned
3394    on, a form field will be put in that allows the user to enter tracing data.
3395    Trace messages will be placed immediately before the terminal C<BODY> tag in
3396    the output, formatted as a list.
3397    
3398    A typical standard script would loook like the following.
3399    
3400        BEGIN {
3401            # Print the HTML header.
3402            print "CONTENT-TYPE: text/html\n\n";
3403        }
3404        use Tracer;
3405        use CGI;
3406        use FIG;
3407        # ... more uses ...
3408    
3409        my ($cgi, $varHash) = ScriptSetup();
3410        eval {
3411            # ... get data from $cgi, put it in $varHash ...
3412        };
3413        if ($@) {
3414            Trace("Script Error: $@") if T(0);
3415        }
3416        ScriptFinish("Html/MyTemplate.html", $varHash);
3417    
3418    The idea here is that even if the script fails, you'll see trace messages and
3419    useful output.
3420    
3421    =over 4
3422    
3423    =item webData
3424    
3425    A string containing either the full web page to be written to the output or the
3426    name of a template file from which the page is to be constructed. If the name
3427    of a template file is specified, then the second parameter must be present;
3428    otherwise, it must be absent.
3429    
3430    =item varHash (optional)
3431    
3432    If specified, then a reference to a hash mapping variable names for a template
3433    to their values. The template file will be read into memory, and variable markers
3434    will be replaced by data in this hash reference.
3435    
3436    =back
3437    
3438    =cut
3439    
3440    sub ScriptFinish {
3441        # Get the parameters.
3442        my ($webData, $varHash) = @_;
3443        # Check for a template file situation.
3444        my $outputString;
3445        if (defined $varHash) {
3446            # Here we have a template file. We need to determine the template type.
3447            my $template;
3448            if ($FIG_Config::template_url && $webData =~ /\.php$/) {
3449                $template = "$FIG_Config::template_url/$webData";
3450            } else {
3451                $template = "<<$webData";
3452            }
3453            $outputString = PageBuilder::Build($template, $varHash, "Html");
3454        } else {
3455            # Here the user gave us a raw string.
3456            $outputString = $webData;
3457        }
3458        # Check for trace messages.
3459        if ($Destination ne "NONE" && $TraceLevel > 0) {
3460            # We have trace messages, so we want to put them at the end of the body. This
3461            # is either at the end of the whole string or at the beginning of the BODY
3462            # end-tag.
3463            my $pos = length $outputString;
3464            if ($outputString =~ m#</body>#gi) {
3465                $pos = (pos $outputString) - 7;
3466            }
3467            # If the trace messages were queued, we unroll them. Otherwise, we display the
3468            # destination.
3469            my $traceHtml;
3470            if ($Destination eq "QUEUE") {
3471                $traceHtml = QTrace('Html');
3472            } elsif ($Destination =~ /^>>(.+)$/) {
3473                # Here the tracing output it to a file. We code it as a hyperlink so the user
3474                # can copy the file name into the clipboard easily.
3475                my $actualDest = $1;
3476                $traceHtml = "<p>Tracing output to $actualDest.</p>\n";
3477            } else {
3478                # Here we have one of the special destinations.
3479                $traceHtml = "<P>Tracing output type is $Destination.</p>\n";
3480            }
3481            substr $outputString, $pos, 0, $traceHtml;
3482        }
3483        # Write the output string.
3484        print $outputString;
3485    }
3486    
3487  =head3 GenerateURL  =head3 GenerateURL
3488    
3489      my $queryUrl = Tracer::GenerateURL($page, %parameters);      my $queryUrl = Tracer::GenerateURL($page, %parameters);
# Line 3560  Line 3618 
3618      return $retVal;      return $retVal;
3619  }  }
3620    
 =head3 Cmp  
   
     my $cmp = Tracer::Cmp($a, $b);  
   
 This method performs a universal sort comparison. Each value coming in is  
 separated into a leading text part and a trailing number part. The text  
 part is string compared, and if both parts are equal, then the number  
 parts are compared numerically. A stream of just numbers or a stream of  
 just strings will sort correctly, and a mixed stream will sort with the  
 numbers first. Strings with a label and a number will sort in the  
 expected manner instead of lexically.  
   
 =over 4  
   
 =item a  
   
 First item to compare.  
   
 =item b  
   
 Second item to compare.  
   
 =item RETURN  
   
 Returns a negative number if the first item should sort first (is less), a positive  
 number if the first item should sort second (is greater), and a zero if the items are  
 equal.  
   
 =back  
   
 =cut  
   
 sub Cmp {  
     # Get the parameters.  
     my ($a, $b) = @_;  
     # Declare the return value.  
     my $retVal;  
     # Check for nulls.  
     if (! defined($a)) {  
         $retVal = (! defined($b) ? 0 : -1);  
     } elsif (! defined($b)) {  
         $retVal = 1;  
     } else {  
         # Here we have two real values. Parse the two strings.  
         $a =~ /^(\D*)(\d*)$/;  
         my $aParsed = [$1, $2];  
         $b =~ /^(\D*)(\d*)$/;  
         my $bParsed = [$1, $2];  
         # Compare the string parts.  
         $retVal = $aParsed->[0] cmp $bParsed->[0];  
         if (! $retVal) {  
             $retVal = $aParsed->[1] <=> $bParsed->[1];  
         }  
     }  
     # Return the result.  
     return $retVal;  
 }  
   
   
3621  =head3 TrackingCode  =head3 TrackingCode
3622    
3623      my $html = Tracer::TrackingCode();      my $html = Tracer::TrackingCode();
# Line 3649  Line 3648 
3648      return $retVal;      return $retVal;
3649  }  }
3650    
3651    =head3 Clean
3652    
3653        my $cleaned = Tracer::Clean($string);
3654    
3655    Clean up a string for HTML display. This not only converts special
3656    characters to HTML entity names, it also removes control characters.
3657    
3658    =over 4
3659    
3660    =item string
3661    
3662    String to convert.
3663    
3664    =item RETURN
3665    
3666    Returns the input string with anything that might disrupt an HTML literal removed. An
3667    undefined value will be converted to an empty string.
3668    
3669    =back
3670    
3671    =cut
3672    
3673    sub Clean {
3674        # Get the parameters.
3675        my ($string) = @_;
3676        # Declare the return variable.
3677        my $retVal = "";
3678        # Only proceed if the value exists.
3679        if (defined $string) {
3680            # Get the string.
3681            $retVal = $string;
3682            # Clean the control characters.
3683            $retVal =~ tr/\x00-\x1F/?/;
3684            # Escape the rest.
3685            $retVal = CGI::escapeHTML($retVal);
3686        }
3687        # Return the result.
3688        return $retVal;
3689    }
3690    
3691    
3692    
3693    
3694  1;  1;

Legend:
Removed from v.1.104  
changed lines
  Added in v.1.105

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3