=head1 NAME

DbFramework::Table - Table class

=head1 SYNOPSIS

  use DbFramework::Table;
  $t = new DbFramework::Table($name,,,$dbh,\%templates);
  $t->init_db_metadata;
  $pk   = $t->is_identified_by($pk);
  @fks  = @{$t->has_foreign_keys_l};
  @keys = @{$t->is_accessed_using_l};
  @a    = $t->get_attributes(@names);
  @n    = $t->get_attribute_names;
  $html = $t->as_html_form;
  $s    = $t->as_string;
  $sql  = $t->as_sql;
  $rows = $t->delete($conditions);
  $pk   = $t->insert(\%values);
  $rows = $t->update(\%values,$conditions);
  @lol  = $t->select(\@columns,$conditions,$order);
  $tmpl = $t->set_templates(\%templates);
  $fill = $t->fill_template($template);
  do_something if $t->in_foreign_key($attribute);
  do_something if $t->in_key($attribute);
  do_something if $t->in_primary_key($attribute);
  do_something if $t->in_any_key($attribute);
  @a = $t->non_key_attributes;

=head1 DESCRIPTION

A B<DbFramework::Table> object represents n database table (entity).

=head1 SUPERCLASSES

B<DbFramework::DefinitionObject>

B<DbFramework::DataModelObject>

=cut

package DbFramework::Table;
use strict;
use vars qw( $NAME @CONTAINS_L $IS_IDENTIFIED_BY $_DEBUG @IS_ACCESSED_USING_L
	     @HAS_FOREIGN_KEYS_L $DBH %TEMPLATE_H @CGI_PK );
use base qw(DbFramework::DefinitionObject DbFramework::DataModelObject);
use DbFramework::PrimaryKey;
use DbFramework::DataType;
use DbFramework::Attribute;
use Alias;
use Carp;
use CGI;

# CLASS DATA

my %fields = (
	      # Entity 1:1 IsIdentifiedBy 1:1 PrimaryKey
	      IS_IDENTIFIED_BY    => undef,
	      # Entity 1:1 HasForeignKeys 0:N ForeignKey
	      HAS_FOREIGN_KEYS_L  => undef,
	      HAS_FOREIGN_KEYS_H  => undef,
	      # Table 1:1 IsAccessedUsing 0:N Key
	      IS_ACCESSED_USING_L => undef,
	      DBH                 => undef,
	      TEMPLATE_H          => undef,
	     );

##-----------------------------------------------------------------------------
## CLASS METHODS
##-----------------------------------------------------------------------------

=head1 CLASS METHODS

=head2 new($name,\@attributes,$primary,$dbh,\%templates)

Create a new B<DbFramework::Table> object.  I<$dbh> is a DBI database
handle which refers to a database containing a table named I<$table>.
I<@attribues> is a list of B<DbFramework::Attribute> objects.
I<$primary> is a B<DbFramework::PrimaryKey> object.  I<@attributes>
and I<$primary> can be omitted if you plan to use the
B<init_db_metadata()> object method (see below).  I<%templates> is a
hash of template name value pairs (see the object method
set_templates() below.)

=cut

sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;
  my $self  = bless($class->SUPER::new(shift,shift),$class);
  for my $element (keys %fields) {
    $self->{_PERMITTED}->{$element} = $fields{$element};
  }
  @{$self}{keys %fields} = values %fields;
  $self->is_identified_by(shift);
  $self->dbh(shift);
  $self->set_templates(%{$_[0]}) if $_[0];
  return $self;
}

##-----------------------------------------------------------------------------
## OBJECT METHODS
##-----------------------------------------------------------------------------

=head1 OBJECT METHODS

Foreign keys in a table can be accessed using the
I<HAS_FOREIGN_KEYS_L> and I<HAS_FOREIGN_KEYS_H> attributes.  B<Note>
that foreign key objects will not be created automatically by calling
init_db_metadata() on a table object.  If you want to automatically
create foreign key objects for your tables you should use call
init_db_metadata() on a data model object (see
L<DbFramework::Datamodel/init_db_metadata()>).  Other keys (indexes)
defined for a table can be accessed using the I<IS_ACCESSED_USING_L>
attribute.  See L<DbFramework::Util/AUTOLOAD()> for the accessor
methods for these attributes.

=head2 is_identified_by($primary)

