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

use strict;
use FindBin;
use Mail::Internet;
use DBI;
use Safe;
unshift @INC, "/u/roy/code";
require Text::Template;
use Carp;



# $Id: Keystone.pm,v 1.45 2000/12/28 18:20:11 nclemons Exp $
#


# ----------------------------------------------------------------------
#  Most of this was written by others.  Some parts added by David H.
#  Silber for Stonekeep Consulting and marked with ``DHS''.
#  david@SilberSoft.com -- http://www.SilberSoft.com/
# ----------------------------------------------------------------------

# ----------------------------------------------------------------------
#  For the strftime() function. -- DHS
use POSIX;


=head1 NAME

Keystone - The Keystone database.

=head1 SYNOPSIS 

        require Keystone;

	$value = $keystone->config_var( <configuration variable> );

	$keystone = new Keystone ( 'debug' => 0 );

	$dateformat = $keystone->dateformat();

	$datewidth = $keystone->datewidth();

Internal methods:

	$self->builddateformat();

=head1 DESCRIPTION

A Keystone object is the means of access to the local Keystone database.

=head1 DATA FORMAT

A Keystone object is a hash of information.
Generally, the externally references value is C<dbh>, the 
handle for the connected Keystone database.

=head1 METHODS

=cut

# ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

=head2 new() -- Construct a Keystone object.

Read in the configuration file, converting the PHP3 variables to Perl
variables in a special name-space.
Connect to the Keystone database.
Collects the contents of the status table.

=over 4

=item Use:

  require Keystone;

  $keystone = new Keystone ( 'debug' => 0 );

=item Parameters:

=over 4

=item Hash of information.

Currently, only the C<debug> value is recognized.

=back

=item Returns:

A Keystone object.

=back

=cut # +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

my $expand_made=0;

sub new {
    my $class = shift;
    bless my $self = {}, $class;

    # Supports only ( 'key' => val ) format for now.
    #
    my %param = @_;

    $self->{debug} = $param{debug} || 0;

    #  Set up the possible file name candidates and the list to put the
    #  winners into.  -- DHS
    my @files;
    my $etcconffile = "/etc/keystone/keystone.conf";
    my $etcdeffile  = "/etc/keystone/keystone.conf.default";

    my $path = $param{'path'} || "$FindBin::RealBin/../conf";

    my $conffile = "$path/keystone.conf";
    my $deffile  = "$path/keystone.conf.default";

    #  If configuration files have been installed under /etc, use them
    #  in preference to the original configuration files.  -- DHS
    if (-e $etcconffile && -e $etcdeffile) {
      @files = ($etcdeffile, $etcconffile);
    }
    else {
      @files = ($deffile, $conffile);
    }

    # Try and parse the conf file...
    foreach my $files (@files) {
	open(CFILE, "$files") ||
	    die "Keystone.pm: cannot open config file $files : $!\n";

	while (<CFILE>) {
	    $_ =~ /^\s*#/ and next;
	    $_ =~ /^\s*$/ and next;
	    $_ =~ s/\<\?//;
	    $_ =~ s/\?\>//;
	    $_ =~ s/\@/\\@/g;
	    $_ =~ s/;.*$/;/;
	    chop;

	    # Perl hashes are with { }, not [ ].  This fix is bad because there
	    # might be a [ or ] on the RHS that we will munge, but it's a quick
	    # fix and I'm too lazy to do it right. -SJH
	    $_ =~ tr/\[\]/\{\}/;

	    # To use $sys_ it has to be a global variable in 'use vars' and
	    # that just ain't pretty. So, let's use our own namespace for
	    # them!
	    #
	    $_ =~ s/sys_/KEY_SYS::/g;

	    eval($_);
	    die "$@" if $@;
        }

	close(CFILE);
    }

    if ($self->{debug}) {
       	print "Keystone.pm: Connecting to '$KEY_SYS::dbname' on '$KEY_SYS::dbhost'...\n";
    }

    $KEY_SYS::server =~ s/^postgresql$/Pg/;

    # port=port as well, but no port stored in the conf file...
    #
    if ($KEY_SYS::server eq 'Pg') {
	$self->{dbh} = DBI->connect(
	    "DBI:$KEY_SYS::server:dbname=$KEY_SYS::dbname;host=$KEY_SYS::dbhost",
	    $KEY_SYS::dbuser, $KEY_SYS::dbpasswd) ||
		die "Keystone.pm: $KEY_SYS::server database connect failed: $DBI::errstr\n";
    } else {
	$self->{dbh} = DBI->connect(
	    "DBI:$KEY_SYS::server:$KEY_SYS::dbname;$KEY_SYS::dbhost",
	    $KEY_SYS::dbuser, $KEY_SYS::dbpasswd) ||
		die "Keystone.pm: $KEY_SYS::server database connect failed: $DBI::errstr\n";
    }

    if ($self->{debug}) {
	print "Keystone.pm: Connected. \n";
    }

    if (!$expand_made) {
	my $query = "select flag, label from status";
	my $sth=$self->{dbh}->prepare($query);

	$sth->execute || die "execute('$query'): $DBI::errstr";

	# Make the expand_status function.
	#
	my @list;

	while (my $arrayref = $sth->fetchrow_arrayref) {
	    foreach (@$arrayref) {
		push @list, $_;
	    }
	}

	eval 'sub expand_status { my $flag = shift; my %hash = qw('
	    . join(" ", @list)
	    . '); return $hash{$flag} || "Unknown"; }';

	$expand_made = 1;
    }

    return $self;
}

# ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

=head2 config_var() -- Get the value of a configuration variable.

Returns the setting of a named configuration variable.

=over 4

=item Use:

  $value = $keystone->config_var( <configuration variable> );

=item Parameters:

=over 4

=item var

The name of a configuration variable, without the C<sys_> prefix.

=back

=item Returns:

The value of the named configuration variable.

=back

=cut # +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

sub config_var {
    my $self = shift;
    my $var = shift;

    $var !~ /^\w+$/ and
	croak "Keystone.pm: Cannot config_var($var) lookup non-alphanumeric "
	    . "variables";

    eval "return \$KEY_SYS::$var";
}

sub DESTROY {
    my $self = shift;

    $self->{dbh}->disconnect();
}

#
# Help for Keystone command line stuff.
#

sub help {
    my $self = shift;
    my %param = @_;

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

    $retval .= <<EOF;
-h		This help text
-status x	View/Create slips with status 'x'
-currtech tech	View/Create slips with currtech 'tech'
-brief		Only show the slip headers
-full		Show full slip (default)
-slip=xx	Select slip 'xx'
-newslip	Specifies the rest of standard input is a
		passed in as a new slip.
-parent=pid	Specify 'pid' as the parent Slip ID
-priority=pri	Specify 'pri' as the priority (1-9)
-debug		Turn on debugging

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

    return $retval;
}

sub mailinfo {
    my $self = shift;
    my %param = @_;

    my $mail = Mail::Internet->new([<>]) || die ("Failed: $!\n");
    $mail->remove_sig;
    $mail->tidy_body;

    my $rply = $mail->reply || die ("Failed: $!\n");
    my $replhead=$rply->head;
    $replhead->replace('From:',"From: " . $self->config_var("m_from"));
		$replhead->replace('Precedence:',"Precedence: bulk");

    (my $dname = $self->config_var("m_from")) =~ s/^[^\@]*\@(.*)/$1/;

    my $tmpl_filename;

    if (-e "$FindBin::RealBin/templates/mailinfo.tmpl") {
        $tmpl_filename = "$FindBin::RealBin/templates/mailinfo.tmpl";
    } else {
        $tmpl_filename = "$FindBin::RealBin/templates/mailinfo.tmpl.default";
    }

    my $template = new Text::Template ('type' => 'FILE',
	'source' => $tmpl_filename);

    my $safe = new Safe;

    # (SAFE => $compartment, ...);
    #
    my $retval = $template->fill_in(SAFE => $safe, 
	HASH => { "sys_company" => $self->config_var("company"),
	    "dname" => $dname } );

    push @{$rply->body}, "$retval\n";

    $rply->smtpsend( Host => $self->config_var("smtpserver") );
}

