#!/usr/local/ls6/perl/bin/perl
#                              -*- Mode: Perl -*- 
# inspect -- 
# ITIID           : $ITI$ $Header $__Header$
# Author          : Ulrich Pfeifer
# Created On      : Fri Nov 10 12:54:53 1995
# Last Modified By: Ulrich Pfeifer
# Last Modified On: Tue Nov 14 16:55:17 1995
# Language        : Perl
# Update Count    : 152
# Status          : Unknown, Use with caution!
# 
# (C) Copyright 1995, Universitt Dortmund, all rights reserved.
# 
# $Locker: pfeifer $
# $Log: inspect,v $
# Revision 2.1  1995/12/13  14:56:35  pfeifer
# *** empty log message ***
#
# Revision 2.0.1.1  1995/11/16  12:24:51  pfeifer
# patch11: Examin Wais databases in directories given on the command
# patch11: line. Needs Curses.
#
# Revision 1.1  1995/11/10  14:04:16  pfeifer
# Initial revision
#
# 

use Curses;
use Wais;

@dbdirs = (
           '/home/robots/wais/wais-sources',
           '/usr/local/ls6/src/freeWAIS-sf-2.0/FIELD-EXAMPLE',
           );


if ($#ARGV < $[) {
    @ARGV = @dbdirs;
}


initscr;                        # Set $COLS,$LINES

