#---------------------------------------------------------------------#
# 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/
# ----------------------------------------------------------------------

# ----------------------------------------------------------------------
#  SlipList.pm
#  $Id:
# ----------------------------------------------------------------------

# ----------------------------------------------------------------------
package SlipList;

# ----------------------------------------------------------------------
#  This manages the details of displaying each individual slip.
require Slip;

# ----------------------------------------------------------------------
#  This provides access to the people table so that users can be
#  authenticated.
require People;

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


=head1 NAME

SlipList - A list of items from the Keystone database C<slip> table

=head1 SYNOPSIS 

	require SlipList;

	$sliplist = new SlipList ( \%where, $keystone, $children );

	$sliplist->display( $method );

Internal methods:

	$self->slipidsize();

	$self->brief( $location );

	$self->full( $location );

	$self->oneline( $location );

=head1 DESCRIPTION

SlipList provides access to a list of Keystone slips.

=head1 DATA FORMAT

A SlipList object contains an array of Slip objects that satisfy the 
query criteria provided to the C<new> method.

The first element of the array is reserved for a hash of meta
information.

B<Meta Data:>

=over 4

=item slipidsize

The maximum length of a slip id string.

=item briefformat

Format of a brief display line.

=back

=head1 METHODS

=cut

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

=head2 new() -- Construct a list of Slip objects.

Query the database for matching slips.  Each of these is used to
create a Slip object.  All of the Slips are grouped into a SlipList.

=over 4

=item Use:

  require SlipList;

  $sliplist = new SlipList ( \%where, $keystone, $children );

=item Parameters:

=over 4

=item where

Hash of selection criteria.
Keys are database column names.
Values must match the information in the database.

=item keystone

A Keystone object, which is used to access the database.

=item children

True, if the new list of slip objects should also include the
children of all slips that match the selection criteria.

=back

=item Returns:

A SlipList object.

=back

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

sub new {
  my $package = shift;      #  Package name.
  my ($where, $keystone, $children) = @_;   #  Reference to hash of selection criteria.

  $main::debug && print STDERR "Entering " . $package . "::new( $where, $keystone, $children ).\n";


  #  Object of our desires...
  my @list;               #  This will become the SlipList object.

  #  Local variables.
  my $field;              #  SQL field to match.
  my @partial;            #  Array of partial WHERE clauses.
  my $item = 0;           #  Counter through @partial.
  my $wherestring = "";   #  The WHERE clause of the query.
  my $count;              #  Used to build $wherestring.
  my $query;              #  Query text.
  my $sth;                #  Statement handle.
  my $basequery;

  #  Create the new SlipList object.

  #  Create the WHERE clause of a SELECT statement.
  #  (Perhaps this bit should be in it's own subroutine?)
  #  First, build an array of ``<name> = <value>'' clauses.
  foreach $field (keys( %$where ) ) {
    $partial[$item++] = $field . " = '" . $$where{$field} . "'";
  }

  #  Now put the clauses together, with ``AND'' between them.
  if ($item > 0) {
    $wherestring = " WHERE ";
    $wherestring .= $partial[0];
    for ($count = 1;  $count < $item;  $count++) {
      $wherestring .= " AND " . $partial[$count];
    }
  }

  #  If the user is not a Keystone user, only show the public slips.
  if (! People::usermatch()) {
    $wherestring .= " AND is_public = '1'";
  }

  #  Build the query.
  $basequery = "SELECT " . fields Slip ( "sql" ) . " FROM slips";
  $query = $basequery . $wherestring;
  $main::debug && print STDERR "SQL query is: " . $query . "\n";

  #  Query the database.
  $sth = $keystone->{dbh}->prepare( $query );
  $sth->execute() || die "execute('$query'): $DBI::errstr";

  $main::debug && print STDERR "Row count: " . $sth->rows . ".\n"; 

  $list[0] = {'slipidsize' => 0};

  #  For each row returned, create a new Slip & add it to the list.
  $item = 1;
  while (my $hashrow = $sth->fetchrow_hashref) {
    $list[$item] = new Slip ( \%$hashrow );
    $main::debug && print "Slip: (" . $item . ") " . $list[$item] . ".\n";
    $item++
  }

  #  Really, I should be able to just modify the query, but either MySQL
  #  doesn't support the UNION clause (and a grep through the MySQL
  #  manual does not come up with any matches) or I can't figure out the
  #  MySQL syntax for this.  (*sigh*)  So, I'll just apply a bit of
  #  brute force to the problem.
  if ($children && @list) {
    my $spidstring = "";
    my $sidstring = "";
    my $clause;
    my $meta;

    $meta = shift @list;
    foreach my $slip (@list) {
      $spidstring .= "spid = '" . $slip->sid() . "' OR ";
      $sidstring .= " AND sid != '" . $slip->sid() . "'";
    }
    unshift @list, $meta;

    $spidstring =~ s/....$//;
    $clause = " WHERE ( " . $spidstring . " ) " . $sidstring;

    #  If the user is not a Keystone user, only show the public slips.
    if (! People::usermatch()) {
      $clause .= " AND is_public = '1'";
    }

    #  Build the query.
    $query = $basequery . $clause;

    #  Query the database.
    $sth = $keystone->{dbh}->prepare( $query );
    $sth->execute() || die "execute('$query'): $DBI::errstr";

    $main::debug && print STDERR "Row count: " . $sth->rows . ".\n"; 

    #  For each row returned, create a new Slip & add it to the list.
    while (my $hashrow = $sth->fetchrow_hashref) {
      $list[$item] = new Slip (\%$hashrow);
      $main::debug && print "Slip: (" . $item . ") " . $list[$item] . ".\n";
      $item++
    }
  }

  #  Make this be our object, for future reference.
  bless \@list, $package;


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

  return \@list;
}


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