sub showslip {
    my $self = shift;
    my %param = @_;

    my $retval;

    $self->{debug} and print "Keystone.pm:showslip: Preparing...\n";

    my $sth = $self->{dbh}->prepare("select * from slips where "
	. "sid=$param{slip}") || die "Prepare failed. ($DBI::errstr)\n";;

    $self->{debug} and print "Keystone.pm:showslip: Done.\n";
    $self->{debug} and print "Keystone.pm:showslip: Executing...\n";

    my $rv = $sth->execute;

    $self->{debug} and print "Keystone.pm:showslip: Done.\n";

    my $rowcount = $sth->rows;

    $self->{debug} and print "Keystone.pm:showslip: Returned $rowcount rows.\n";

    if ($sth->rows) {
    	if ($param{brief}) {
    	    $retval .= "Slip ID St Open/Last Activ/Close                     Currtech Problem\n";
    	    $retval .= "======= == ========================================= ======== ==========================\n";
	}

	while (my $hashrow = $sth->fetchrow_hashref) {
	    my ($lds, $cds, $ods);

    	    if ($param{brief}) {
	      	$retval .= sprintf("%-7i ",$hashrow->{sid});
		$retval .= sprintf("%2s ",$hashrow->{status});
		$ods = localtime($hashrow->{o_date});
		$retval .= sprintf("Open:  %-18s by %-7s", $ods,
		    $hashrow->{o_tech});
		$retval .= sprintf("%-8s ", ($hashrow->{currtech} || "None"));
		$retval .= sprintf("%-40s\n", $hashrow->{problem});

		if ($hashrow->{l_activity}) {
		    $lds = localtime($hashrow->{l_activity});
		}

		if ($hashrow->{c_date}) {
		    $cds = localtime($hashrow->{c_date});
		}

		$lds and $retval .= sprintf("%10s L_Act: %-18s by %-15s\n",
		    ' ', $lds, $hashrow->{l_tech});
		$cds and $retval .= sprintf("%10s Close: %-18s by %-15s\n",
		    ' ', $cds, $hashrow->{c_tech});
    	    } else {
		my $tmpl_filename;

		if (-e "$FindBin::RealBin/templates/showslip.tmpl") {
		    $tmpl_filename = "$FindBin::RealBin/templates/showslip.tmpl";
		} else {
		    $tmpl_filename = "$FindBin::RealBin/templates/showslip.tmpl.default";
		}

		my $template = new Text::Template ('type' => 'FILE',
		  'source' => $tmpl_filename);

		my $safe = new Safe;

		$hashrow->{c_date} and
		    $hashrow->{cds} = localtime($hashrow->{c_date});
		$hashrow->{l_activity} and
		    $hashrow->{lds} = localtime($hashrow->{l_activity});
		$hashrow->{ods} = localtime($hashrow->{o_date});

	    	if ($hashrow->{spid}) {
		    my $subq = $self->{dbh}->prepare("select problem from "
			. "slips where sid=$hashrow->{spid}");
		    $subq->execute;
		    my $subqdata = $subq->fetchrow_hashref;
		    $hashrow->{subproblem} = $subqdata->{problem};
		}

		$safe->share('expand_status');

		# (SAFE => $compartment, ...);
		#
		$retval .= $template->fill_in(SAFE => $safe, 
		    HASH => $hashrow );
		$retval .= "\n";
	    }
	}
    } else {
	die "No slip '$param{slip}' found. (query returned 0 rows)\n";
    }

    if ($param{followups}) {
	if ($param{brief}) {

	} else {
	    # TODO: Let the user decide if non-public stuff is shown?
	    #
	    my $sth = $self->{dbh}->prepare("select * from followups where "
		. "f_sid=$param{slip} and f_public=1 order by f_seq desc") ||
		    die "Prepare failed. ($DBI::errstr)\n";
	    my $rv = $sth->execute;
	    my $rowcount = $sth->rows;

	    if ($rowcount) {
		my $tmpl_filename;

		if (-e "$FindBin::RealBin/templates/followup.tmpl") {
		    $tmpl_filename = "$FindBin::RealBin/templates/followup.tmpl";
		} else {
		    $tmpl_filename = "$FindBin::RealBin/templates/followup.tmpl.default";
		}

		my $template = new Text::Template ('type' => 'FILE',
		  'source' => $tmpl_filename);

		while (my $hashrow = $sth->fetchrow_hashref) {
		    my $safe = new Safe;

		    $hashrow->{fds} = localtime($hashrow->{f_date});

		    $retval .= $template->fill_in(SAFE => $safe,
			HASH => $hashrow);
		    $retval .= "\n";
		}
	    }
	}
    }

    return $retval;
}