for $dir (@ARGV) {
    for $dbsrc ( <$dir/*.src> ) {
        $dbsrc =~ m:$dir/(.*)\.src$:;
        $db = $1;
        push(@db,$db);
        $dbdir{$db} = $dir;
    }
}

while (1) {
    $db = &Select("Select a database", '', @db);
    last unless $db;

    $dbpr = $dbdir{$db}."/${db}_field_";
    @fld = ('text');
    for $fieldf ( <$dbpr*.dct> ) {
        $fieldf =~ m:$dbpr(.*)\.dct:;
        push(@fld, $1);
    }
    $fld = &Select("Select a field", '', @fld);
    &Examin($dbdir{$db}."/$db", $fld) if $fld;
}

endwin;
resetty;
exit;

sub Examin {
    my($db,$field)= @_;
    my(@words, %words, $word);

    while (1) {
        $prefix = &Select("Select a prefix", '', '<none>', 0 .. 9, "a" .. "z");
        last unless length($prefix);
        $prefix = '' if $prefix eq '<none>';
        $field  = '' if $field eq 'text';
    
        if ($field) {
            if ($prefix) {
                %words = Wais::dictionary($db, $field, $prefix.'*');
            } else {
                %words = Wais::dictionary($db, $field);
            }
        } else {
            if ($prefix) {
                %words = Wais::dictionary($db, $prefix.'*');
            } else {
                %words = Wais::dictionary($db);
            }
        }
        while (1) {
            $word = &Select("Select a word", 
                            sub {display_wc($_[0],$words{$_[1]})}, 
    sort keys %words);
            last unless $word;
            &Postings($db,$field,$word);
        }
    }
}

sub Postings {
    my($db,$field, $word)= @_;
    my(%postings, @post);
    my $hl = 'Here are the postings';
    my ($sel,$did);

    if ($field) {
        %postings = &Wais::postings($db, $field, $word);
    } else {
        %postings = &Wais::postings($db,  $word);
    }
    for (sort {$a <=> $b} keys %postings) {
        my @p = @{$postings{$_}};
        my $w = shift @p;

        push(@post, sprintf("%6d %5.3f %s ", $_, $w, join(',', @p)));
    }
    while (1) {
        $sel = &Select('Select a posting', sub {diplay_headline($db, @_)}, @post);
        last unless length($sel);
        ($did) = ($sel =~ /^\s*(\d+)/);
#        endwin;
#        print '#' x 20, "\n";
#        print &Wais::document($db,$did);
#        print "\n", $Wais::errmsg,"\n";
#        sleep 5;
        { 
          my $width = $COLS -5;
          my @lines = grep($_ = sprintf("%-${width}s", $_), 
                           split (/\n/,  &Wais::document($db,$did)));
        &Select('View the document', '', @lines);
      }
        }
}

sub diplay_headline {
    my ($db, $win, $line) = @_;
    my ($did) = ($line =~ /^\s*(\d+)/);
    my $hl =&Wais::headline($db, $did);

    $win->addstr(0,0, $hl);
    $win->clrtoeol;
    $win->refresh;
}

sub display_wc {
    my ($win, $wc) = @_;

    $win->addstr(0,0, sprintf "%5d", $wc);
    $win->clrtoeol;
    $win->refresh;
}

sub maxl {
    my(@lines) = @_;
    my $result = 8;

    for (@lines) {
        if (length($_)>$result) {
            $result = length($_);
        }
    }
    $result;
}

sub Select {
    my($msg, $func, @lines) = @_;
    my $items  = $#lines+1;
    my $iteml  = &maxl(@lines);
    my $cols   = (int($COLS/($iteml+2)))?int($COLS/($iteml+2)):1;
    my $lines  = $LINES-4;
    my $pages  = int($items/($lines*$cols))+1;
    my $select = 0;
    my $win    = new Curses ($lines+2,$COLS,1,0);
    my $inp    = new Curses (1,$COLS,$LINES-1,0);
    my $tiw    = new Curses (0,$COLS,0,0);
    my $offset = 0;
    my $result;
    my $iop    = $lines*$cols;

    unless (int($COLS/($iteml+2))) {
        for (@lines) {
            $_ = substr($_, 0, $COLS-4);
        }
        $iteml = $COLS-4;
    }
    $tiw->addstr($msg);
    $tiw->refresh();
    $win->box('|', '-');
    $win->leaveok(1);
    $inp->refresh();
    noecho();
    cbreak();
    $inp->keypad(1);
    $inp->leaveok(1);
    if (ref $func) {
        &{$func}($inp,@lines[$select]);
    }
    while (1) {
        my $sel    = $select;
        my $co     = $offset;
        &Redraw($win, $cols, $lines, $iteml, 
                $offset, $select,@lines);
        $ch = $inp->getch();
        if    ($ch == KEY_UP)    { $sel -= $cols}
        elsif ($ch == KEY_DOWN)  { $sel +=$cols}
        elsif ($ch == KEY_RIGHT) { $sel +=1}
        elsif ($ch == KEY_LEFT)  { $sel -=1}
        elsif (ord($ch) == 10)   { $result = $lines[$select]; last; }
        elsif (ord($ch) == 22)   { $co+=$iop; }
        elsif ($ch == KEY_NPAGE) { $co+=$iop; }
        elsif ($ch == KEY_PPAGE) { $co-=$iop; }
        elsif (ord($ch) ==118)   { $co-=$iop; }
        elsif ($ch eq "q")       { $result = ''; last; }
        else { $inp->addstr(ord($ch)); }
        
        if ($co != $offset) {
            if ($co < 0) {
                $co = 0;
            } elsif ($co > $items) {
                $co = $offset;
            }

            $sel -= ($offset - $co);

            $offset = $co;
        }
        if (($sel >= $offset+$iop) && ($sel < $items)) {
            $offset += $cols if $offset+$cols <= $items;
        } elsif (($sel < $offset) && ($sel >= 0)) {
            $offset -= $cols if $offset-$cols >= 0;
        } 
        if (($sel >= 0) && ($sel < $items)) {
            $select = $sel;
            if (ref $func) {
                &{$func}($inp,@lines[$select]);
            }
        } else {
            beep;
        }
        #$tiw->addstr(0,20,"offset=$offset cursor=$select ");
        #$tiw->clrtoeol;
        #$tiw->refresh;
    }
    $win->delwin;
    $inp->delwin;
    $tiw->delwin;
    return $result;
}
    
sub Redraw {
    my ($win, $cols, $lines, $iteml, $offset, $select, @lines) = @_;

    ROW: for $row (1 .. $lines) {
        for $col (1 .. $cols) {
            $win->attron(A_REVERSE) if ($offset == $select);
            #print STDERR "($row, ($col-1)*($iteml+2)", $lines[$offset++], "\n";
            $win->addstr($row, ($col-1)*($iteml+2)+2, 
                         sprintf ("%-${iteml}s", $lines[$offset]));
            $win->attrset(A_NORMAL) if ($offset == $select);
            $offset++;
            #$win->attroff(A_REVERSE) if ($offset == $select);
            #last ROW if $offset > $#lines;
        }
    }
    $win->refresh;
}
