package PSP::FieldSpace::Group;

# Copyright (c) 2000, FundsXpress Financial Network, Inc.
# This library is free software released under the GNU Lesser General
# Public License, Version 2.1.  Please read the important licensing and
# disclaimer information included below.

# $Id: Group.pm,v 1.1.1.2 2003/12/06 19:47:27 hartmans Exp $

=head1 NAME

PSP::FieldSpace::Group - a class for PSP FieldSpace groups.

=head1 SYNOPSIS

 use PSP::FieldSpace;
 use PSP::FieldSpace::Group;

 my $fs = ..

=cut

use strict;

use PSP::share;
#use PSP::Utils;
use HTMLIO::Utils qw(html_tag);

@PSP::FieldSpace::Group::ISA = qw(PSP::share);

use vars qw(@hashes @arrays);
@hashes = (
	   'fields',          # instanciated fields
	   'field_was_setup', # .. ?
	   'export_controls'  # outgoing mapping of controls to CGI params.
	  );
@arrays = (
	   'field_names',     # list of field names (read-only)
	   'objects',         # list of setup'd objects.
	   'import_controls'  # incoming mapping of controls to CGI params.
	  );

sub _min { my ($a,$b) = @_; return( ($a < $b) ? $a : $b ); }
sub _max { my ($a,$b) = @_; return( ($a > $b) ? $a : $b ); }

sub new {
  my ($proto,$fs,$group_def) = @_;
  $fs or throw Error::Simple("Group constructed without FieldSpace.");
  $group_def ||= {};

  my $this = { %$group_def };
  bless $this, ref($proto) || $proto;

  # initialize the members.
  ($this->{name} = ref($this)) =~ s/^Group:://;
  map { $this->{$_} ||= {} } @hashes;
  map { $this->{$_} ||= [] } @arrays;

  # assign the group's fieldspace.
  $this->fieldspace($fs);

  # set some reasonable defaults, possibly to be overridden by propagation
  $this->first_item_n(1);
  $this->n_items_per_page($this->{number}||20);
  $this->n_pages_at_a_time(10);

  my @saw;
  my @poss = sort {$a<=>$b} grep(!$saw[$_]++, ($this->{number}, qw(10 20)));
  push @poss, 'All';
  $this->poss_n_items_per_page(\@poss);

  $this->source_share_class($fs->source_share_class());

  return $this;
}

sub free_internals {
  my ($this) = @_;
  delete $this->{fieldspace};
}

sub setup {
  my ($this,$index) = @_;
  die "This function is overridden by generated pile.";
}

sub was_setup {
  my ($this,$index,$val) = @_;
  defined $val and $this->{was_setup}->[$index-1] = $val;
  $this->{was_setup}->[$index-1];
}

sub field_was_setup {
  my ($this,$field_name,$val) = @_;

  # get (or create) the index of this group.
  my $index = $this->cursor();
  # if a value is given, assign it.
  defined $val and 
    $this->{field_was_setup}->{$field_name}->[$index-1] = $val;
  # return the value of this field.
  return $this->{field_was_setup}->{$field_name}->[$index-1];
}

sub cursor {
  my ($this) = @_;
  $this->{cur_index} or $this->{cur_index} = 1;
  return $this->{cur_index};
}
sub set_cursor {
  my ($this,$index) = @_;
  $this->{cur_index} = $index;
}
sub advance_cursor {
  my ($this) = @_;
  $this->{cur_index}++;
}

sub gen_value {
  my ($this,$name,$val) = @_;
  defined $val and $this->{$name} = $val;
  return $this->{$name};
}
sub name              { shift->gen_value('name',              @_) }
sub first_item_n      { shift->gen_value('first_item_n',      @_) }
sub n_items_per_page  { shift->gen_value('n_items_per_page',  @_) }
sub n_pages_at_a_time { shift->gen_value('n_pages_at_a_time', @_) }
sub poss_n_items_per_page { shift->gen_value('poss_n_items_per_page', @_) }

sub gen_int_rule {
  my ($this,$name,$val) = @_;
  if (defined $val) {
    if ($val < 0) {
      delete $this->{$name};
    } else {
      $this->{$name} = $val;
    }
  }
  return $this->{$name};
}

sub n_pages {
  my ($this,$val) = @_;
  if (! defined $this->gen_int_rule("n_pages",$val)) {
    $this->{n_pages} = 
      int( ($this->n_items() - 1) / $this->n_items_per_page()) + 1;
  }
  return $this->{n_pages};
}