sub addfollowup {
    my $self = shift;
    my %param = @_;

    my $f_sid = $param{slip};
    my $f_date = time();
    my $f_tech = $self->{dbh}->quote($param{currtech} || "UNKNOWN");
    my $f_public = $param{public} ? 1 : 0;
    my $f_text = $self->{dbh}->quote($param{f_text});
    my $f_seq;
    my $reopen = $param{reopen} ? ",status='O' " : "";

    $f_text || die "Keystone.pm: No f_text passed to addfollowup!";

    # Test f_sid to make sure it is a valid slip id.
    #

    my $sth = $self->{dbh}->prepare("select max(f_seq)+1 as max from "
	. "followups where f_sid=$param{slip}");

    my $rv=$sth->execute || die "Keystone.pm: Error: $DBI::errstr";

    my $rowcount = $sth->rows;

    if ($sth->rows) {
	my $hashrow = $sth->fetchrow_hashref;

	$f_seq = $hashrow->{max} || 1;
    }

    my $flist = "f_sid,f_date,f_tech,f_text,f_seq,f_public";
    my $vlist = "$f_sid,$f_date,$f_tech,$f_text,$f_seq,$f_public";
	my $numfollow = 0;
    my $query = "insert into followups ($flist) values ($vlist)";

    $sth = $self->{dbh}->prepare($query) 
	|| die "Keystone.pm: Error preparing post: $DBI::errstr";

    $rv=$sth->execute || die "Keystone.pm: execute($query): $DBI::errstr";

	if ( $self->config_var('server') eq 'Pg' ) {
		$query = "select num_follows from slips where sid = $f_sid";
		$sth = $self->{dbh}->prepare( $query );
		my $hashrow = $sth->fetchrow_hashref;
		$numfollow = $hashrow->{num_follows} || 1;
		$query = "update slips set l_activity=$f_date, l_tech=$f_tech,"
			. "num_follows=$numfollow "
			. $reopen
			. " where sid=$f_sid";
	} else {
	    $query = "update slips set l_activity=$f_date, l_tech=$f_tech,"
		. "num_follows=if(num_follows is null, 1, num_follows+1)"
		. $reopen
		. " where sid=$f_sid";
	}

    $sth = $self->{dbh}->prepare($query)
	|| die "Keystone.pm: Error preparing post: $DBI::errstr";

    $rv=$sth->execute || die "Keystone.pm: execute($query): $DBI::errstr";
}

