#!/afs/athena/contrib/perl/perl

$dbmdata = "/mit/sipb/lib/@sys/findprog.db";
$verbose = 1;
$pager = $ENV{"PAGER"} || "more";
%progdb = ();

sub print_entry {
	local ($prog, $info) = @_;
        if (!defined $info) {
		print "no entry for $prog\n";
		return;
	}
	$info =~ s/\013/\n\t/; # decode newlines
	($desc, $locker, $catpath, $comments) = split (/\|/, $info);
	if ($verbose) {
		print <<"EOT";
Program Name: $prog
Description: $desc
Location: $locker
Comments: $comments 

For more information, read the man page in
the $locker locker as follows:

	athena% add $locker
	athena% man $prog
EOT
	} else {
		print "$prog - $desc ($locker)\n";
	}
}

sub help {
	print <<"EOH";
Typing a program name displays information for
that program.

Other Commands: 

	? 		- print this message
	verbose 	- set verbose mode (default)
	terse		- set terse mode
	man prog	- show the man page for the program prog
	search regexp   - display all records matching the
			  perl regular expression regexp.
			  (regexp searches are always
			   terse.)
	quit (or ^D)	- quit program
EOH
}

sub show_man_page {
	local ($prog) = @_;
	local ($info) = $progdb{$prog};
	local (*PAGER, *CATPAGE);
	if (!defined $info) {
		print STDERR "no entry for $prog\n";
		return;	
	}
	local ($catpage) = (split (/\|/, $info))[2];
	if (! -r $catpage) {
		print STDERR "formatted man page for $prog not found\n";
		return;
	}
        $SIG{'PIPE'} = "IGNORE";
	open (PAGER, "|$pager") || die  "$0: error opening pipe to $pager: $!";
	open (CATPAGE, "<$catpage") || die "$0: error opening $catpage: $!"; 
	while (<CATPAGE>) {
		print PAGER;
	}
	close CATPAGE;
	close PAGER;
	$SIG{'PIPE'} = "DEFAULT";
}

sub regexp_search {
	local ($regexp) = @_;
	local ($prog, $info, $tmp);
	local ($found) = 0;
	local (*PAGER);
	local ($saved_verbose) = $verbose;
	
	$verbose = 0; # searches are always terse

	study $regexp;
	while (($prog, $info) = each %progdb) {
		$tmp = $prog . $info;
		if (eval { $tmp =~ /$regexp/i; }) {
			if (! $found) {
				$SIG{'PIPE'} = 'IGNORE';
				open (PAGER, "|$pager")
				 || die "$0: error opening pipe to $pager: $!";
			}
			$found = 1;
			select PAGER;
			&print_entry ($prog, $info);
			select STDOUT;
		}
                if ($@) {
			print "You gave a bad regular expression:\n";
			print STDERR $@;
			$verbose = $saved_verbose;
			return;
		}
	}
	if (! $found) {
		print STDERR "no matches found for $regexp\n";
	} else  {
		close PAGER;
	}
	$verbose = $saved_verbose;
}

sub do_request {
	chop;
	y/A-Z/a-z/;
	s/^[ \t]+//;
	s/[ \t]+$//;
	if (/^\?*$/o) {
		&help ();
		return;
	}
	if (/^verbose$/o) {
		$verbose = 1;
		print "verbose mode set\n";
		return;
	}
	if (/^terse$/o) {
		$verbose = 0;
		print "terse mode set\n";
		return;
	}
	if (/^man/o) {
		s/^man[ \t]+//;
		&show_man_page ($_);
		return;
	}
	if (/^search/o) {
		s/^search[ \t]+//;
		&regexp_search ($_);
		return;
	}
	if (/^quit/o) {
		dbmclose (progdb);
		exit (0);
	}
	&print_entry ($_, $progdb{$_});
}


sub print_argv {
	print join (":", @ARGV), "\n";
}

dbmopen (progdb, $dbmdata, 0666) || die "$0: error in dbmopen(): $!";

if ($#ARGV == -1) { # interactive
	print "Type ? for help.\n";
	print "findprog> ";
	while (<>) {
		&do_request ($_);
		print "findprog> ";
	}
} else { # parse command line args
	while (@ARGV && ($_ = $ARGV[0])) {
		y/A-Z/a-z/;
		if (/^-verbose$/) {
			$verbose = 1;
			shift (@ARGV);
			next;
		}
		if (/^-terse$/) {
			$verbose = 0;
			shift (@ARGV);
			next;
		}
		if (/^-man$/) {
			shift (@ARGV);
			&show_man_page ($ARGV[0]);
			shift (@ARGV);
			next;
		}
		if (/^-search$/) {
			shift (@ARGV);
			&regexp_search ($ARGV[0]);
			shift (@ARGV);
			next;
		}
		if (/^-\?|-help$/) {
			&help ();
			shift (@ARGV);
			next;
		}
		&print_entry ($_, $progdb{$_});
		shift (@ARGV);
	}
}

dbmclose (progdb);