[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.122, Wed Jul 1 19:37:24 2009 UTC revision 1.129, Tue Jan 5 17:25:48 2010 UTC
# Line 1062  Line 1062 
1062    
1063  =head3 ETracing  =head3 ETracing
1064    
1065      ETracing($parameter);      ETracing($parameter, %options);
1066    
1067  Set up emergency tracing. Emergency tracing is tracing that is turned  Set up emergency tracing. Emergency tracing is tracing that is turned
1068  on automatically for any program that calls this method. The emergency  on automatically for any program that calls this method. The emergency
# Line 1083  Line 1083 
1083  is a CGI object and emergency tracing is not on, the C<Trace> and  is a CGI object and emergency tracing is not on, the C<Trace> and
1084  C<TF> parameters will be used to determine the type of tracing.  C<TF> parameters will be used to determine the type of tracing.
1085    
1086    =item options
1087    
1088    Hash of options. The permissible options are given below.
1089    
1090    =over 8
1091    
1092    =item destType
1093    
1094    Emergency tracing destination type to use if no tracing file is found. The
1095    default is C<WARN>.
1096    
1097    =item noParms
1098    
1099    If TRUE, then display of the saved CGI parms is suppressed. The default is FALSE.
1100    
1101    =item level
1102    
1103    The trace level to use if no tracing file is found. The default is C<0>.
1104    
1105  =back  =back
1106    
1107  =cut  =cut
1108    
1109  sub ETracing {  sub ETracing {
1110      # Get the parameter.      # Get the parameter.
1111      my ($parameter) = @_;      my ($parameter, %options) = @_;
1112      # Check for CGI mode.      # Check for CGI mode.
1113      if (defined $parameter && ref $parameter eq 'CGI') {      if (defined $parameter && ref $parameter eq 'CGI') {
1114          $SavedCGI = $parameter;          $SavedCGI = $parameter;
1115      } else {      } else {
1116          $SavedCGI = undef;          $SavedCGI = undef;
1117      }      }
1118      # Default to no tracing except errors.      # Check for the noParms option.
1119      my ($tracing, $dest) = ("0", "WARN");      my $noParms = $options{noParms} || 0;
1120        # Get the default tracing information.
1121        my $tracing = $options{level} || 0;
1122        my $dest = $options{destType} || "WARN";
1123      # Check for emergency tracing.      # Check for emergency tracing.
1124      my $tkey = EmergencyKey($parameter);      my $tkey = EmergencyKey($parameter);
1125      my $emergencyFile = EmergencyFileName($tkey);      my $emergencyFile = EmergencyFileName($tkey);
1126      if (-e $emergencyFile) {      if (-e $emergencyFile && (my $stat = stat($emergencyFile))) {
1127          # We have the file. Read in the data.          # We have the file. Read in the data.
1128          my @tracing = GetFile($emergencyFile);          my @tracing = GetFile($emergencyFile);
1129          # Pull off the time limit.          # Pull off the time limit.
# Line 1109  Line 1131 
1131          # Convert it to seconds.          # Convert it to seconds.
1132          $expire *= 3600;          $expire *= 3600;
1133          # Check the file data.          # Check the file data.
         my $stat = stat($emergencyFile);  
1134          my ($now) = gettimeofday;          my ($now) = gettimeofday;
1135          if ($now - $stat->mtime > $expire) {          if ($now - $stat->mtime <= $expire) {
             # Delete the expired file.  
             unlink $emergencyFile;  
         } else {  
1136              # Emergency tracing is on. Pull off the destination and              # Emergency tracing is on. Pull off the destination and
1137              # the trace level;              # the trace level;
1138              $dest = shift @tracing;              $dest = shift @tracing;
1139              my $level = shift @tracing;              my $level = shift @tracing;
             # Convert the destination to a real tracing destination.  
             # temp directory.  
             $dest = EmergencyTracingDest($tkey, $dest);  
1140              # Insure Tracer is specified.              # Insure Tracer is specified.
1141              my %moduleHash = map { $_ => 1 } @tracing;              my %moduleHash = map { $_ => 1 } @tracing;
1142              $moduleHash{Tracer} = 1;              $moduleHash{Tracer} = 1;
1143              # Set the trace parameter.              # Set the trace parameter.
1144              $tracing = join(" ", $level, sort keys %moduleHash);              $tracing = join(" ", $level, sort keys %moduleHash);
1145          }          }
     } elsif (defined $SavedCGI) {  
         # There's no emergency tracing, but we have a CGI object, so check  
         # for tracing from the form parameters.  
         if ($SavedCGI->param('Trace')) {  
             # Here the user has requested tracing via a form.  
             $dest = ($SavedCGI->param('TF') ? ">$FIG_Config::temp/Trace$$.log" : "QUEUE");  
             $tracing = $SavedCGI->param('Trace') . " Tracer";  
         }  
1146      }      }
1147        # Convert the destination to a real tracing destination.
1148        $dest = EmergencyTracingDest($tkey, $dest);
1149      # Setup the tracing we've determined from all the stuff above.      # Setup the tracing we've determined from all the stuff above.
1150      TSetup($tracing, $dest);      TSetup($tracing, $dest);
1151      # Check to see if we're a web script.      # Check to see if we're a web script.
1152      if (defined $SavedCGI) {      if (defined $SavedCGI) {
1153          # Yes we are. Trace the form and environment data.          # Yes we are. Trace the form and environment data if it's not suppressed.
1154            if (! $noParms) {
1155          TraceParms($SavedCGI);          TraceParms($SavedCGI);
1156            }
1157          # Check for RAW mode. In raw mode, we print a fake header so that we see everything          # Check for RAW mode. In raw mode, we print a fake header so that we see everything
1158          # emitted by the script in its raw form.          # emitted by the script in its raw form.
1159          if (T(Raw => 3)) {          if (T(Raw => 3)) {
# Line 1333  Line 1344 
1344      # Declare the return variable.      # Declare the return variable.
1345      my $retVal;      my $retVal;
1346      # Determine the parameter type.      # Determine the parameter type.
1347      if (! defined $parameter || defined($ENV{TRACING})) {      if (! defined $parameter) {
1348          # Here we're supposed to check the environment. If that fails, we          # Here we're supposed to check the environment. If that fails, we
1349          # get the effective login ID.          # get the effective login ID.
1350          $retVal = $ENV{TRACING} || scalar getpwuid($<);          $retVal = $ENV{TRACING} || scalar getpwuid($<);
# Line 4128  Line 4139 
4139          <img src="http://s20.sitemeter.com/meter.asp?site=s20nmpdr" alt="Site Meter" border="0"/></a>          <img src="http://s20.sitemeter.com/meter.asp?site=s20nmpdr" alt="Site Meter" border="0"/></a>
4140          </noscript>          </noscript>
4141          <!-- Copyright (c)2006 Site Meter -->          <!-- Copyright (c)2006 Site Meter -->
         <script type="text/javascript">  
         var gaJsHost = (("https:" == document.location.protocol) ? "https://ssl." : "http://www.");  
         document.write(unescape("%3Cscript src='" + gaJsHost + "google-analytics.com/ga.js' type='text/javascript'%3E%3C/script%3E"));  
         </script>  
         <script type="text/javascript">  
         try {  
             var pageTracker = _gat._getTracker("UA-9588384-1");  
             pageTracker._trackPageview();  
         } catch(err) {}</script>  
4142  END_HTML  END_HTML
4143      }      }
4144      return $retVal;      return $retVal;

Legend:
Removed from v.1.122  
changed lines
  Added in v.1.129

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3