#
# addattach - will add an attachment the library & existing slip
#
sub addattach {
    my $self = shift;
    my %param = @_;

    my $now = time();

    $param{fname} || return 0;  # Die if no filename.
    my $attachdir=$self->config_var('attachdir');
    my $fullname="$FindBin::RealBin/../$attachdir/$param{fname}";
    -f $fullname || return(0);
    $param{slip} || return(0);
    $param{size} ||= -s $fullname;
    $param{time} ||= $now;
    $param{currtech} ||= 'UNKNOWN';
    $param{title} ||= '';
    $param{desc} ||= `/usr/bin/file -b $fullname`;
    $param{public} ||= 0;
    $param{sname} ||= ($param{fname}=~/([^\/]+)$/,$1);

    my $vstring="li_fname,li_fsize,li_update,li_uptech,li_title,li_descrip,li_public,li_oname";
    my $dstring= "'$param{fname}',"
               . "'$param{size}',"
               . "'$param{time}',"
               . "'$param{currtech}',"
               . $self->{dbh}->quote($param{title}) . ","
               . $self->{dbh}->quote($param{desc}) . ","
               . "'$param{public}',"
               . "'$param{sname}'";

    my $sth=$self->{dbh}->prepare("replace into library ($vstring) " .  "values ($dstring)")
               || die "Keystone.pm: Error preparing post: $DBI::errstr";

    my $rv=$sth->execute || die "Keystone.pm: Error posting: $DBI::errstr";

    $vstring="at_sid,at_fname,at_tech,at_date,at_comment";
    $dstring= "'$param{slip}',"
            . "'$param{fname}',"
            . "'$param{currtech}',"
            . "'$param{time}',"
            .   $self->{dbh}->quote($param{title});

    $sth=$self->{dbh}->prepare("insert into attachments ($vstring) " .  "values ($dstring)")
             || die "Keystone.pm: Error preparing post: $DBI::errstr";

    $rv=$sth->execute || die "Keystone.pm: Error posting: $DBI::errstr";

    return(1);
}

#
# addslip - will post a slip that's coming in via email.
#
sub addslip {
    my $self = shift;
    my %param = @_;

    my $now = time();

    $param{status} ||= 'U';
    $param{priority} ||= 5;
    $param{parent} ||= 0;
    $param{contact} ||= 'UNKNOWN';
    $param{opentech} ||= 'email';
    $param{public} ||= 0;

#    my $vstring="spid,priority,o_date,o_tech,status,ctag,problem,"
#	. "is_public,summary";
    my $vstring="spid,priority,o_date,l_activity,o_tech,status,ctag,problem,is_public,summary" ;
#    my $dstring="$param{parent},$param{priority},$now,"
    my $dstring="$param{parent},$param{priority},$now,$now,"
	. $self->{dbh}->quote($param{opentech}) . ","
	. "'$param{status}'" . ","
	. $self->{dbh}->quote($param{contact}) . ","
	. $self->{dbh}->quote($param{sline}) . ","
	. "'$param{public}'" . ","
	. $self->{dbh}->quote($param{body});
    #
    # opening tech should always be defined, but auto-assigning slips
    # will not always be used.
    #
    if ($param{currtech}) {
	$vstring .= ",currtech";
	$dstring .= "," . $self->{dbh}->quote($param{currtech});
    }
    my $sth=$self->{dbh}->prepare("insert into slips ($vstring) " .
	"values ($dstring)") || die "Keystone.pm: Error preparing post: $DBI::errstr";
    my $rv=$sth->execute || die "Keystone.pm: Error posting: $DBI::errstr";

    my $insertid;

    if ($self->config_var("server") eq 'mysql') {
	$insertid = $self->{dbh}->{'mysql_insertid'};
    } elsif ($self->config_var("server") eq 'Pg') {
        my $oid_status = $sth->{'pg_oid_status'};

	my $sth = $self->{dbh}->prepare("SELECT sid FROM slips "
	    . "WHERE oid=$oid_status");
	my $rv = $sth->execute || die "Keystone.pm: Error selecting: $DBI::errstr";
	my @arr = $sth->fetchrow_array;

	($insertid) = @arr;
    } else {
	die "Unsupported database type for creating slips."
    }

    #
    # Update the children counter on the parent slip if a parent is specified.
    # Otherwise the counters get out of sync, have to be fixed under Maint, and
    # unless there's one child that the parent knows about, this renders quickslips
    # useless when tied to keymail.
    #
    if ($param{parent}) {
        my $query;
        if ( $self->config_var('server') eq 'Pg' ) {
            $query = "select num_children from slips where sid = $param{parent}";
            $sth = $self->{dbh}->prepare( $query );
            my $hashrow = $sth->fetchrow_hashref;
            my $numchildren = $hashrow->{num_children} || 1;
            $query = "update slips set l_activity=$now,"
                . "num_children=$numchildren "
                . " where sid=$param{parent}";
        } else {
            $query = "update slips set l_activity=$now,"
                . "num_children=if(num_children is null, 1, num_children+1)"
                . " where sid=$param{parent}";
        }       

        my $sth = $self->{dbh}->prepare($query)
           || die "Keystone.pm: Error preparing post: $DBI::errstr";
	my $rv = $sth->execute || die "Keystone.pm: Error executing: $DBI::errstr";
    }

    return $insertid;
}

