[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.64, Thu Sep 14 23:06:00 2006 UTC revision 1.65, Tue Sep 19 19:28:48 2006 UTC
# Line 33  Line 33 
33      use File::stat;      use File::stat;
34      use LWP::UserAgent;      use LWP::UserAgent;
35      use Time::HiRes 'gettimeofday';      use Time::HiRes 'gettimeofday';
36        use URI::Escape;
37    
38  =head1 Tracing and Debugging Helpers  =head1 Tracing and Debugging Helpers
39    
# Line 1906  Line 1907 
1907      my $query = CGI->new();      my $query = CGI->new();
1908      # Check for tracing. Set it up if the user asked for it.      # Check for tracing. Set it up if the user asked for it.
1909      if ($query->param('Trace')) {      if ($query->param('Trace')) {
1910          # Set up tracing to be queued for display at the bottom of the web page.          # Set up tracing.
1911          TSetup($query->param('Trace') . " FIG Tracer", "QUEUE");          my $ttype = ($query->param('TF') ? ">$FIG_Config::temp/Trace$$.log" : "QUEUE");
1912            TSetup($query->param('Trace') . " FIG Tracer", $ttype);
1913          # Trace the parameter and environment data.          # Trace the parameter and environment data.
1914            TraceParms($query);
1915        } else {
1916            # Here tracing is to be turned off. All we allow is errors traced into the
1917            # error log.
1918            TSetup("0", "WARN");
1919        }
1920        # Create the variable hash.
1921        my $varHash = { DebugData => '' };
1922        # Return the query object and variable hash.
1923        return ($query, $varHash);
1924    }
1925    
1926    =head3 TraceParms
1927    
1928    C<< Tracer::TraceParms($query); >>
1929    
1930    Trace the CGI parameters at trace level CGI => 3 and the environment variables
1931    at level CGI => 4.
1932    
1933    =over 4
1934    
1935    =item query
1936    
1937    CGI query object containing the parameters to trace.
1938    
1939    =back
1940    
1941    =cut
1942    
1943    sub TraceParms {
1944        # Get the parameters.
1945        my ($query) = @_;
1946          if (T(CGI => 3)) {          if (T(CGI => 3)) {
1947              # Here we want to trace the parameter data.              # Here we want to trace the parameter data.
1948              my @names = $query->param;              my @names = $query->param;
# Line 1926  Line 1960 
1960                  Trace("ENV: $envName = $ENV{$envName}");                  Trace("ENV: $envName = $ENV{$envName}");
1961              }              }
1962          }          }
     } else {  
         # Here tracing is to be turned off. All we allow is errors traced into the  
         # error log.  
         TSetup("0", "WARN");  
     }  
     # Create the variable hash.  
     my $varHash = { DebugData => '' };  
     # If we're in DEBUG mode, set up the debug mode data for forms.  
     if (Tracer::DebugMode) {  
         $varHash->{DebugData} = GetFile("Html/DebugFragment.html");  
     }  
     # Return the query object and variable hash.  
     return ($query, $varHash);  
1963  }  }
1964    
1965  =head3 ScriptFinish  =head3 ScriptFinish
# Line 2398  Line 2419 
2419      return ($inserted, $deleted);      return ($inserted, $deleted);
2420  }  }
2421    
2422    =head3 GetLine
2423    
2424    C<< my @data = Tracer::GetLine($handle); >>
2425    
2426    Read a line of data from a tab-delimited file.
2427    
2428    =over 4
2429    
2430    =item handle
2431    
2432    Open file handle from which to read.
2433    
2434    =item RETURN
2435    
2436    Returns a list of the fields in the record read. The fields are presumed to be
2437    tab-delimited. If we are at the end of the file, then an empty list will be
2438    returned. If an empty line is read, a single list item consisting of a null
2439    string will be returned.
2440    
2441    =back
2442    
2443    =cut
2444    
2445    sub GetLine {
2446        # Get the parameters.
2447        my ($handle) = @_;
2448        # Declare the return variable.
2449        my @retVal = ();
2450        # Read from the file.
2451        my $line = <$handle>;
2452        # Only proceed if we found something.
2453        if (defined $line) {
2454            # Remove the new-line.
2455            chomp $line;
2456            # If the line is empty, return a single empty string; otherwise, parse
2457            # it into fields.
2458            if ($line eq "") {
2459                push @retVal, "";
2460            } else {
2461                push @retVal, split /\t/,$line;
2462            }
2463        }
2464        # Return the result.
2465        return @retVal;
2466    }
2467    
2468    =head3 PutLine
2469    
2470    C<< Tracer::PutLine($handle, \@fields); >>
2471    
2472    Write a line of data to a tab-delimited file. The specified field values will be
2473    output in tab-separated form, with a trailing new-line.
2474    
2475    =over 4
2476    
2477    =item handle
2478    
2479    Output file handle.
2480    
2481    =item fields
2482    
2483    List of field values.
2484    
2485    =back
2486    
2487    =cut
2488    
2489    sub PutLine {
2490        # Get the parameters.
2491        my ($handle, $fields) = @_;
2492        # Write the data.
2493        print $handle join("\t", @{$fields}) . "\n";
2494    }
2495    
2496    =head3 GenerateURL
2497    
2498    C<< my $queryUrl = Tracer::GenerateURL($page, %parameters); >>
2499    
2500    Generate a GET-style URL for the specified page with the specified parameter
2501    names and values. The values will be URL-escaped automatically. So, for
2502    example
2503    
2504        Tracer::GenerateURL("form.cgi", type => 1, string => "\"high pass\" or highway")
2505    
2506    would return
2507    
2508        form.cgi?type=1&string=%22high%20pass%22%20or%20highway
2509    
2510    =over 4
2511    
2512    =item page
2513    
2514    Page URL.
2515    
2516    =item parameters
2517    
2518    Hash mapping parameter names to parameter values.
2519    
2520    =item RETURN
2521    
2522    Returns a GET-style URL that goes to the specified page and passes in the
2523    specified parameters and values.
2524    
2525    =back
2526    
2527    =cut
2528    
2529    sub GenerateURL {
2530        # Get the parameters.
2531        my ($page, %parameters) = @_;
2532        # Prime the return variable with the page URL.
2533        my $retVal = $page;
2534        # Loop through the parameters, creating parameter elements in a list.
2535        my @parmList = map { "$_=" . uri_escape($parameters{$_}) } keys %parameters;
2536        # If the list is nonempty, tack it on.
2537        if (@parmList) {
2538            $retVal .= "?" . join("&", @parmList);
2539        }
2540        # Return the result.
2541        return $retVal;
2542    }
2543    
2544  1;  1;

Legend:
Removed from v.1.64  
changed lines
  Added in v.1.65

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3