=head2 display() -- Display the list of slips.

This displays the list of slips, according to the specified display
method.
A header and footer are displayed, as appropriate to the display
method.

=over 4

=item Use:

  $sliplist->display( $method );

=item Parameters:

=over 4

=item method

The Slip method to use to format the slip display.
Currently, this is one of ``full'', ``brief'', or ``onelist''.

=back

=item Returns:

Formatted text to be displayed.

=back

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

sub display {
  my $self = shift;
  my ($method) = @_;
  
  $main::debug && print STDERR "Entering " . $self . "::display().\n";


  my $rowcount;    #  Count of slips in the list.
  my $slip;        #  A Slip to display.
  my $meta;        #  Temporary storage for hash of meta-data.
  my $string;      #  Text to be displayed.

  $rowcount = @$self - 1;    #  Get the count of slips in the list.

  #  Only display headers, footers &ct if there is data in the list.
  if ($rowcount) {

    #  Display the appropriate headers.
    $string =  $self->$method( "header" );

    #  Display the body of each Slip.
    $meta = shift @$self;
    foreach $slip (@$self) {
      $string .=  $slip->$method( $$meta{'briefformat'} );
    }
    unshift @$self, $meta;

    #  Display the appropriate footers.
    $string .=  $self->$method( "footer" );

  }
  else {
    die "No matching slip found.\n";
  }
  

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

  return $string;
}


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

=head1 INTERNAL METHODS

=cut

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

=head2 slipidsize() -- Find the largest slip ID.

Finds the largest slip ID in this SlipList.

=over 4

=item Use:

  $slipwidth = $self->slipidsize();

=item Returns:

The display-width of the largest slip ID in the SlipList.

=item Side-effects:

The slipidsize meta-data is stored for later use.

=back

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

sub slipidsize {
  my $self = shift;


  my $meta;
  my $biggest = 0;
  my $slip;


  #  If slipidsize is already set, use that setting & we're done.
  $$self[0]->{'slipidsize'} && return $$self[0]->{'slipidsize'};

  #  Get the maximum size of a slip id.
  $meta = shift @$self;
  foreach $slip (@$self) {
    $biggest = Utilities::max( $biggest, length( $slip->sid ) );
  }
  unshift @$self, $meta;

  #  Store the maximum slip id length for furture use, and
  #  return it.
  $$self[0]->{'slipidsize'} = $biggest;

  return $biggest;

}


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