sub page_n {
  my ($this,$val) = @_;
  if (! defined $this->gen_int_rule("page_n",$val)) {
    $this->{page_n} = 
      int( ($this->first_item_n() - 1) / $this->n_items_per_page() ) + 1;
  }
  return $this->{page_n};
}

sub last_item_n {
  my ($this,$val) = @_;
  if (! defined $this->gen_int_rule("last_item_n",$val)) {
    $this->{late_item_n} = 
      _min( ($this->first_item_n() + $this->n_items_per_page() - 1),  
	    $this->n_items() );
  }
  return $this->{last_item_n};
}

sub last_page_n {
  my ($this,$val) = @_;
  if (! defined $this->gen_int_rule("last_page_n",$val)) {
    $this->{last_page_n} = 
      _min( ($this->first_page_n() + $this->n_pages_at_a_time() - 1), 
	    $this->n_pages() );
  }
  return $this->{last_page_n};
}

sub first_page_n {
  my ($this,$val) = @_;
  if (! defined $this->gen_int_rule("first_page_n",$val)) {
    $this->{first_page_n} = 
      $this->page_n() - 
	( ($this->page_n() - 1) % $this->n_pages_at_a_time() );
  }
  return $this->{first_page_n};
}

sub after_page_n {
  my ($this,$val) = @_;
  if (! defined $this->gen_int_rule("after_page_n",$val)) {
    $this->{after_page_n} = 
      (($this->first_item_n() - 1) % $this->n_items_per_page()) 
	? $this->page_n() : 0;
  }
  return $this->{after_page_n};
}

sub first_item_n_from_page_n {
  my ($this,$page_n) = @_;
  return( 1 + ($page_n-1) * $this->n_items_per_page() );
}

sub fieldspace { 
  my ($this,$val) = @_;
  (!$val and !defined $this->{fieldspace}) and throw
    Error::Simple("fieldspace expected from group method.");
  $val and $this->{fieldspace} = $val;
  return $this->{fieldspace};
}

sub n_items {
  my ($this,$val) = @_;

  if (! defined $this->gen_int_rule("n_items",$val)) {

    # find the last computed object..
    my $n_items = @{$this->{objects}};

    # if we have dummy_ok, do not guess any further than the number
    # of the last object we currently have.
    if (!$this->{dummy_ok}) {

      # otherwise, compute the next objects until we find the last one.
      # leave the objects array sparse, but cache the last object.
      my ($obj,$tmp_obj);
      for (my $n = $n_items; ($tmp_obj = $this->setup($n)); $n++) {
	$obj = $tmp_obj;
	$n_items++;
	# don't do this forever if setup() is bogus.
	if ($n_items > 100000) {
	  warn "group setup items exceeded 100000 when determining n_items.\n";
	  last;
	}
      }

      # cache this last object, thus preserving the 
      $this->{objects}->[$n_items-1] = $obj;
    }

    $this->{n_items} = $n_items;
  }

  return $this->{n_items};
}

sub more_to_come {
  my ($this) = @_;
  if ($this->n_items_per_page() and
      $this->cursor() - $this->first_item_n() >= $this->n_items_per_page()) {
    return undef;
  }
  return($this->object() || $this->{dummy_ok});
}

sub object {
  my ($this,$index) = @_;
  $index or $index = $this->cursor();

  if (!$this->was_setup($index)) {
    $this->{objects}->[$index-1] = $this->setup($index);
    $this->was_setup($index,1);
  }
  return $this->{objects}->[$index-1];
}

sub lexical_context {
  my ($this,$gname) = @_;

  my $grpvar = $this->{grpvar};
  my $numvar = $this->{numvar};
  my $objvar = $this->{objvar};

  my $code = join("\n",
	("my $grpvar = \$fs->group('$gname');",
	 "my $numvar = $grpvar->cursor();",
	 "my $objvar = $grpvar->object();"
	))."\n";

  return $code;
}

sub scan_fields {
  my ($this,$sub) = @_;
  my $gname = $this->name();
  my $field;

  my $out = "";
  my $ret_val;

  my $fs = $this->fieldspace();

  # Iterate through each of the field columns.
  for my $field_name ($this->field_names()) {

    # Iterate through each of the fields' rows.
    for my $index ($this->indices($field_name)) {
      $this->set_cursor($index);
      $field = $fs->get_field($field_name);
      $ret_val = &{$sub}($field,$field_name,$gname,$index);
      defined $ret_val and $out .= $ret_val;
    }
  }

  $this->set_cursor(0);

  return $out;
}