sub banner {
    my $self = shift;
    my %param = @_;

    my $version = $self->config_var("version");

    my $retval = <<EOF;
Keystone Command Line Utility                Keystone v$version
--------------------------------------------------------------
EOF

    return $retval;
}



# ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

=head2 dateformat() -- Format a date.

Format the date according to the specification in the Keystone
configuration file.

If date format string has not already been generated, have it (and
the date width) built.

=over 4

=item Use:

  $dateformat = $keystone->dateformat();

=item Parameters:

=over 4

=item date

The date to be formated, in Unix time format.

=back

=item Returns:

A string containing the date, formatted for display.

=item Side-effects:

C<$self->>C<{date_format}> & C<$self->>C<{date_width}> are set
if they don't yet exist.

=back

=cut # +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

sub dateformat {
  my $self = shift;
  my ($date) = @_;

  $main::debug && print STDERR "Entering " . $self . "::dateformat().\n";


  my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
                #  Individual time & date variables for use with strftime().
  my $string;   #  String to put the formatted date into.
  my $format;   #  Date format.

  $format = $self->{date_format};
  if (!$format) {
    $self->builddateformat();
    $format = $self->{date_format};
  }

  #  Get the parts of the date & time from the Unix date.
  ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
      localtime( $date );

  #  Format the date.
  $string = POSIX::strftime( $format, $sec, $min, $hour, $mday,
      $mon, $year );


  $main::debug &&
      print STDERR "Returning from " . $self .  "::dateformat().\n";

  return $string;
}



# ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

=head2 datewidth() -- Get space required to print date.

If date width has not already been generated, have it (and the date
format) built.

=over 4

=item Use:

  $datewidth = $keystone->datewidth();

=item Returns:

The width required to display the current date format.

=item Side-effects:

C<$self->>C<{date_format}> & C<$self->>C<{date_width}> are set
if they don't yet exist.

=back

=cut # +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

sub datewidth {
  my $self = shift;

  $main::debug && print STDERR "Entering " . $self . "::datewidth().\n";


  my $width;   #  Width required to display the current date format.

  $width = $self->{date_width};
  if (!$width) {
    $self->builddateformat();
    $width = $self->{date_width};
  }


  $main::debug &&
      print STDERR "Returning " . $width . " from " . $self .
      "::datewidth().\n";

  return $width;
}



# ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

=head1 INTERNAL METHODS

=cut

# ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

=head2 builddateformat() -- Create the date format string.

Grabs the C<$sys_datefmt> configuration variable and converts it into
a date format string suitable for use with the C<POSIX::strftime()>
function.  Also counts up the amount of text space to reserve for
the formatted date.

Stores this date format string and width for later use.

=over 4

=item Use:

  require Keystone;

  $self->builddateformat();

=item Side-effects:

C<$self->>C<{date_format}> & C<$self->>C<{date_width}> are set.

=back

=cut # +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