I<$primary> is a B<DbFramework::PrimaryKey> object.  If supplied, sets
the table's primary key to I<$primary>.  Returns a
B<DbFramework::PrimaryKey> object with is the table's primary key.

=head2 get_attributes(@names)

Returns a list of B<DbFramework::Attribute> objects.  I<@names> is a
list of attribute names to return.  If I<@names> is undefined, all
attributes associated with the table are returned.

=cut

sub get_attributes {
  my $self = attr shift;
  print STDERR "getting attributes for (",join(',',@_),")\n" if $_DEBUG;
  return @_ ? $self->contains_h_byname(@_) # specific attributes
            : @{$self->contains_l};	   # all attributes
}

##-----------------------------------------------------------------------------

=head2 get_attribute_names()

Returns a list of attribute names for the table.

=cut

sub get_attribute_names {
  my $self = attr shift;
  my @names;
  for ( @CONTAINS_L ) { push(@names,$_->name) }
  @names;
}

#------------------------------------------------------------------------------

=head2 as_html_form()

Returns HTML form fields for all non foreign key attributes in the
table.

=cut

sub as_html_form {
  my $self = attr shift;
  my $form;
  for ( @{$self->contains_l} ) {
    next if $self->in_foreign_key($_);
    $form .= $_->as_html_form_field . "\n";
  }

  return $form;
}

#------------------------------------------------------------------------------

=head2 in_foreign_key($attribute)

I<$attribute> is a B<DbFramework::Attribute> object.  Returns true if
I<$attribute> is a part of any foreign key in the table.

=cut

sub in_foreign_key {
  my($self,$attribute) = (attr shift,shift);
  my $name = $attribute->name;
  my @fk_names = ();
  print STDERR "foreign keys: @HAS_FOREIGN_KEYS_L\n" if $_DEBUG;
  for ( @HAS_FOREIGN_KEYS_L ) { push(@fk_names,$_->attribute_names) }
  print STDERR "Looking for $name in @fk_names\n" if $_DEBUG;
  return grep(/^$name$/,@fk_names) ? 1 : 0;
}

#------------------------------------------------------------------------------

=head2 in_primary_key($attribute)

I<$attribute> is a B<DbFramework::Attribute> object.  Returns true if
I<$attribute> is a part of the primary key in the table.

=cut

sub in_primary_key {
  my($self,$attribute) = (attr shift,shift);
  my $name     = $attribute->name;
  my @pk_names = $self->is_identified_by->attribute_names;
  print STDERR "Looking for $name in @pk_names\n" if $_DEBUG;
  return grep(/^$name$/,@pk_names) ? 1 : 0;
}

#------------------------------------------------------------------------------

=head2 in_key($attribute)

I<$attribute> is a B<DbFramework::Attribute> object.  Returns true if
I<$attribute> is a part of a key (index) in the table.

=cut

sub in_key {
  my($self,$attribute) = (attr shift,shift);
  my @k_names = ();
  my $name    = $attribute->name;
  for ( @IS_ACCESSED_USING_L ) { push(@k_names,$_->attribute_names) }
  print STDERR "Looking for $name in @k_names\n" if $_DEBUG;
  return grep(/^$name$/,@k_names) ? 1 : 0;
}

#------------------------------------------------------------------------------

=head2 in_any_key($attribute)

I<$attribute> is a B<DbFramework::Attribute> object.  Returns true if
I<$attribute> is a part of a key (index), a primary key or a foreign
key in the table.

=cut

sub in_any_key {
  my($self,$attribute) = (attr shift,shift);
  print STDERR "$self->in_any_key($attribute)\n" if $_DEBUG;
  return ($self->in_key($attribute)         ||
	  $self->in_primary_key($attribute) ||
	  $self->in_foreign_key($attribute)) ? 1 : 0;
}

#------------------------------------------------------------------------------

=head2 non_key_attributes()

Returns a list of B<DbFramework::Attribute> objects which are not
members of any key, primary key or foreign key.

=cut

sub non_key_attributes {
  my $self = attr shift;
  my @non_key;
  for ( @CONTAINS_L ) { push(@non_key,$_) unless $self->in_any_key($_) }
  @non_key;
}

#------------------------------------------------------------------------------

#=head2 html_hidden_pk_list()

