#!/opt/bin/perl
##
## dgc@uchicago.edu, evil qi guy
##
## $Id: mutt_phquery,v 1.1 2000/01/01 00:17:15 dgc Exp $
##

###########################################################################
## Configurable parameters:

## List all Qi servers to check.
##	server	=> hostname of server ($)
##	port	=> service/port, if not the default (csnet-ns/105) ($)
##	fullname=> field containing full name on this server ($)
##	dfields	=> fields with descriptive text about person ([])
##	capnames=> do names need to be coerced into proper capitalization? ($)
##	shownull=> Show records with empty mailbox fields? ($)
@QISVRS = ( {
		server		=> "ns.uchicago.edu",
		port		=> undef,
		fullname	=> "name", 
		dfields		=> \@INFOFIELDS,
		capnames	=> 1,
		shownulls	=> 1,
	},
	{
		server		=> "alumni.uchicago.edu",
		port		=> undef,
		fullname	=> "name", 
		dfields		=> \@INFOFIELDS,
		capnames	=> 1,
		shownulls	=> 1,
	},
#	{
#		server		=> "ns.nwu.edu",
#		port		=> undef,
#		fullname	=> "name", 
#		dfields		=> [qw(title department curriculum text)],
#		capnames	=> 1,
#		shownulls	=> 0,
#	},
## UIUC is s l o w
#	{
#		server		=> "ns.uiuc.edu",
#		port		=> undef,
#		fullname	=> "name", 
#		dfields		=> [qw(title department curriculum text)],
#		capnames	=> 1,
#		shownulls	=> 0,
#	},
);

## Fields to take commentary text from, in precedence order.
@INFOFIELDS = qw(
	title
	appointment
	department
	curriculum
	text
);

## No more config after this.
###########################################################################

use Symbol;
use Socket;
use Sys::Hostname;

($A0 = $0) =~ s:.*/::;

sub max {
	my (@all) = @_;
	my ($x);

	$x = 0;
	for (@all) {
		$x = $_ if ($_ > $x);
	}
	return $x;
}

sub QiConnect {
	my ($host, $port) = @_;
	my @pw;
	my $sock = gensym;
	my $port = getservbyname($port, 'tcp')
		|| getservbyport($port, 'tcp')
		|| getservbyname('csnet-ns', 'tcp')
		|| getservbyname('ns', 'tcp')
		|| getservbyport(105, 'tcp');
	my $sin = sockaddr_in($port, inet_aton($host));
	socket($sock, PF_INET, SOCK_STREAM, getprotobyname('tcp'));
	connect($sock, $sin);
	select $sock; $| = 1; select STDOUT;

	@pw = getpwuid($<);
	print $sock "hello ", $pw[0], "\@", hostname, " [$0]\n";
	while (<$sock>) {
		last if (/^[2-9]/);
	}
	return $sock;
}

if ($#ARGV != 0) {
	print "$A0: usage: $A0 query_exp\n";
	exit 1;
}

($SEARCH = $ARGV[0]) =~ s/\s+/\*/g;

$nresults = 0;
for $svr (@QISVRS) {
	@matches = ();
	$Qi = &QiConnect($svr->{server}, $svr->{port});
	print $Qi "siteinfo\n";
IO:	while (<$Qi>) {
		last IO if (/^[2-9]/);
		chomp;
		($r, $n, $f, $v) = split(/\s*:\s*/, $_);
		if ($f =~ /^maildomain$/) {
			$svr->{maildomain} = "\@$v";
		} elsif ($f =~ /^mailfield$/) {
			$svr->{mailfield} = $v;
		} elsif ($f =~ /^mailbox$/) {
			$svr->{mailbox} = $v;
		}
	}
	@qfields = @{$svr->{dfields}};
	$loops = 1;
	while ($loops > 0) {
		$loops = 0;
		$lastn = 0;
		print $Qi join(' ', "query $SEARCH return",
				$svr->{fullname}, $svr->{mailfield},
				$svr->{mailbox}, @qfields), "\n";
IO:		while (<$Qi>) {
			chomp;
			if (/^502/) {
				print "Too many entries; please narrow your search.\n";
				exit(2);
			}
			last IO if (/^[2-9]/);
			($r, $n, $f, $v) = split(/\s*:\s*/, $_, 4);
			if ($r eq "-507") {
				@qfields = grep (!/^$n$/, @qfields);
				$loops = 1;
			}
			next IO unless ($r eq "-200");
			$lastf = $f if ($f =~ /\S/);
			if ($n != $lastn) {
				$e = {};
				push(@matches, $e);
				$lastn = $n;
			}
			if ($lastf =~ /^$svr->{mailfield}$/) {
				$e->{__email__} = "$v" . $svr->{maildomain};
			} else {
				$e->{$lastf} .= "$v ";
			}
		}
	}
	close($Qi);

	if ($svr->{shownulls}) {
		map {
			$_->{__email__} = "-"
				if (!defined($_->{$svr->{mailbox}}));
		} @matches;
		$svr->{matches} = [@matches];
	} elsif ($svr->{shownulls} == 0) {
		$svr->{matches} = [grep {defined($_->{$svr->{mailbox}})} @matches];
	}

	for $e (@{$svr->{matches}}) {
MISC:		for $field (@{$svr->{dfields}}) {
			last MISC if ($e->{__misc__} = $e->{$field});
		}
	}

	$nresults += $#{$svr->{matches}} + 1 - $[;
}

if ($nresults < 0) {
	printf "No results from Qi servers.\n";
	exit 1;
}

printf("Qi server%s report%s %d result%s\n",
	$#QISVRS?"s":"", $#QISVRS?"":"s", $nresults, $nresults==1?"":"s");

for $svr (@QISVRS) {
	map {
		if ($svr->{capnames} &&
				($_->{$svr->{fullname}} =~ /^[^a-z]+$/) ||
				($_->{$svr->{fullname}} =~ /^[^A-Z]+$/)) {
			#$last = '-';
			#$_->{$svr->{fullname}} = join('', map {
			#	if ($last =~ /[\s-]/) {
			#		$_ = uc($_);
			#	} else {
			#		$_ = lc($_);
			#	}
			#	$last = $_;
			#} split('', $_->{$svr->{fullname}}));
			$_->{$svr->{fullname}} = join(' ', map {
				/(.)(.*)/;
				$_ = uc($1) . lc($2);
			} split(/\s+/, $_->{$svr->{fullname}}));
			#$_->{$svr->{fullname}} =~ s/\s+/ /;
		}
		$out = sprintf "%s\t%s\t%s",
			$_->{__email__} || "-",
			$_->{$svr->{fullname}} || "-",
			$_->{__misc__} || "-";
		$out =~ s/^(.{255}).*/\1/;
		print "$out\n";
	} sort {$a->{$svr->{fullname}} cmp $b->{$svr->{fullname}}}
							@{$svr->{matches}};
}

##
## $Log: mutt_phquery,v $
## Revision 1.1  2000/01/01 00:17:15  dgc
## Initial revision
##
##