eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
& eval 'exec perl -S $0 $argv:q'
if 0;
 
#
# Putbacks Viewer v1.0
# by Alan Harder (alan.harder@sun.com)
# 02121996
#
# THIS SAMPLE PROGRAM IS BEING PROVIDED "AS IS" AND ONLY AS A COURTESY TO
# THE RECIPIENT.  SUN MAKES NO WARRANTY OR REPRESENTATION, EITHER EXPRESS 
# OR IMPLIED WITH RESPECT TO THIS SAMPLE PROGRAM INCLUDING QUALITY, PERF- 
# FORMANCE, FITNESS FOR A PARTICULAR PURPOSE, MERCHANTABILITY, OR NON- 
# INFRINGEMENT.  IN NO EVENT WILL SUN BE LIABLE FOR ANY DIRECT, INDIRECT,  
# SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR  
# INABILITY TO USE THIS SAMPLE PROGRAM. 

require 5.000;
use Tk;
 
sub ReadNext
{
    my($fd) = @_;
    my($line);
    my(%rec);
 
    do {
        $line = <$fd>;
        return(%rec) unless ($line);
     } until ($line =~ /^COMMAND.*putback/);
    do {
        $line = <$fd>;
    } until ($line =~ /^BEGIN COMMENT/);
    while (1) {
        $line = <$fd>;
        last if ($line =~ /^END COMMENT/);
        $rec{'COMMENT'} .= $line;
    }
    while (1) {
        $line = <$fd>;
        last if ($line =~ /^CWD /);
        next if ($line =~ /^update parent's/ || $line =~ /^update children's/);
        $rec{'ACTIONS'} .= $line;
    }
    while ($line !~ /^STATUS/) {
        $line = <$fd>;
        chop $line;
        ($line =~ /^USER (.*)$/        && ($rec{'USER'} = $1) )     ||
        ($line =~ /^HOST (.*)$/        && ($rec{'HOST'} = $1) )     ||
        ($line =~ /^RELEASE (.*)$/     && ($rec{'RELEASE'} = $1) )  ||
        ($line =~ /^STATUS (.*)$/      && ($rec{'STATUS'} = $1) )   ||
        ($line =~ /^START \(([^)]*)\)/ && ($rec{'TIME'} = $1) );
    }
       
    return(%rec);
}
 
sub wordwrap
{
    my($string) = @_;
    my(@lines,@words,@result,$i,$word,$line);
 
    $i=-1;
    @lines = split(/^/,$string);
    while (@lines)
    {
        $i++;
        $line = shift @lines;
        @words = split(/[ \t\n]+/,$line);
        while (@words)
        {
            $word = shift @words;
            if (length($result[$i]) > 0   &&
                (length($word) + length($result[$i]) > 79))
            {
                $i++;
            }
            $result[$i] .= $word . ' ';
        }
    }
       
    return @result;
}
 
sub Update
{
  if ($currentmax > 0)
  {
    *rec = $reclist[$match_table[$currentloc]];
    $title = "PUTBACK from $rec{'USER'}\@$rec{'HOST'}, $rec{'TIME'}.";
    $tk_comment->delete(0,'end');
    $tk_comment->insert('end', &wordwrap($rec{'COMMENT'}));
    $tk_action->delete(0,'end');
    $tk_action->insert('end', split(/^/,$rec{'ACTIONS'}));
    $release = "RELEASE $rec{'RELEASE'}";
    $status = "STATUS $rec{'STATUS'}";
    $number = "Putback #" . ($match_table[$currentloc]+1);
  }
  else
  {
    $title = "<empty>";
    $tk_comment->delete(0,'end');
    $tk_action->delete(0,'end');
    $release = $status = $number = "";
  }
}
 
sub SetLimits
{
    my($i,$name);
    my($n,$c,$u) = (&MakeSafe($name_match), &MakeSafe($comment_match),
                    &MakeSafe($update_match));
    @match_table = ();
    for ($i=0; $i < $reccount; $i++)
    {
        *rec = $reclist[$i];
        $name = $rec{'USER'} . "@" . $rec{'HOST'};
        if ( (!$name_match    ||  $name =~ /$n/i )           &&  
             (!$comment_match ||  $rec{'COMMENT'} =~ /$c/i ) &&
             (!$update_match  ||  $rec{'ACTIONS'} =~ /$u/i ) )
        {
                push(@match_table, $i);
        }
    }
    return @match_table;
}
 
sub AboutDlg
{
    my $top = shift;
    my($dlg,$msg,$ok);
    $dlg = $top->Toplevel(-class => Dialogue);
    $ok = $dlg->Button(-text => "Ok", -command => [\&HideDlg, $dlg]);
    $msg = $dlg->Message(-text => "Putback Viewer\nAlan Harder\nalan.harder\@sun.com\n02121996", -width => "5c", -justify => center);
    $dlg->wm("group",$top);
    $dlg->wm("transient",$top);
    $dlg->wm("withdraw");
    $dlg->wm("minsize",0,0);
    $msg->pack(-side => top, -expand => 1, -fill => x);
    $ok->pack(-side => bottom, -expand => 1);
    $dlg->title("About..");
    return($dlg);
}
 