#Returns a 'hidden' HTML form field whose key consists of the primary
#key column names separated by '+' characters and whose value is the
#current list of @CGI_PK

#=cut

#sub html_hidden_pk_list {
#  my $self   = attr shift;
#  my $cgi    = new CGI('');
#  return $cgi->hidden(join('+',@{$PRIMARY->column_names}),@CGI_PK) . "\n";
#}

#------------------------------------------------------------------------------

=head2 as_string()

Return table details as a string.

=cut

sub as_string {
  my $self = attr shift;
  my $s    = "Table: $NAME\n";
  for ( @{$self->contains_l} ) { $s .= $_->as_string }
  return $s;
}

##-----------------------------------------------------------------------------

=head2 init_db_metadata()

Returns an initialised B<DbFramework::Table> object for the table
matching this object's name() in the database referenced by dbh().

=cut

sub init_db_metadata {
  my $self  = attr shift;

  my($sql,$sth,$rows,$rv);
  $sql   = qq{DESCRIBE $NAME};
  $sth   = $DBH->prepare($sql) || die($DBH->errstr);
  $rv    = $sth->execute       || die($sth->errstr);
  $rows  = $sth->rows;
  my @columns;
  for ( my $i = 1; $i <= $rows; $i++ ) {
    my %row = %{$sth->fetchrow_hashref};
    
    my $d = new DbFramework::DataType($row{Type} =~ /^(\w+)\(*.*$/,
                                      $row{Type} =~ /^\w+\((\d+)\)$/,
                                      $row{Extra}
                                     );
    my $a = new DbFramework::Attribute($row{Field},
                                       $row{Default},
                                       $row{Null} eq 'YES' ? 1 : 0,
                                       $d
                                      );
    push(@columns,$a);
  }
  $self->_init(\@columns);

  ## add keys
  my(%keys,$key,@row,@keys);
  $sql = qq{SHOW KEYS FROM $NAME};
  $sth = $DBH->prepare($sql) || die($DBH->errstr);
  $rv  = $sth->execute       || die($sth->errstr);
  while ( @row = $sth->fetchrow_array ) {
    push(@{$keys{$row[2]}},$row[4]);
  }

  for ( keys(%keys) ) {
    my @attributes = $self->get_attributes(@{$keys{$_}});
    if ( $_ eq 'PRIMARY' ) {    # primary key
      my $pk = new DbFramework::PrimaryKey(\@attributes);
      $pk->belongs_to($self);   # reverse reference
      $self->is_identified_by($pk);
    } elsif ( $_ !~ /^f_/i ) {  # key (not foreign)
      my $k = new DbFramework::Key($_,\@attributes);
      $k->belongs_to($self);    # reverse reference
      push(@keys,$k);
    }
  }
  $self->is_accessed_using_l(\@keys);

  $self->_templates;  # set default templates

  return $self;
}

#------------------------------------------------------------------------------

=head2 as_sql()

Returns a string which can be used to create a table in an SQL 'CREATE
TABLE' statement.

=cut

sub as_sql {
  my $self = attr shift;
  my $sql = "CREATE TABLE $NAME (\n";
  for ( @{$self->contains_l} ) { $sql .= "\t" . $_->as_sql($DBH) . ",\n"; }
  $sql .= "\t" . $IS_IDENTIFIED_BY->as_sql;
  for ( @IS_ACCESSED_USING_L ) { $sql .= ",\n\t" . $_->as_sql }
  for ( @HAS_FOREIGN_KEYS_L )  { $sql .= ",\n\t" . $_->as_sql }
  return "$sql\n)";
}

#------------------------------------------------------------------------------

#=head2 validate_foreign_keys()

#Ensure that foreign key definitions match related primary key
#definitions.

#=cut

sub validate_foreign_keys {
  my $self = shift;
  attr $self;

  for my $fk ( @HAS_FOREIGN_KEYS_L ) {
    my $fk_name       = $fk->name;
    my @fk_attributes = @{$fk->incorporates_l};
    my @pk_attributes = @{$fk->references->incorporates_l};
    @fk_attributes == @pk_attributes ||
      die "Number of attributes in foreign key $NAME:$fk_name(",scalar(@fk_attributes),") doesn't match that of related primary key (",scalar(@pk_attributes),")";
    for ( my $i = 0; $i <= $#fk_attributes; $i++) {
      my($fk_aname,$pk_aname) =
        ($fk_attributes[$i]->name,$pk_attributes[$i]->name);
      print STDERR "$fk_aname eq $pk_aname\n" if $_DEBUG;
      $fk_aname eq $pk_aname ||
        die "foreign key component $NAME:$fk_aname ne primary key component $pk_aname\n";
    }
  }
}

#------------------------------------------------------------------------------

=head2 delete($conditions)

B<DELETE> rows B<FROM> the table associated with this object B<WHERE>
the conditions in I<$conditions> are met.  Returns the number of rows
deleted.

=cut

sub delete {
  my($self,$conditions) = (attr shift,shift);

  my $sql  = "DELETE FROM $NAME";
     $sql .= " WHERE $conditions" if $conditions;
  print STDERR "$sql\n" if $_DEBUG;
  return $DBH->do($sql) || die($DBH->errstr);
}
#------------------------------------------------------------------------------

=head2 insert(\%values)

B<INSERT INTO> the table columns corresponding to the keys of
I<%values> the B<VALUES> corresponding to the values I<%values>.
Returns the primary key of the inserted row if it is a Mysql
'AUTO_INCREMENT' column.

=cut

sub insert {
  my $self   = attr shift;
  my %values = %{$_[0]};

  my $columns = '(' . join(',',keys(%values)). ')';
  my $values;
  for ( values(%values) ) { $values .= $DBH->quote($_) . ',' }
  chop $values;

  my $sql = "INSERT INTO $NAME $columns VALUES ($values)";
  print STDERR "$sql\n" if $_DEBUG;
  my $sth = $DBH->prepare($sql) || die $DBH->errstr;
  my $rv  = $sth->execute       || die $sth->errstr;
  my $rc  = $sth->finish;

  return $sth->{'insertid'}; # id of auto_increment field (DBD::mysql specific)
}
#------------------------------------------------------------------------------

=head2 update(\%values,$conditions)

B<UPDATE> the table B<SET>ting the columns matching the keys in
%values to the values in %values B<WHERE> I<$conditions> are
met. Returns the number of rows updated.

=cut

sub update {
  my $self = attr shift;
  my %values     = %{$_[0]};
  my $conditions = $_[1];

  my $values;
  for ( keys %values ) { $values .= "$_ = " . $DBH->quote($values{$_}) . ',' }
  chop $values;
  
  my $sql  = "UPDATE $NAME SET $values";
     $sql .= " WHERE $conditions" if $conditions;
  print STDERR "$sql\n" if $_DEBUG;
  return $DBH->do($sql) || die($DBH->errstr);
}

#------------------------------------------------------------------------------

=head2 select(\@columns,$conditions,$order)

Returns a list of lists of values by B<SELECT>ing rows B<FROM> the
table B<WHERE> I<$conditions> are met B<ORDER>ed B<BY> I<$order>.

=cut

sub select {
  my $self = attr shift;
  my @columns = defined($_[0]) ? @{$_[0]} : @{$self->get_attribute_names};
  my($conditions,$order) = @_[1..2];
  my $sql        = "SELECT " . join(',',@columns) . " FROM $NAME";
     $sql       .= " WHERE $conditions" if $conditions;
     $sql       .= " ORDER BY $order"   if $order;
  print STDERR "$sql\n" if $_DEBUG;
  my $sth        = $DBH->prepare($sql) || die($DBH->errstr);
  my $rv         = $sth->execute       || die "$sql\n" . $sth->errstr . "\n";
  my @things;
  # WARNING!
  # Can't use fetchrow_arrayref here as it returns the *same* ref (man DBI)
  while ( my @attributes = $sth->fetchrow_array ) {
    print "@attributes\n" if $_DEBUG;
    push(@things,\@attributes);
  }
  if ( $_DEBUG ) {
    print "@things\n";
    for ( @things ) { print "@{$_}\n" }
  }
  return @things;
}
##-----------------------------------------------------------------------------

=head2 fill_template($name,\%values)

Return the filled template named I<$name>.  A template can contain
special placeholders representing columns in a database table.
Placeholders in I<$template> can take the following forms:

=over 4

=item B<E<lt>DbField table.columnE<gt>>

=item B<E<lt>DbField table.column value=valueE<gt>>

=item B<E<lt>DbField table.column value=value type=typeE<gt>>

=item B<E<lt>DbValue table.columnE<gt>>

=back

If the table's name() matches I<table> in a B<DbField> placeholder,
the placeholder will be replaced with the corresponding HTML form
field for the column named I<column> with arguments I<value> and
I<type> (see L<DbFramework::Attribute/html_form_field()>).  If
I<%values> is supplied, placeholders will have the values in
I<%values> added where a key in I<%values> matches a column name in
the table.

B<DbValue> placeholders will be replaced with the values in I<%values>
where a key in I<%values> matches a column name in the table.

=cut

sub fill_template {
  my($self,$name,$values) = (attr shift,shift,shift);
  print STDERR "filling template '$name' for table '$NAME'\n" if $_DEBUG;
  return '' unless exists $TEMPLATE_H{$name};
  my $template = $TEMPLATE_H{$name};
  print STDERR "template = \n$TEMPLATE_H{$name}\n" if $_DEBUG;

  # insert values into template
  if ( defined($values) ) {
    $template =~ s/(<DbField\s+$NAME\.)(\w+)(\s+value=)(.*?\s*)>/$1$2 value=$values->{$2}>/g;
    $template =~ s/(<DbField $NAME\.)(\w+)>/$1$2 value=$values->{$2}>/g;
    $template =~ s/<DbValue\s+$NAME\.(\w+)\s*>/$values->{$1}/g;
  }

  # foreign key placeholders
  $template =~ s/<DbFKey\s+$NAME\.(\w+)\s*>/$self->_as_html_foreign_key($1)/eg;

  # form field placeholders
  $template =~ s/<DbField\s+$NAME\.(\w+)\s+value=(.*?)\s+type=(.*?)>/$self->_as_html_form_field($1,$2,$3)/eg;
  $template =~ s/<DbField\s+$NAME\.(\w+)\s+value=(.*?)>/$self->_as_html_form_field($1,$2)/eg;
  $template =~ s/<DbField $NAME\.(\w+)>/$self->_as_html_form_field($1)/eg;
  $template;
}

#------------------------------------------------------------------------------

sub _as_html_form_field {
  my($self,$attribute) = (shift,shift);
  my @attributes = $self->get_attributes($attribute);
  $attributes[0]->as_html_form_field(@_);
}

#------------------------------------------------------------------------------

sub _as_html_foreign_key {
  my($self,$fk_name) = @_;
  attr $self;
  $self->has_foreign_keys_h_byname($fk_name)->references->html_select_field;
}

#------------------------------------------------------------------------------

=head2 set_templates(%templates)

Adds the contents of the files which are the values in I<%templates>
as templates named by the keys in I<%templates>.  Returns a reference
to a hash of all templates.

=cut

sub set_templates {
  my $self = attr shift;
  if ( @_ ) {
    my %templates = @_;
    my @templates;
    for ( keys %templates ) {
      open(T,"<$templates{$_}") || die "Couldn't open template $templates{$_}";
      my @t = <T>;
      close T;
      push(@templates,$_,"@t");
    }
    $self->template_h(\@templates);
  }
  \%TEMPLATE_H;
}

#------------------------------------------------------------------------------

sub _templates {
  my $self = attr shift;
  $self->_template('input','_input_template');
  $self->_template('output','_output_template');
}

#------------------------------------------------------------------------------

sub _template {
  my($self,$key,$method) = (attr shift,shift,shift);
  my @fk_attributes;
  for ( @HAS_FOREIGN_KEYS_L ) { push(@fk_attributes,$_->attribute_names) }
  my $t = $IS_IDENTIFIED_BY->$method(@fk_attributes);
  for ( $self->non_key_attributes ) { $t .= $_->$method($NAME) }
  for ( @IS_ACCESSED_USING_L )      { $t .= $_->$method() }
  for ( @HAS_FOREIGN_KEYS_L )       { $t .= $_->$method() }
  $self->template_h_add({$key => $t});
}

1;

=head1 SEE ALSO

L<DbFramework::DefinitionObject>, L<DbFramework::Attribute> and
L<DbFramework::DataModelObject>.

=head1 AUTHOR

Paul Sharpe E<lt>paul@miraclefish.comE<gt>

=head1 COPYRIGHT

Copyright (c) 1997,1998 Paul Sharpe. England.  All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

