#!/usr/local/bin/perl

# $Id: PTDB.pl,v 1.2 1994/11/23 19:02:32 bates Exp $
# Client for two-level index lookups.
$Usage = "$0 Configuration_file";

die "$Usage\n" unless -r ($Config = shift);

open(CONFIG, "< $Config");      # Load CONFIG into %Config
while (<CONFIG>) {
    chop;
    die "Configuration line is not of form \"Key = value\"\n$_\n"
       unless (/(\w+)\s*=\s*(.*)$/); 
    $Config{$1} = ($Config{$1}) ? $Config{$1} . "\n" . $2 : $2;
}

die "Configuration file must define ClientDir, Port, Server, and Subroutines.\n"
    unless $Config{'ClientDir'} && $Config{'Port'} && $Config{'Server'}
           && $Config{'Subroutines'};

$opt_pattern = $Config{'OptPattern'};
$opt_pattern = "rp" unless $opt_pattern;
require("getopts.pl");
&Getopts($opt_pattern);
$force_raw = 1 if $opt_r;
$prompt = $Config{'Prompt'} . " " if $Config{'Prompt'};
unless (@ARGV) {
    print STDERR $Config{'Welcome'}, "\n" if $Config{'Welcome'};
    print STDERR $prompt if $prompt;
    $tty = -t STDIN;
}

( $pager = $ENV{'PAGER'} ) || ( $pager = "more" );
require("$Config{'ClientDir'}/$Config{'Subroutines'}");


$AF_INET = 2;                   # Now open a socket to the server.
$SOCK_STREAM = 1;

$sockaddr = 'S n a4 x8';

chop($hostname = `hostname`);

($name,$aliases,$proto) = getprotobyname('tcp');
($name,$aliases,$Config{'Port'}) = getservbyname($Config{'Port'},'tcp')
    unless $Config{'Port'} =~ /^\d+$/;
($name,$aliases,$type,$len,$thisaddr) =
       gethostbyname($hostname);
($name,$aliases,$type,$len,$thataddr) = gethostbyname($Config{'Server'});

$this = pack($sockaddr, $AF_INET, 0, $thisaddr);
$that = pack($sockaddr, $AF_INET, $Config{'Port'}, $thataddr);

die $! unless socket(S, $AF_INET, $SOCK_STREAM, $proto);
die $! unless bind(S, $this);
die $! unless connect(S, $that);

# Set socket and STDOUT to be command buffered.

select(S); $| = 1; select(STDOUT); $| = 1;

# Should avoid deadlock by forking but it gets too complicated
$login = getlogin || (getpwuid($<))[0];
die "Server did not connect:\n\tResponse was $_\n"
    unless ($_ = <S>) =~ /^099 Connect/;
print S $login, "\n";
die "Server did not become ready:\n\tResponse was $_\n"
    unless ($_ = <S>) =~ /^100 Ready/;

( $pager = $ENV{'PAGER'} ) || ( $pager = "more" );


if ( @ARGV ) {
    $SIG{'PIPE'} = 'short_plumber';
    $_ = join(" ",@ARGV);
    &open_pager;
    &do_query;
    &close_pager;
    exit 0;
}

$SIG{'PIPE'} = 'plumber';
                               # use a select loop to be able to examine both
                               # both STDIN and S for input
