#!/usr/bin/perl 
## show -- list specified messages to the standard output
## Copyright (c) 2000 Christopher League; see LICENSE for details

## I require these packages:
##  - DBI-1.11 (Generic database interface)
##  - MailTools-1.13 (RFC822 message parsing) by Graham Barr
use DBI;
use Mail::Internet;
use Mail::Header;
use Getopt::Long;
use strict;

## Descriptive text
my $version = "0.1";

my $version_text =
"show (Meba) $version
Copyright (c) 2000 Christopher League
Meba comes with ABSOLUTELY NO WARRANTY.
You may redistribute and/or modify Meba under the terms of the 
GNU General Public License;  see the file LICENSE for details.
";

my $usage_text = 
"Usage: show [OPTIONS] [NUMS] ...
List each message number in NUMS to the standard output.

  -P, --pager=PROGRAM  pipe the each message through PROGRAM
  -H, --headers=LIST   comma-separated list of headers to show
  -c  --conf-file=FILE read configuration from FILE (default meba.conf)
      --help           display this help and exit
      --version        output version information and exit

The following options override the settings in the meba.conf file:

  -d, --database=NAME  name of database to use (default to meba_`whoami`)
  -t, --prefix=TEXT    prefix table names with `TEXT' (default `')
  -h, --host=HOST      host running the database server (default to localhost)
      --port=NUM       port number to use for connection, if non-standard
  -u, --user=NAME      login to server as this user (default to current user)
  -p, --password=TEXT  password to use when connecting to server

Report bugs to meba-bugs\@contrapunctus.net.
";

##### BAD DUPLICATION: 
##### The option-processing stuff is almost the same as in `insert'

## We want command line options to override configuration file settings,
## but the user can specify a configuration file as a command line 
## option!  The solution is to parse the command line options first,
## putting the results into a hash called `cmd_line_options'.  Then
## we look for and parse the configuration file(s), putting the results
## into the hash `options'.  Finally, we merge the `cmd_line_options'
## into `options', giving precedence to the former.
my %cmd_line_options;
my %options;
$options{user} = getpwuid $<;     # Q: do I want real or effective UID here?
$options{database} = "meba_$options{user}";

## These are the specs for command-line options
my @cmd_line_specs = 
    (\%cmd_line_options, 
     "database|d=s", "host|h=s", "conf-file|c=s", "pager|P=s",
     "password|p=s", "port=s", "user|u=s", "verbose|v", "prefix|t=s",
     "headers|H:s", "help", "version" );

## Parse the command line into `cmd_line_options'.
my $getopt_result = GetOptions (@cmd_line_specs);

## If the user wanted the usage or version blurbs, then we can 
## output them and stop now.
print STDERR $usage_text and exit 1
    if $cmd_line_options{help};

print STDERR $version_text and exit 2
    if $cmd_line_options{version};

## If there was an error in the command line options, we can
## also stop now.
unless ($getopt_result) {
    print STDERR "Try `$0 --help' for more information.\n";
    exit 3;
}

## Next, look for and parse the configuration file(s).
## We read each of the following files, in reverse order.
## That way the FIRST file in this list has precedence.
my @conf_file_list = ("./meba.conf", "$ENV{HOME}/.meba.conf");

## Put user-specified configuration file at head of list.
unshift @conf_file_list, $cmd_line_options{"conf-file"}
    if $cmd_line_options{"conf-file"};

## Read configuration file(s) in reverse order..
my $conf_file;
while ($conf_file = pop @conf_file_list) { # for each potential conf file
    if(open (CONF, $conf_file)) {      # if it can be opened,
        print "Reading $conf_file...\n" if $cmd_line_options{verbose};
        while(<CONF>) {                # read each line
            chop;
            if (/\s*\#.*/) { }         # ignore comments
            elsif (/\s*([\w\.]+)\s*\=\s*(.*)/) { # varname = value
                $options{$1} = $2;
            }
            elsif (/\s*/) { }           # ignore blank lines
            else {
                print STDERR "$conf_file:$.: bad configuration command\n";
                print STDERR "Try `$0 --help' for more information.\n";
                exit 5;
            }
        }
        close CONF;
    }
    else {
        print "Configuration file $conf_file could not be opened.\n"
            if $cmd_line_options{verbose};
    }
}

## Open up modularized names in the conf file, such as "show.XXX"
my ($k, $v);
while (($k, $v) = each %options) {
    if ($k =~ /^show\.(.*)/) {
        $options{$1} = $options{$k};
    }
}

## Now we need to merge the `cmd_line_options' into `options', 
## giving priority to the former in case of conflict.
my @cmd_line_keys = keys %cmd_line_options;
my $key;
while ($key = shift @cmd_line_keys) {
    $options{$key} = $cmd_line_options{$key};
}

## Verbosity: dump key/value pairs in %options
if ($options{verbose}) {
    my $key; my $value;
    print "Configuration:\n";
    while (($key, $value) = each %options) {
        print "  $key = $value\n";
    }
}

##### END OF OPTION PROCESSING, now on to the important stuff...

## Determine arguments to connect()
my $data_source = "DBI:mysql:$options{database}";
if ($options{host}) {
    $data_source .= ":$options{host}";
    $data_source .= ":$options{port}" if $options{port};
}
print "Connect ($data_source, $options{user}, $options{password})\n"
    if $options{verbose};

## Go ahead and connect
my $db;
$db = DBI->connect ($data_source, $options{user}, $options{password})
    || exit 6;

## Which headers to show?
my @show_headers = split /\s*,\s*/, $options{headers};

## Process each message number in ARGV
my $num;
while ($num = shift @ARGV) {
    print "Fetching message $num...\n" if $options{verbose};
    my $q = 
"SELECT headers, body FROM $options{prefix}message 
WHERE message_num = $num
";
    print $q if $options{verbose};
    my $s = $db->prepare ($q);
    $s->execute or exit 8;
    my ($headers, $body) = $s->fetchrow_array;
    $s->finish;
    ## open up pager as an output stream
    open (OUT, "|$options{pager}") or die "Could not execute `$options{pager}'";
    print OUT "[Message $num]\n";
    ## print the selected headers.  to do this, we will use the MailTool
    ## header module.  First, split the headers into lines...
    my @heads = split /\n/, $headers;
    @heads = map "$_\n", @heads;
    my $head = new Mail::Header \@heads;
    my $tag;
    foreach $tag (@show_headers) {
        my $t = $head->get($tag);
        print OUT "$tag: $t" if $t;
    }
    print OUT "\n$body";
    ## remove `unseen' tag from message
    $q = 
"DELETE FROM $options{prefix}tag 
WHERE tag = 'unseen' AND message_num = '$num'
";
    print $q if $options{verbose};
    $s = $db->prepare ($q);
    $s->execute or exit 8;
    $s->finish;
    close OUT;
}

## All done -- disconnect and exit
unless ($options{"dry-run"}) {
    $db->disconnect || die "Error disconnecting: " . $db->errstr;
}
exit 0;

##### END OF MAIN PROGRAM