=head2 brief() -- Display the brief format header and footer.

Format a header and footer for the ``brief'' display mode.
Return these strings, one at a time.

=over 4

=item Parameters:

=over 4

=item location

"header" or "footer".

=back

=item Use:

  $slipwidth = $self->brief( $location );

=item Returns:

The header or footer string.

=item Side-effects:

The slipidsize meta-data is stored for later use.

The briefformat meta-data is set.

=back

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

sub brief {
  my $self = shift;
  my ($location) = @_;

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


  my $string;    #  String to be displayed.

  #  The slip ID will take up at least 4 characters.
  my $slipwidth = Utilities::max( $self->slipidsize, 4 );

  #  The date's width will take up at least 8 characters.
  my $datewidth = Utilities::max( $main::keystone->datewidth(), 8 );

  #  The subject field gets (at most) 41 spaces.
  my $subjectwidth = 61 - $slipwidth - $datewidth;

  #  Once we have blown our screen width allocation, we might as well
  #  get a reasonable amount of the subject printed.
  if ($subjectwidth < 1) {
    $subjectwidth = 60;
  }

  my $headerformat =
      sprintf( "%%%i.%is %%-%i.%is %%-%i.%is %%-%i.%is %%-%i.%is\n",
      $slipwidth, $slipwidth,
      6, 6,
      $datewidth, $datewidth,
      8, 8,
      $subjectwidth, $subjectwidth );

  #  Almost the same as the header format, but the first section is numeric.
  $$self[0]->{'briefformat'} =
      sprintf( "%%%ii %%-%i.%is %%-%i.%is %%-%i.%is %%-%i.%is\n",
      $slipwidth,
      6, 6,
      $datewidth, $datewidth,
      8, 8,
      $subjectwidth, $subjectwidth );

  if ($location eq "header") {
    $string = sprintf( $headerformat, "Slip", "Status",
	"OpenDate", "OpenTech", "Subject" );
    $string .= sprintf( $headerformat, "===========", "======",
	"============================================================",
	"========",
	"============================================================" );
  } else {
    $string = sprintf( $headerformat, "===========", "======",
	"============================================================",
	"========",
	"============================================================" );
  }
  

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

  return $string;
}       


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

=head2 full() -- Display the full format header and footer.

Since the 'full' slip display does not need headings, this simply
provides a border to be displayed at the top & bottom.

=over 4

=item Parameters:

=over 4

=item location

"header" or "footer".
This is not currently used, but might be at some future date to change
the way things look.

=back

=item Use:

  $slipwidth = $self->full( $location );

=item Returns:

The header or footer string.

=item Side-effects:

The slipidsize meta-data is stored for later use.

=back

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

sub full {
  my $self = shift;
  my ($location) = @_;

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


  my $string = "================================================================================\n";
  

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

  return $string;
}       


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

=head2 oneline() -- Display the oneline format header and footer.

This displays a header or footer, depending on the location specified.

The header consists of a list of field names, each contained in
quotes and each separated from the other field names by a comma.

The footer is blank.

=over 4

=item Parameters:

=over 4

=item location

"header" or "footer".
This is not currently used, but might be at some future date to change
the way things look.

=back

=item Use:

  $slipwidth = $self->oneline( $location );

=item Parameters:

=over 4

=item location

"header" or "footer".

=back

=item Returns:

The header or footer string.

=item Side-effects:

The slipidsize meta-data is stored for later use.

=back

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

sub oneline {
  my $self = shift;
  my ($location) = @_;

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


  my $string = "";    #  Header is built in this string.

  if ($location eq "header") {
    foreach my $field (split / /, Slip::fields()) {
      $string .= Utilities::enquote( $field ) . ", ";
    }
    $string =~ s/..$/\n/;
  }
  

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

  return $string;
}


1;

__END__

=head1 CAVEATS

There should be some way to specify relative values in the WHERE clause.
(I.e.  priority < 3.)

=head1 BUGS

None that I know of.

=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<Slip>,
L<People>,
L<Utilities>

=cut