sub LimitsDlg
{
    my $top = shift;
    my ($dlg,$cancel,$apply,$fr,$f1,$f2,$l1,$t1,$l2,$t2,$l3,$t3);
    $dlg = $top->Toplevel("-class","Dialogue");
    $cancel = $dlg->Button(-text => "Cancel", -command => [\&HideDlg, $dlg]);
    $apply = $dlg->Button(-text => "Apply", -command =>
                          sub{
                                $currentmax = &SetLimits();
                                $currentloc = $currentmax - 1;
                                &HideDlg($dlg);
                                &Update();
                          });
    $fr = $dlg->Frame();
    $f1 = $fr->Frame();
    $f2 = $fr->Frame();
    $l1 = $f1->Label(-text => "Name contains");
    $t1 = $f2->Entry(-relief => sunken, -bd => 2, -width => 30,
                      -textvariable => \$name_match);
    $l2 = $f1->Label(-text => "Comment contains");
    $t2 = $f2->Entry(-relief => sunken, -bd => 2, -width => 30,
                      -textvariable => \$comment_match);
    $l3 = $f1->Label(-text => "Update contains");
    $t3 = $f2->Entry(-relief => sunken, -bd => 2, -width => 30,
                      -textvariable => \$update_match);
    $dlg->wm("group",$top);
    $dlg->wm("transient",$top);
    $dlg->wm("withdraw");
    $dlg->wm("minsize",0,0);
    $l1->pack(-side => top);
    $t1->pack(-side => top);
    $l2->pack(-side => top);
    $t2->pack(-side => top);
    $l3->pack(-side => top);
    $t3->pack(-side => top);
    $f1->pack(-side => left);
    $f2->pack(-side => right);
    $fr->pack(-side => top);
    $apply->pack(-side => left, -expand => 1, -fill => x);
    $cancel->pack(-side => right, -expand => 1, -fill => x);
    $dlg->title("Viewer Limits");
    return $dlg;
}
 
sub ShowDlg
{
    my $dlg = shift;
    my $wm = $wm->MainWindow;
    $dlg->{Cursor} = $wm->cget("-cursor");
    $wm->configure(-cursor => watch);
    $dlg->deiconify;
    $dlg->update;
    $dlg->grab;
}
 
sub HideDlg
{
    my $dlg = shift;
    my $top=$dlg->MainWindow;
    $top->configure(-cursor => $dlg->{Cursor});
    $dlg->grab("release");
    $dlg->withdraw;
}
 
sub MakeSafe
{
        my($string) = @_;
 
        # Add more translations as needed.
        $string =~ s/\|/\\\|/g;
        $string =~ s/\(/\\\(/g;
        $string =~ s/\)/\\\)/g;
        $string =~ s/\[/\\[/g;
        $string =~ s/\]/\\]/g;
        $string =~ s/\"/\\"/g;
        $string =~ s/\$/\\\$/g;
        $string =~ s/\*/\\*/g;
        $string =~ s/\^/\\^/g;
        $string =~ s/\?/\\?/g;
 
        return($string);
}
 
# check ~/.putbacks files
unless (@ARGV)
{
  $config = $ENV{'HOME'} ? $ENV{'HOME'} : (getpwnam(`/usr/ucb/whoami`))[7];
  $config .= '/' unless (substr($config,length($config)-1) eq '/');
  $config .= '.putbacks';
  if (-r $config) {
    open(FD,"<$config");
    $_ = <FD>;
    close(FD);
    chop;
    $ARGV[0] = $_;
  }
}
 
unless (@ARGV && open(FD,"<$ARGV[0]"))
{
  print "unable to open input file ($ARGV[0])\n" if (@ARGV);
  print "usage: $ARGV0 <history file>\nOr put the name of the history file in ~/.putbacks\n";
  exit;
}
 
$varname = "rec00000";
$reccount = 0;
 
while (1)
{
    *rec = $varname;
    %rec = &ReadNext(FD);
    last unless (%rec);
    $reclist[$reccount++] = *rec;
    $varname++;
}
 
close(FD);
$currentmax = &SetLimits();
$currentloc = $currentmax - 1;

$wm = MainWindow->new;
$tk_title = $wm->Message(-textvariable => \$title, -justify => left, -relief => sunken, -bd => 0, -width => "12c");
$tk_comment = $wm->ScrlListbox(-scrollbars => 'se', -width => "80");
$tk_action = $wm->ScrlListbox(-scrollbars => 'se', -width => "80");
$fr = $wm->Frame();
$tk_release = $fr->Message(-textvariable => \$release, -justify => left, -width => "4c");
$tk_status  = $fr->Message(-textvariable => \$status,  -justify => center, -width => "4c");$tk_number  = $fr->Message(-textvariable => \$number,  -justify => right, -width => "4c");
$prev = $wm->Button(-text => "<< Prev", -command => sub{ if ($currentloc>0) {$currentloc--; &Update();} });
$next = $wm->Button(-text => "Next >>", -command => sub{ if ($currentloc<$currentmax-1) {$currentloc++; &Update();} });
$limdlg = &LimitsDlg($wm);
$limit = $wm->Button(-text => "Limits..", -command => sub{ &ShowDlg($limdlg); });
$abdlg = &AboutDlg($wm);
$about = $wm->Button(-text => "About..", -command => sub{ &ShowDlg($abdlg); });
$quit = $wm->Button(-text => "Quit", -command => sub{ exit; });
 
$tk_title->pack(-side => top, -fill => x);
$tk_comment->pack(-side => top, -fill => x);
$tk_action->pack(-side => top, -fill => x);
$tk_release->pack(-side => left, -expand => 1, -fill => x);
$tk_status->pack(-side => left, -expand => 1, -fill => x);
$tk_number->pack(-side => right, -expand => 1, -fill => x);
$fr->pack(-side => top, -fill => x);
$prev->pack(-side => left, -expand => 1, -fill => x);
$next->pack(-side => left, -expand => 1, -fill => x);
$limit->pack(-side=> left, -expand => 1, -fill => x);
$about->pack(-side=> left, -expand => 1, -fill => x);
$quit->pack(-side => left, -expand => 1, -fill => x);
 
$wm->title("PUTBACK Viewer");
&Update();
 
MainLoop;

