[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.100, Thu May 8 14:38:44 2008 UTC revision 1.101, Thu May 8 18:03:10 2008 UTC
# Line 700  Line 700 
700              # First, the date, in a very specific format.              # First, the date, in a very specific format.
701              my $date = strftime("%a, %02e %b %H:%M:%S %Y ", localtime) .              my $date = strftime("%a, %02e %b %H:%M:%S %Y ", localtime) .
702                  (tz_local_offset() / 30);                  (tz_local_offset() / 30);
             # We'll put the link and title in here.  
             my ($link, $title);  
703              # Environment data goes in here.              # Environment data goes in here.
704              my $environment;              my $environment;
705              # HTML-escape the message.              # HTML-escape the message and remove excess space.
706              my $escaped = CGI::escapeHTML($message);              my $title = CGI::escapeHTML($message);
707                $title =~ s/\s+/ /gs;
708                # Compute the title from the message. If it's too long, we have to
709                # split it up.
710                if (length $title > 60) {
711                    $title = substr($title, 0, 50) . "...";
712                }
713                # We'll put the link in here.
714                my $link;
715              # If we have a CGI object, then this is a web error. Otherwise, it's              # If we have a CGI object, then this is a web error. Otherwise, it's
716              # command-line.              # command-line.
717              if (defined $SavedCGI) {              if (defined $SavedCGI) {
718                  # We're in a web service. The title is the user's IP, and the link                  # We're in a web service. The environment is the user's IP, and the link
719                  # is the URL that got us here.                  # is the URL that got us here.
720                  my $key = $ENV{HTTP_X_FORWARDED_FOR} || $ENV{REMOTE_ADDR};                  my $key = $ENV{HTTP_X_FORWARDED_FOR} || $ENV{REMOTE_ADDR};
721                  $title = "Event Reported at IP address $key: $escaped";                  $environment = "Event Reported at IP address $key.";
722                  $link = $SavedCGI->url(-full => 1, -query => 1);                  $link = $SavedCGI->url(-full => 1, -query => 1);
723                  # We need the user agent string and (if available) the referrer.                  # We need the user agent string and (if available) the referrer.
724                  $environment = "User Agent $ENV{HTTP_USER_AGENT}";                  $environment .= "User Agent $ENV{HTTP_USER_AGENT}";
725                  if ($ENV{HTTP_REFERER}) {                  if ($ENV{HTTP_REFERER}) {
726                      $environment .= " referred from $ENV{HTTP_REFERER}"                      $environment .= " referred from $ENV{HTTP_REFERER}"
727                  }                  }
# Line 723  Line 729 
729                  $environment .= ". ";                  $environment .= ". ";
730              } else {              } else {
731                  # No CGI object, so we're a command-line tool. Use the tracing                  # No CGI object, so we're a command-line tool. Use the tracing
732                  # key and the PID as the user identifier.                  # key and the PID as the user identifier, and add the command.
733                  my $key = EmergencyKey();                  my $key = EmergencyKey();
734                  $title = "Event Reported by $key Process $$: $escaped";                  $environment = "Event Reported by $key Process $$. Command $ENV{_}.";
735                  # Set the link to the development NMPDR. There is really no good                  # Set the link to the development NMPDR. There is really no good
736                  # choice here.                  # choice here.
737                  $link = "http://$FIG_Config::dev_server";                  $link = "http://$FIG_Config::dev_server";
                 # We need the command  
                 $environment = "Command $ENV{_}.";  
738              }              }
739              # Build a GUID. We use the current time, the title, and the process ID,              # Build a GUID. We use the current time, the title, and the process ID,
740              # then digest the result.              # then digest the result.
741              my $guid = Digest::MD5::md5_base64(gettimeofday(), $title, $$);              my $guid = Digest::MD5::md5_base64(gettimeofday(), $title, $$);
742              # Finally, the description. This is a stack trace plus various environmental stuff.              # Finally, the description. This is a stack trace plus various environmental stuff.
743                # We have a goofy thing here in that we need to HTML-escape some sections of the description
744                # twice. They will be unescaped once when processed by the RSS reader. First, the stack
745                # trace.
746                my $stackTrace = "";
747              my @trace = LongMess();              my @trace = LongMess();
748              my $trace = join "; ", @trace;              # Only proceed if we got something back.
749              my $description = CGI::escapeHTML("$environment Stack trace: $trace");              if (scalar(@trace) > 0) {
750                    $trace[0] =~ s/Tracer::Warn.+?called/Event occurred/;
751                    $stackTrace = "Stack trace:<pre>" . join("\n", @trace, "</pre>");
752                }
753                my $basicDescription = CGI::escapeHTML($message) . "<br /><br />" .
754                        CGI::escapeHTML($environment) . $stackTrace;
755              # Okay, we have all the pieces. Create a hash of the new event.              # Okay, we have all the pieces. Create a hash of the new event.
756              my $newItem = { title => $title,              my $newItem = { title => $title,
757                              description => $description,                              description => CGI::escapeHTML($basicDescription),
758                              link => $link,                              link => $link,
759                              category => $LastCategory,                              category => $LastCategory,
760                              pubDate => $date,                              pubDate => $date,
# Line 784  Line 797 
797              # Add our new item at the front.              # Add our new item at the front.
798              unshift @{$items}, $newItem;              unshift @{$items}, $newItem;
799              # Replace the file.              # Replace the file.
800              my $xml = XML::Simple::XMLout($rss, NoAttr => 1, RootName => 'rss', XmlDecl => '<?xml version="1.0" encoding="utf-8"?>',              my $xml = XML::Simple::XMLout($rss, NoAttr => 1, RootName => 'rss version="2.0"', XmlDecl => '<?xml version="1.0" encoding="utf-8"?>',
801                                            NoEscape => 1);                                            NoEscape => 1);
802              # We don't use Open here because we can't afford an error.              # We don't use Open here because we can't afford an error.
803              if (open XMLOUT, ">$fileName") {              if (open XMLOUT, ">$fileName") {

Legend:
Removed from v.1.100  
changed lines
  Added in v.1.101

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3