sub field {
  my ($this,$field_name,$index,$field) = @_;
  $index or $index = $this->cursor();
  defined $field and $this->{fields}->{$field_name}->[$index-1] = $field;
  return unless $this->{fields}->{$field_name};
  return $this->{fields}->{$field_name}->[$index-1];
}

sub field_names {
  my ($this) = @_;
  return @{$this->{field_names}};
}

sub fields {
  my ($this,$index) = @_;
  if ($index) {
    my @field_names;
    for my $field_name (sort keys %{$this->{fields}}) {
      $this->field($field_name,$index) or next;
      push @field_names, $field_name;
    }
    return @field_names;
  } else {
    return sort keys %{$this->{fields}};
  }
}

sub indices {
  my ($this,$field_name) = @_;

  my @field_names;
  if ($field_name) {
    @field_names = ($field_name);
  } else {
    @field_names = $this->field_names();
  }

  my %indices;
  for $field_name (@field_names) {
    my $list = $this->{fields}->{$field_name} or next;
    for my $n (0..$#$list) {
      $list->[$n] or next;
      $indices{$n+1}++;
    }
  }
  return sort { $a <=> $b } keys %indices;
}

sub verify_fields {
  my ($this,$vfields,$rvfields) = @_;
  $vfields  ||= $this->{verifies}->{field}  || {};
  $rvfields ||= $this->{verifies}->{rfield} || {};

  my $fs = $this->fieldspace();

  my $n_errors = 0;
  for my $field_name (sort keys %$vfields) {
    # do not verify field if we would just remove that field anyway.
    next if $rvfields->{$field_name};

    # get the field definition.
    my $field_def = $fs->field_def($field_name);

    # verify only dynamic fields in a group method.
    $field_def->{group} or next;

    # iterate through all available indices of this field
    for my $index ($this->indices($field_name)) {

      # set the cursor to this index.
      $this->set_cursor($index);

      # get the field
      my $field = $fs->get_field($field_name) or throw
	Error::Simple("$fs->{name} contains no '$field_name'");

      # verify the field.
      my ($success,$problems) = $field->verify();
      if (! $success) {
	for my $msg (@$problems) {
	  $fs->add_error("field",$msg,$field_name,$index);
	}
	$n_errors++;
      }
    }
  }

  # remove any ignored fields.
  if (my $ferror = $this->{errors}->{field}) {
    for my $field_name (keys %$rvfields) { 
      $ferror->remove_error('field',$field_name);
    }
  }

  $this->set_cursor(0);
}

=head

group_state:

n_items

fundamental_state:

first_item_n
n_items_per_page
n_pages_at_a_time

derived_state:

n_pages      = int( (n_items - 1) / n_items_per_page) + 1
page_n       = int( (first_item - 1) / n_items_per_page ) + 1
last_item_n  = min( (first_item + n_items_per_page - 1),  n_items )
last_page_n  = min( (first_page_n + n_pages_at_a_time - 1), n_pages )
first_page_n = page_n - ( (page_n - 1) % n_pages_at_a_time )
after_page_n = ((first_item - 1) % n_items_per_page) ? page_n : 0

configuration:

poss_n_items_per_page

specifiable:

first_item_n
page_n
n_items_per_page

=cut

