#!/usr/bin/perl
# #!/usr/bin/perl -w

#---------------------------------------------------------------------#
# This source code is (c)1999 Dave Belfer-Shevett - shevett@pobox.com #
# see http://www.stonekeep.com/license.html for licensing information #
#---------------------------------------------------------------------#

# ----------------------------------------------------------------------
#  Written by David H. Silber for Stonekeep Consulting.
#  david@SilberSoft.com -- http://www.SilberSoft.com/
# ----------------------------------------------------------------------

# ----------------------------------------------------------------------
#  keycli.pl
#  $Id:
# ----------------------------------------------------------------------

# ----------------------------------------------------------------------
# This is keycli.pl, which provides a command-line interface to the
# Keystone system.
#
# This release of keycli.pl only includes read capabilities.  Extra
# features to add and modify data will come later.
# ----------------------------------------------------------------------

# ----------------------------------------------------------------------
#  Note that the `-w' option to perl was removed from the interpreter
#  line, as I am getting an extra warning from the Slip::full() method.
#  I'll put it back as soon as I figure out a better way to disable
#  those messages.
# ----------------------------------------------------------------------

# ----------------------------------------------------------------------
#  History:

# ----------------------------------------------------------------------
#  Find the directory from which we were called, and add that to the
#  @INC list.
use FindBin;
unshift (@INC, $FindBin::RealBin);

# ----------------------------------------------------------------------
#  These global variables are accessed from within certain packages.
#  (SlipList, Slip, Status, People)
use vars qw($debug $username $keystone);

# ----------------------------------------------------------------------
#  To keep me honest.
use strict;

# ----------------------------------------------------------------------
#  Used to send results via email.
use Mail::Internet;

# ----------------------------------------------------------------------
#  Used for command-line option processing.
use Getopt::Long;

# ----------------------------------------------------------------------
#  Used to extract the base filename.
use File::Basename;

# ----------------------------------------------------------------------
#  The Keystone method is used to process the configuration file and
#  make the initial connection to the database.
require Keystone;

# ----------------------------------------------------------------------
#  This manages a list of Keystone slips.
require SlipList;

# ----------------------------------------------------------------------
#  Utilities that don't really belong in a package.
require Utilities;



# ----------------------------------------------------------------------
#  Parse the configuration file and connect to the database.
$keystone = new Keystone ( 'debug' => 0 );


# ----------------------------------------------------------------------
#  Set up the available command-line options.
my %options;

GetOptions( \%options,
    #  Mode options:
    "h", "help", "l", "list",

    #  Debugging switch:
    "debug",

    #  Selection options:
    "slip=i", "status=s", "parent=i", "currtech=s", "priority=i",

    #  Output formatting options:
    "b", "brief", "full", "children", "oneline", 

    #  Mail options:
    "mailreply=s", "replyto=s",
);


# ----------------------------------------------------------------------
#  Check to see if debugging mode is on.
if ($options{debug}) {
  print STDERR "Debugging mode on!\n";
  $debug = $options{debug};

  print STDERR "Command-Line Switches:\n";
  foreach my $item (keys( %options )) {
    print STDERR "--" . $item . "='" . $options{$item} . "'\n";
  }
}

#  Keep track of the user's name.
$username = $ENV{USER};

# ----------------------------------------------------------------------
#  Provide help, if requested...
if ($options{help} || $options{h}) {
  print help();
  exit;
}


# ----------------------------------------------------------------------
#  If no mode specified, default to --list.
if ((! $options{list}) && (! $options{l})) {
  print "No mode specified.  Defaulting to --list.\n";
}


# ----------------------------------------------------------------------
#  No mode or --list or -l specified, so default to --list.
my $displaytext;

#  If none of the selection options have been specified,
if ((! $options{slip}) && (! $options{status}) &&
    (! $options{parent}) && (! $options{currtech}) &&
    (! $options{priority})) {
  #  Set the default selection criteria:
  $options{currtech} = $username;
  $options{priority} = 1;
  print "No selection criteria specified.  Defaulting to " .
      "--currtech=" . $options{currtech} . " --priority=" .
      $options{priority} .  ".\n";
}

#  Build a hash of database fields to selection criteria from which
#  a SQL WHERE clause can be generated.
my %where;
foreach my $item ('slip', 'status', 'parent', 'currtech', 'priority' ) {
  #  The WHERE clause contains only those criteria that we are
  #  concerned with.  Most selection criteria names cleverly match
  #  the equivalent database field name.  The exceptions would not
  #  make for very user-friendly parameters.
  if (($item eq 'slip') && ($options{'slip'})) {
    $where{'sid'} = $options{'slip'};
  }
  elsif (($item eq 'parent') && ($options{'parent'})) {
    $where{'spid'} = $options{'parent'};
  }
  else {
    $options{$item} ? $where{$item} = $options{$item} : 1;
  }
}

#  Get the requested list of slips.
my $sliplist = new SlipList ( \%where, $keystone, $options{children} );

#  Pick the appropriate display format...
if ($options{full}) {
  $displaytext = $sliplist->display( "full" );
}
elsif ($options{oneline}) {
  $displaytext = $sliplist->display( "oneline" );
}
else {
  $displaytext = $sliplist->display( "brief" );
}

