#!/afs/athena/contrib/perl5/perl -w
# -*- cperl -*-

# NOTE: FEEPING CREATURES ARE THE FAULT OF <danw@mit.edu>, HE STARTED IT FIRST.

use IPC::Open2;
use Carp;
use FileHandle;
# use vars qw( @connect @auth @query $debug $align );
# use vars qw( $mrtest @help @argl @retl @fields @qret $i );
# use strict;

sub usage {
  my $info = shift(@_) || '';
  croak "Usage: qy query args... [-db database] [-n]\n${info}Aborting";
}

# Parse the command-line arguments
@connect = ("c");
@auth =    ("a");
@query =   ();

$debug = 0;
$align = 1;		# do we want an option to control this?

while (@ARGV) {
  my $arg = shift(@ARGV);

  if ($arg eq "-D") {
    $debug++;
  } elsif($arg eq "-db") {
    $arg = shift(@ARGV) || usage "No argument specified to -db.\n";
    @connect = ("c $arg");
  } elsif($arg eq "-n") {
    @auth = "";
  } else {
    push(@query, $arg);
  }
}
usage "No query specified.\n"           unless @query;
usage "No query arguments specified.\n" unless (@query > 1);

# $reply = read_reply()
#     Reads the reply from mrtest, up to the next 'moira:  '.
# Returns:
#     $reply --- a string containing the reply
sub read_reply {
  my $reply = '';
  while ($reply !~ /^moira:  $/m) {
    sysread MOIRA, $reply, 1024, length($reply);
  }

  $reply =~ /^moira:  $/m;
  $' && die "internal error: unexpected text following 'moira:  '";	#'  
  $`;
}

# @lines = command(@commands)
#     Sends one or more commands, in order, to mrtest and reads the replies.
# Arguments:
#     @commands --- one or more mrtest commands (each element may contain
#        several commands separated by newlines)
# Returns:
#     @lines --- the replies from mrtest, separated into individual lines
#        (with newlines removed)
sub command {
  my ($cmd, @return);
  foreach $cmd (map {split /\n/} @_) {
    print "[command '$cmd']\n" if $debug;
    print CMDS "$cmd\n";
    push (@return, read_reply);
  }
  map {split /\n/} @return;
}

# Find mrtest.
$mrtest = '/usr/athena/etc/mrtest';
$mrtest = '/usr/local/etc/mrtest'                         unless (-x $mrtest);
$mrtest = '/afs/athena/system/moira/arch/@sys/bin/mrtest' unless (-x $mrtest);
die "Can't find an executable mrtest binary\nAborting"    unless (-x $mrtest);
# [This does more stat()'s than it absolutely needs to, but I don't care. =)]

# Open the pipes to stdout and stdin of mrtest, make the input flushed by Perl
open2(\*MOIRA, \*CMDS, "$mrtest");
autoflush CMDS 1;


read_reply;			# wait for the initial 'moira:  ' prompt
command @connect;		# connect to the server
command @auth    if @auth;	# authenticate to the server (or not)

# get help information on command
@help = command "qy _help $query[0]";
(@help == 2) || die "Unexpected number of lines from 'qy _help'\nAborting";

# parse the help into the argument list and the response list
@argl = split(/, /, ($help[0] =~ /\((.*)\)/)[0]);
@argl || die "No argument list found in output from 'qy _help'\nAborting";
@retl = split(/, /, ($help[0] =~ /=>\s+(.*)$/)[0]);
@retl || die "No return list found in output from 'qy _help'\nAborting";

# make the response list be constant width, so responses are aligned
if ($align) {
  my $retsize = 0;
  foreach (map length($_), @retl) { $retsize = $_ if $retsize < $_; }
  $retsize += 2;  # number of spaces + 1
  @fields = map sprintf("%-${retsize}s", "$_:"), @retl;
} else {
  @fields = map "$_: ", @retl;
}

# send the query to the Moira server
@qret = command "qy @query";
(pop(@qret) =~ /^\d+ tuple/) || die "Unexpected last line from 'qy @query'";

# print out the response from the server
foreach (@qret) {
  my @vals = split(/, /);
  for $i (0..$#fields) {
    print $fields[$i], $vals[$i], "\n";
  }
  print "\n";
}

command "d";			# disconnect from the server