: # use perl eval 'exec $ANTELOPE/bin/perl -S $0 "$@"' if 0; use lib "$ENV{ANTELOPE}/data/perl" ; # Copyright (c) 2005 Boulder Real Time Technologies, Inc. # # This software module is wholly owned by Boulder Real Time # Technologies, Inc. Any use of this software module without # express written permission from Boulder Real Time Technologies, # Inc. is prohibited. require "getopts.pl" ; if ( ! &Getopts('nv') || @ARGV != 1 ) { my $pgm = $0 ; $pgm =~ s".*/"" ; die ( "Usage: $pgm [-nv] incident-report\n" ) ; } use Datascope ; use Tk ; use Tk::widgets qw(JPEG) ; use Tk::NoteBook ; use Tk::LabEntry ; use Tk::BrowseEntry ; use Tk::Balloon ; use Tk::Frame ; use Tk::LabFrame ; use Tk::Pane ; use ptkform ; use ptkalert ; use rt ; $MW = MainWindow->new ; $MW->setPalette("#e0e0e0") ; $frame=$MW->Scrolled("Frame", -height=>800, -scrollbars=>'e') ->pack(-side=>"top", -expand=>"yes", -fill=>"both") ; $filename = shift ; $Tmpdir = "/tmp/snap$$" ; mkdir $Tmpdir, 0775 ; if ( $filename =~ /\.(Z|gz)/ ) { open ( IN, "gunzip < $filename|" ) ; } elsif ( $filename =~ /\.(bz2)/ ) { open ( IN, "bunzip2 < $filename|" ) ; } else { open ( IN, $filename ) ; } while (getln()) { chomp ; if ( /^(\w+) Report/ ) { $title = $_ ; } elsif ( m"^\s*\d+/\d\d/\d\d\d\d \(\d+\)" ) { push(@date, "$_\n") ; } elsif ( /^\S+ \(\d+\) died from signal/ ) { $why = $_ ; show("Date", @date) ; show("Why", $why) ; } elsif ( /^> (.*)/ ) { &collect ($1) ; } elsif ( /^(To|From|Subject|Date): / ) { # ignore } elsif ( ! /^\s*$/ ) { print STDERR "ignoring line:\n\t'$_'\n" ; } } ptkform($frame, \%Var, \%Widget, @Specs) ; while (@Buttons) { $name = shift(@Buttons) ; $header = shift(@Buttons); $text = shift(@Buttons) ; $nlines = shift(@Buttons) ; $Widget{$name}->configure(# -relief=>"flat", -pady=>0, -command=>[\&showtext, $header, $text, $nlines]) ; } $MW->Button(-command=>\&cleanup, -fg=>"red", -text=>"Quit" ) ->pack(-side=>"top", -fill=>"x", -expand=>"yes" ) ; &MainLoop ; &cleanup ; sub cleanup { system ( "rm -rf $Tmpdir" ) if -d $Tmpdir ; rtkill ( rtchildren($$) ) ; $MW->destroy() ; exit 0 ; } sub collect { my ($header) = @_ ; my @info = () ; while ( getln() ) { if ( /^> / ) { putbak($_) ; show($header, @info) ; last ; } else { push(@info, $_) ; } } } sub showtext { my ($name, $text, $nlines) = @_ ; if ( $nlines < 400 ) { my $t = ptkshow_text($MW, $text) ; $t->see("end") ; my $top = $t->toplevel() ; $top->title($name) ; } else { rtbkg ( "xvile $text" ) ; } } sub show { my ($header, @info) = @_ ; while ( @info > 0 && $info[-1] =~ /^\s*$/ ) { pop(@info) ; } my $n = @info ; printf STDERR "(%3d) $header\n", $n if $opt_v ; $cnt++ ; if ( $n == 0 ) { my ($name, $value) = split ( ':', $header, 2 ) ; push (@Specs, "label label$cnt - +,0 $name" ) ; $Var{"label$cnt"} = $value ; } elsif ( $n < 3 ) { push (@Specs, "label label$cnt - +,0 $header" ) ; $Var{"label$cnt"} = join("\n", @info) ; } else { $text = "$Tmpdir/text$cnt" ; open ( TEXT, ">$text" ) or die ( "Can't open $text to write: $!\n" ) ; print TEXT @info ; close TEXT ; push (@Specs, "button button$cnt - +,0 $header" ) ; push (@Buttons, "button$cnt", $header, $text, $n ) ; } } sub getln { if ( @stack > 0 ) { $_ = shift (@stack) ; } else { $_ = ; } } sub putbak { push(@stack, @_) ; }