sub builddateformat {
  my $self = shift;

  $main::debug && print STDERR "Entering " . $self . "::builddateformat().\n";


  my $format = "";   #  Date format.
  my $width = 0;     #  Date width.

  #  This is the set of equivalent format chararacters.
  #  The first column is for the PHP3 date function.
  #  The second column is for POSIX::strftime().
  my %equivs = (
      'Y' => "%Y",   #  year, numeric, 4 digits
      'y' => "%y",   #  year, numeric, 2 digits
      'F' => "%B",   #  month, textual, long; i.e. "January"
      'M' => "%b",   #  month, textual, 3 letters; i.e. "Jan"
      'm' => "%m",   #  month, numeric (Does php3 pad with a 0? -- %m does)
      'z' => "%j",   #  day of the year, numeric; i.e. "299"
      'd' => "%d",   #  day of the month, numeric, 2 digits, with leading
		     #  zeros
      'j' => "%d",   #  day of the month, numeric, without leading zeros
		     #  (%d uses leading zeros)
      'l' => "%A",   #  day of the week, textual, long; i.e. "Friday"
      'D' => "%a",   #  day of the week, textual, 3 letters; i.e. "Fri"
      'w' => "%w",   #  day of the week, numeric, 1 digit (What day of the
		     #  week is 0 in php3?  %w has Sunday being 0.)
      'H' => "%H",   #  hour, numeric, 24 hour format (Zero padded?  %H is)
      'h' => "%I",   #  hour, numeric, 12 hour format (Zero padded?  %I is)
      'i' => "%M",   #  minutes, numeric (Zero padded?)
      's' => "%S",   #  seconds, numeric (Zero padded?)
      'A' => "%p",   #  "am" or "pm" (php3 uses upper case, %p lower case.)
      'a' => "%p"    #  "am" or "pm"
    );

  #  For each entry in the above hash, we need to know how much text
  #  space to leave for the resulting date strings.
  my %sizes = (
      'Y' => 4,   #  year, numeric, 4 digits
      'y' => 2,   #  year, numeric, 2 digits
      'F' => 9,   #  month, textual, long; i.e. "January"
      'M' => 3,   #  month, textual, 3 letters; i.e. "Jan"
      'm' => 2,   #  month, numeric (Does php3 pad with a 0? -- %m does)
      'z' => 3,   #  day of the year, numeric; i.e. "299"
      'd' => 2,   #  day of the month, numeric, 2 digits, with leading
		  #  zeros
      'j' => 2,   #  day of the month, numeric, without leading zeros
		  #  (%d uses leading zeros)
      'l' => 9,   #  day of the week, textual, long; i.e. "Friday"
      'D' => 3,   #  day of the week, textual, 3 letters; i.e. "Fri"
      'w' => 1,   #  day of the week, numeric, 1 digit (What day of the
		  #  week is 0 in php3?  %w has Sunday being 0.)
      'H' => 2,   #  hour, numeric, 24 hour format (Zero padded?  %H is)
      'h' => 2,   #  hour, numeric, 12 hour format (Zero padded?  %I is)
      'i' => 2,   #  minutes, numeric (Zero padded?)
      's' => 2,   #  seconds, numeric (Zero padded?)
      'A' => 2,   #  "am" or "pm" (php3 uses upper case, %p lower case.)
      'a' => 2    #  "am" or "pm"
    );

  #  Get the format from the Keystone configuration file.
  my $phpformat = $self->config_var( "datefmt" );

  #  For each character in the original date format string,
  my $phpformatsize = length( $phpformat );
  for (my $index = 0;  $index < $phpformatsize;  $index++) {
    my $size = 1;    #  Normal characters use one space.

    #  Get each character in turn.
    my $character = substr( $phpformat, $index, 1 );

    #  If it is a special character,
    if ($equivs{$character}) {
      $size = $sizes{$character};       #  Update the character width.
      $character = $equivs{$character}; #  Replace with new special characters.
    }
    $format .= $character;   #  Build onto the format string.
    $width += $size;         #  Count up the format string width.
  }

  #  Store our results for later use.
  $self->{date_format} = $format;
  $self->{date_width} = $width;

  $main::debug &&
      print STDERR "Returning from " . $self .  "::builddateformat().\n";
}

1;


__END__

=head1 CAVEATS


=head1 BUGS

This module consists mostly of functions that are designed specifically
to support keymail.
Since this package is now used by multiple programs,
these keymail-specific functions should be factored out to make the
package more generic.

=head1 AUTHORS

Most of this was written by Jonathan Roy &/or Dave Belfer-Shevett.

David H. Silber of Silber Software Engineering
F<E<lt>david@SilberSoft.comE<gt>>
added the C<dateformat()>, C<datewidth()> and C<builddateformat()> modules,
and some miscellaneous functionality
as part of the B<keycli> development effort.

=head1 SEE ALSO

=cut