$rin = '';
vec($rin, fileno(STDIN), 1) = 1;
vec($rin, fileno(S), 1) = 1;
$ein = $rin;
 INPUT: while ($nfound = select($rout = $rin, undef, $eout = $ein, undef)) {
     if ($nfound && vec($rout, fileno(S), 1)) {        # line from server
        if (($_ = <S>) =~ /^103\s*/) { die "$'\n"; }
        elsif (/^100/) { next; }
        else {
            die "Unexpected server message\n$_\n";
        }
     } elsif ($nfound && vec($eout, fileno(S), 1)) { # exception on server
        die "Exception condition on server port\n";
     } elsif ($nfound && vec($eout, fileno(STDIN), 1)) { # exception on STDIN
        die "Exception condition on standard input\n";
     } elsif ($nfound && vec($rout, fileno(STDIN), 1)) { # usual situation
        unless ($_ = <STDIN>) { exit 0;}
        chop;
        s/^\s+//;
        $force_raw = 0 unless $opt_r;
        if (/^q$/) {
            print S "q\n";
            die "Server did not shut down properly:\nResponse was $_\n"
                unless ($_ = <S>) =~ /^101 Goodbye/;
            exit 0;
        }
        elsif ( /(^r\s*[|>])|(^raw\s*[|>])/ ) {
            $force_raw = 1;
            s/^[raw\s]*//;
        }
        elsif ( /^[-+]/ ) {
            s/^/ /;
            s/\s([-+])/ $1 /g;
            for(split(' ')) {
                if    ( /^\+$/ ) { $add = 1;}
                elsif ( /^-$/ )  { $add = 0;}
                else  { $Last =~ s/ *\b$_\b */ /g;
                        if ( $add ) { $Last = "$Last $_";}
                    }
            }
            $_ = $Last;
            s/\s+/ /g;  s/^\s*//;  s/\s*$//; 
            $Last = $_;
            &freq_print("[Modified query is: $_]\n");
        }
        if (/^>/) {
            $file = $_;
            $file =~ s/^[\s>]*//;
            $ok = 1;
            if (-s $file && -t STDIN && -t STDOUT && !/^>>/) {
                print STDERR "OK to overwrite file $file ? [y] ";
                $ans = <STDIN>;
                $ok = ( $ans =~ /^\s*y/i || $ans eq "\n" );
            }
            next unless $ok;
        }
        if (/^[|>]+/) {
            if (open(OUT, $_)) {
                &reprint;
                close(OUT);
            } else {
                print STDERR "Can't open '$_' for writing: $!\n";
            }
        }
        elsif (/^!!(.*)/) {
            $ofh = select(STDERR);
            eval $1;
            print "\n";
            select($ofh);
        }
        elsif (/^!(.*)/) {
            system $1;
        }
        elsif ( /^[a-zA-Z0-9]/ ) {
            &open_pager;
            &do_query;
            &close_pager;
        }
        elsif ( (/^$/ || /\(null\)/) && $tty ) {
            &open_pager;
            &freq_print("[Looking up '$Last' again...]\n") if $Last;
            &reprint;
            &close_pager;
        }
        elsif ( /^?$/ ) {
            &open_pager;
            print "
Input     Action
------    -----------
word(s)   Find entries in database containing these query word(s).
+word(s)  Add word(s) to last query, and rerun the query.
-word(s)  Delete word(s) from last query, and rerun the query.
             Note: + and - lists may be mixed on the same line.
(null)    Rerun last query.
>file     Rerun last query, writing output to file.
>>file    Rerun last query, appending output to file.
|cmd      Rerun last query, piping output through unix command 'cmd'.
r>file    Rerun last query, writing RAW output to file.
r>>file   Rerun last query, appending RAW output to file.
r|cmd     Rerun last query, piping RAW output through unix command 'cmd'.
!cmd      Escape to shell to run unix command(s) 'cmd', then return.
!!cmd     Run the Perl command(s) 'cmd', then continue.
?         Print this help screen.
q         Quit.

";
             &close_pager;
         }
        else {
            print STDERR "What???\n";
        }
    }
} continue {
    &freq_print("[Current query is: $Last]\n") if $prompt;
    print STDERR $prompt if $prompt;
}

exit 0;
      
sub open_pager {
    if ($opt_p) { open(OUT, ">-"); }
    else {
       ($pg_open = open(OUT, "|($pager || true)")) || open(OUT,">-");
    }
    $| = 1;
}

sub close_pager {
    close OUT;
}

sub do_query {
    $Last = $_ if $_;
    undef(@Last_cites);
    print S $_, "\n";
    while (<S>) {
       last if /^100 Ready/;   # Possibly add a time-out here?
       chop;
       push(@Last_cites, $_);
       if (/^[12]10 /) {
           print OUT "=" x 20, "\n", $', "\n";
           $add_row = 1;
       } elsif (/^510 /) {
           if ($add_row) { print OUT "=" x 20, "\n"; }
           else { print OUT "\n";}
           if ($force_raw) { print OUT substr($_,4), "\n";}
           else { &pretty(*OUT, substr($_,4));}
           $add_row = 0;
       }
    }
}

sub reprint {
    if ($force_raw) {
       for (@Last_cites) { print OUT $',"\n" if /^510 /;}
    } else {
       for (@Last_cites) {
           if (/^[12]10 /) {
               print OUT "=" x 20, "\n", $', "\n";
               $add_row = 1;
           } elsif (/^510 /) {
               if ($add_row) { print OUT "=" x 20, "\n"; }
               else { print OUT "\n";}
               &pretty(*OUT, substr($_,4));
               $add_row = 0;
           }
       }
    }
}
                       
sub freq_print {
    local($s) = join('',@_);
    local($Cols) = $cols ? $cols : 75 ;
    unless($prefix) {
       $prefix = "...";
       $lprefix = length($prefix);
    }
    if ( length($s) + $fplen >= $Cols - 1 ) {
       print "\n";
       $s =~ s/^ //;
       $fplen = $lprefix;
    }
    print $prefix if $fplen <= $lprefix;
    print $s;
    $fplen += length($s);
    $fplen = 0 if $s =~ /\n$/;
}

sub plumber {
    while (<S>) {
       last if /^100 Ready/;   # Possibly add a time-out here?
       chop;
       push(@Last_cites, $_);
    }
    close OUT;
    &freq_print("[Current query is: $Last]\n") if $prompt;
    print STDERR $prompt if $prompt;
    goto INPUT;
}

sub short_plumber {
    close(S);
    exit 1;
}