sub import_controls {
  my ($this,$cgi) = @_;

  my $val;

  # determine the control names.
  #
  $this->determine_control_names();

  # find any first_item_n in the controls.
  #
  my $new_first_item_n;
  if ($val = $this->get_control_value($cgi,"first_item_n")) {
    $new_first_item_n = $val;

  } elsif ($val = $this->get_control_value($cgi,"next")) {
    $new_first_item_n = $this->first_item_n() + $this->n_items_per_page();

  } elsif ($val = $this->get_control_value($cgi,"prev")) {
    $new_first_item_n = $this->first_item_n() - $this->n_items_per_page();

  } elsif ($val = $this->get_control_value($cgi,"page_n")) {
    $new_first_item_n = $this->first_item_n_from_page_n($val);
  }

  # now, see if we are changing our items_per_page constraint.
  #
  if (my $n = $this->get_control_value($cgi,"n_items_per_page")) {
    $n = $this->n_items() || 1 if $n eq "All";
    $this->n_items_per_page($n);
    # invalidate the number of pages.
    $this->n_pages(-1);
    $this->page_n(-1);
  }

  # if we still don't have a first_item_n, consider other controls.
  #
  if (! $new_first_item_n) {
    my $page_n;
    if ($val = $this->get_control_value($cgi,"prev_pages")) {
      $page_n = $this->first_page_n() - $this->n_pages_at_a_time();
      $new_first_item_n = $this->first_item_n_from_page_n($page_n);
    } elsif ($val = $this->get_control_value($cgi,"prev_pages")) {
      $page_n = $this->first_page_n() + $this->n_pages_at_a_time();
      $new_first_item_n = $this->first_item_n_from_page_n($page_n);
    }
  }

  # if we have $new_first_item_n, validate it.
  #
  if ($new_first_item_n) {
    # first, validate lower boundary.
    if ($new_first_item_n < 1) {
      $new_first_item_n = 1;
    }
    # next, validate upper boundary.
    if (! $this->{dummy_ok} and $new_first_item_n > $this->n_items()) {
      $new_first_item_n = $this->first_item_n_from_page_n($this->n_pages());
    }
    # if the $new_first_item is the same as current, it is not new.
    if ($new_first_item_n == $this->first_item_n()) {
      undef $new_first_item_n;
    }
  }

  # effect changes if we have a new_first_item_n.
  #
  if ($new_first_item_n) {
    $this->first_item_n($new_first_item_n);
    $this->set_cursor($new_first_item_n);
    # invalidate quantities related to item_n or page_n
    $this->last_item_n(-1);
    $this->page_n(-1);
    $this->first_page_n(-1);
    $this->last_page_n(-1);
    $this->after_page_n(-1);
  }
}

sub determine_control_names {
  my ($this) = @_;

  my $control_names = $this->{control_names} = {};

  if (my @imports = @{$this->{import_controls}}) {
    my ($type,$name);
    while (@imports) {
      $type = shift @imports;
      $name = shift @imports;
      $control_names->{$type} ||= [];
      push @{$control_names->{$type}}, $name;
    }
  } else {
    my $gname = $this->name();
    for my $type (qw(prev next page_n refresh first_item_n
		     prev_pages next_pages n_items_per_page)) {
      $control_names->{$type} = [ "$gname:$type" ];
    }
  }
}

sub get_control_value {
  my ($this,$cgi,$type) = @_;

  my $control_names = $this->{control_names};
  $control_names->{$type} or return undef;

  my $ret_val;
  for my $name (@{$control_names->{$type}}) {
    defined $cgi->param($name) or next;
    $ret_val = $cgi->param($name);
    last;
  }

  return $ret_val;
}

##
## HTML controls.
##

sub html_prev_page_button {
  my ($this,$text,$cgi_name) = @_;
  $text ||= "<< Prev";
  $cgi_name ||= $this->name().":prev";
  $this->{export_controls}->{"prev=$cgi_name"}++;

  my %attr = (type => "submit", name => $cgi_name, value => $text);

  return html_tag("input",\%attr,[qw(type name value)]);
}

sub html_next_page_button {
  my ($this,$text,$cgi_name) = @_;
  $text ||= "Next >>";
  $cgi_name ||= $this->name().":next";
  $this->{export_controls}->{"next=$cgi_name"}++;

  my %attr = (type => "submit", name => $cgi_name, value => $text);

  return html_tag("input",\%attr,[qw(type name value)]);
}

sub html_page_select {
  my ($this,$text,$cgi_name) = @_;
  $text ||= "Go to page ->";
  $cgi_name ||= $this->name().":page_n";
  $this->{export_controls}->{"page_n=$cgi_name"}++;

  my $out = "<select name=\"$cgi_name\">\n";
  $out .= "<option value=\"0\" selected>$text</option>\n";

  # now, display the various page buttons.
  for (my $n=1; $n < $this->n_pages(); $n++) {
    $out .= "<option value=\"$n\">$n</option>\n";
  }

  $out .= "</select>\n";

  return $out;
}

sub html_refresh_button {
  my ($this,$text,$cgi_name) = @_;
  $text ||= "Refresh";
  $cgi_name ||= $this->name().":refresh";
  $this->{export_controls}->{"refresh=$cgi_name"}++;

  my %attr = (type => "submit", name => $cgi_name, value => $text);

  return html_tag("input",\%attr,[qw(type name value)]);
}

sub html_page_button {
  my ($this,$page_n,$text,$cgi_name) = @_;
  $page_n   ||= 1;
  $text     ||= $page_n;
  $cgi_name ||= $this->name().":page_n";
  $this->{export_controls}->{"page_n=$cgi_name"}++;

  my %attr = (type => "submit", name => $cgi_name, value => $text);

  return html_tag("input",\%attr,[qw(type name value)])."\n";
}

