I hadn't seen a query_command program for qi on www.mutt.org, so I
wrote one.  (I know they're around, but I was blinded or something and
I missed them.)  I particularly didn't know about the one on Brandon
Long's archive that handles multiple servers, but mine handles them
better anyway. :)

We don't have many mutt users here, but I haven't heard anything from
any of them, so I'll let all of you try it out anyway.

It's a perl script, I'm afraid.  There's a nested hash at the top that
defines your server(s) and parameters that apply to them individually.
At uchicago.edu we have two standard servers, so this was kinda
necessary.  You can turn it to your advantage, too: I put nwu.edu in my
copy, as well, since we're in the same general neighborhood.

The reason I think this is better, btw, are that 1) the awful nested
hash lets you set parameters for each server independently; 2) this one
is a little smarter about using the info available via `siteinfo' to
fill in blanks; and 3) it tries hard to give useful commentary on the
matches.

It doesn't require a client or the perl Net::Ph (or whatever) module.

-- 
-D. [EMAIL PROTECTED]    "Tuna Casserole. Ingredients: 1 large casserole dish.
    NS/ENSA              Place [the dish] in a cold oven. Place a chair facing
    Networking Services  the oven and sit in it forever. Think about how hungry
    Uchicago.Com         you are. When night falls, do not turn on the light."
#!/opt/bin/perl
##
## [EMAIL PROTECTED], evil qi guy
##

###########################################################################
## 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}};
}

Reply via email to