#  Display to the standard output, or mail, as requested.
if ($options{mailreply}) {
  email( $displaytext, $options{mailreply}, $options{replyto} );
}
else {
  print $displaytext;
}

exit;


# ----------------------------------------------------------------------
#  email() -- Display keycli.pl output via email
#
#  Use the Mail::Internet and Mail::Header packages to construct a
#  message around the text provided and send it.  If their files exist,
#  introduction and trailer messages can be added to the email message.
#
#  Parameters:
#    text -- Results of query.
#    mailto -- email address to send the message
#    mailreply -- email address to which any responses should be
#        directed.
# ----------------------------------------------------------------------
sub email {
  my ($text, $mailto, $mailreply) = @_;


  my $intro;    #  Text of introduction (if any).
  my $trailer;  #  Text to put after the query results.

  #  Make sure that the mailto address is valid.
  isemail( $mailto ) || die "Invalid --mailreply address.";

  #  Create the email message.
  my $mail = Mail::Internet->new() || die ("Failed: $!\n");

  #  Set up the email message's header.
  my $header = $mail->head;
  $header->add( "To", $mailto );
  $header->add( "Reply-To", $mailreply ) if isemail( $mailreply );
  $header->add( "Subject", "Results from Keystone" );

  #  Get the introduction and trailer, if any.
  $intro = textfile( "$FindBin::RealBin/templates/keycli_mail_intro.txt" );
  $trailer = textfile( "$FindBin::RealBin/templates/keycli_mail_trailer.txt" );

  #  Put together the email message's body.
  $mail->body( $intro . $text . $trailer );

  #  Send it!
  $mail->smtpsend();
}


# ----------------------------------------------------------------------
#  isemail() -- Confirm that a string contains a valid email address.
#
#  Currently, this only checks that the address contains an `@'.  Other
#  checks can be added later, as needed.
#
#  Parameters:
#    address -- String to check for a valid email address.
#
#  Returns:
#    true, if the address is valid.
# ----------------------------------------------------------------------
sub isemail {
  my ($address) = @_;

  return grep /@/, $address;
}


# ----------------------------------------------------------------------
#  textfile() -- Read a text file into a string.
#
#  Parameter:
#    filename -- Name of the file to read.
#
#  Returns:
#    A string containing the contents of the text file or an empty
#    string, if the file is empty, does not exist, or can not be read.
# ----------------------------------------------------------------------
sub textfile {
  my ($filename) = @_;


  my $filedata = "";  #  Built the result string here.
  my $temp;           #  Temporary holder for text.

  if (-e $filename) {
    open INTRO, $filename;
    while (read INTRO, $temp, 1024) {
      $filedata .= $temp;
    }
  }

  return $filedata;
}



# ----------------------------------------------------------------------
#  help() -- Display keycli.pl help message.
#
#  Returns:
#    A string containing help text.
# ----------------------------------------------------------------------
sub help {
  my $self = shift;

  my $retval = $keystone->banner();

$retval .= <<EOF;
Usage:  keycli <Mode> [Criteria] [Output]

Modes:
--help          Display this help text.
--list          List requested data.
(If no mode is specified, then --list mode is presumed.)

Selection Criteria:
--slip=n        Specify the slip to report on.
--parent=n      Select slips whose parent is `n'.
--status=c      Select slips with status `c'.
--currtech=s    Specify the current tech for selected slips.
--priority=n    Select slips with a priority of `n'.
(If none of the above are specified, then priority 1 slips for the current
user are displayed.)
--children      Include all children of that match the selection criteria.

Output Options:
--brief         The results are trimmed down to a single line per slip.
--full          All the information for is displayed for each slip.
--oneline       One line of comma-separated data is displayed per slip.
--mailreply=s   Mail the results to address `s'.
--replyto=s     Set the "Reply-To:" header for mailed results.
--debug         Show debugging information on STDERR.
(The --brief option is the default.)


For more information, go to http://www.stonekeep.com/ or refer to
the Keystone documentation.
EOF

  return $retval;
}

1;

__END__

=head1 NAME

keycli - The Keystone Command-Line Interface

=head1 SYNOPSIS 

	keycli <mode> [Criteria] [Output]

	keycli --help

	keycli [--list] [--slip=n] [--parent=n] [--status=c] [--currtech=s]
	    [--priority=n] [--children] [--brief] [--full] [--oneline]
	    [--mailreply=s [--replyto=s]] [--debug]

=head1 DESCRIPTION

The keycli program provides access to Keystone from a shell prompt.

This version of keycli only supports query operations.

=for html
Details of the use of this program can be found in
<a href=http:../keycli.html>the keycli user's guide</a>.

=for text
Details of the use of this program can be found in the keycli user's guide.

=head1 CAVEATS

The main part of the program defines a few variables which are used by
the various Keystone database classes.
It would be better if there were no such dependencies, but these were
set up in the name of expediency:
  $main::username -- the name of the current user (from $ENV{USER}).
  $main::debug -- set, if the debugging option was specified.
  $main::keystone -- a Keystone object.

=head1 AUTHOR

David H. Silber
of Silber Software Engineering
F<E<lt>david@SilberSoft.comE<gt>>
wrote this for StoneKeep Consulting
as part of the B<keycli> development effort.

=head1 SEE ALSO

L<Keystone>, L<SlipList>, L<Utilities>

=cut