sub html_prev_pages_button {
  my ($this,$text,$cgi_name) = @_;
  $text ||= "<< More";
  $cgi_name ||= $this->name().":prev_pages";
  $this->{export_controls}->{"prev_pages=$cgi_name"}++;

  my %attr = (type => "submit", name => $cgi_name, value => $text);

  return html_tag("input",\%attr,[qw(type name value)]);
}

sub html_next_pages_button {
  my ($this,$text,$cgi_name) = @_;
  $text ||= "More >>";
  $cgi_name ||= $this->name().":next_pages";
  $this->{export_controls}->{"next_pages=$cgi_name"}++;

  my %attr = (type => "submit", name => $cgi_name, value => $text);

  return html_tag("input",\%attr,[qw(type name value)]);
}


sub html_page_buttons {
  my ($this,$prev_text,$next_text,$goto_name,$prev_name,$next_name) = @_;

  my $out = "";

  # if we the first page is not page 1, display the previous 
  if ($this->first_page_n() != 1) {
    $out .= $this->html_prev_pages_button($prev_text,$prev_name)."\n";
  }

  # now, display the various page buttons.
  for (my $page_n = $this->first_page_n();
       $page_n <= $this->last_page_n();
       $page_n++) {

    # if we are on the page to be indicated, do not provide button.
    if ($page_n == $this->page_n() and !$this->after_page_n()) {
      $out .= "[";
      $out .= $this->html_page_button($page_n,$page_n,$goto_name);
      $out .= "]\n";
      next;
    }

    # provide the current page button.
    $out .= $this->html_page_button($page_n,$page_n,$goto_name);

    # if we are between buttons, indicate so.
    if ($page_n == $this->after_page_n()) {
      $out .= "[&nbsp;]\n";
    }
  }

  # if we the first page is not page 1, display the previous
  if ($this->last_page_n() != $this->n_pages()) {
    $out .= $this->html_next_pages_button($next_text,$next_name)."\n";
  }

  return $out;
}

sub html_show_at_a_time {
  my ($this,$cgi_name) = @_;
  $cgi_name ||= $this->name().":n_items_per_page",
  $this->{export_controls}->{"n_items_per_page=$cgi_name"}++;

  my $out = "";

  # determine possible n_items_per_page options.
  #
  my @poss = @{$this->poss_n_items_per_page()};
  my $found;
  for my $i (@poss) {
    if ($i eq $this->n_items_per_page()) {
      $found++;
      last;
    }
  }
  if (!$found and $this->n_items_per_page() != $this->n_items) {
    $found or unshift @poss, $this->n_items_per_page();
  }

  for my $i (@poss) {
    my %attr = (type  => "radio", name  => $cgi_name, value => $i);
    if (($i eq $this->n_items_per_page()) or
	($i eq "All" and $this->n_items_per_page() == $this->n_items())) {
      $attr{checked}++;
    }
    $out .= ("<font size=\"+1\">".
	     html_tag("input",\%attr,[qw(type name value)]).
	     "</font>".$i."\n");
  }

  return $out;
}

1;
__END__

=head1 BUGS

No known bugs, but this does not mean no bugs exist.

=head1 SEE ALSO

L<AtomicData>, L<HTMLIO>, L<Field>.

=head1 COPYRIGHT

 PSP - Perl Server Pages
 Copyright (c) 2000, FundsXpress Financial Network, Inc.

 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
 License as published by the Free Software Foundation; either
 version 2 of the License, or (at your option) any later version.

 BECAUSE THIS LIBRARY IS LICENSED FREE OF CHARGE, THIS LIBRARY IS
 BEING PROVIDED "AS IS WITH ALL FAULTS," WITHOUT ANY WARRANTIES
 OF ANY KIND, EITHER EXPRESS OR IMPLIED, INCLUDING, WITHOUT
 LIMITATION, ANY IMPLIED WARRANTIES OF TITLE, NONINFRINGEMENT,
 MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, AND THE
 ENTIRE RISK AS TO SATISFACTORY QUALITY, PERFORMANCE, ACCURACY,
 AND EFFORT IS WITH THE YOU.  See the GNU Lesser General Public
 License for more details.

 You should have received a copy of the GNU Lesser General Public
 License along with this library; if not, write to the Free Software
 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA

=cut