The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
=head1 NAME

DbFramework::Key - Key class

=head1 SYNOPSIS

  use DbFramework::Key;
  $k     = new DbFramework::Key($name,\@attributes);
  $name  = $k->name($name);
  @a     = @{$k->incorporates_l(\@attributes)};
  @names = $k->attribute_names;
  $sql   = $k->as_sql;
  $table = $k->belongs_to($table);
  $html  = $k->as_html_heading;

=head1 DESCRIPTION

The B<DbFramework::Key> class implements keys (indexes) for a table.

=head1 SUPERCLASSES

B<DbFramework::Util>

=cut

package DbFramework::Key;
use strict;
use base qw(DbFramework::Util);
use Alias;
use vars qw( $NAME @INCORPORATES_L $BELONGS_TO $BGCOLOR );

my %fields = (
	      NAME           => undef,
	      # Key 0:N Incorporates 0:N Attribute
	      INCORPORATES_L => undef,
	      # Key 1:1 BelongsTo 1:1 Table
	      BELONGS_TO     => undef,
	      BGCOLOR        => '#ffffff',
	     );

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

=head1 CLASS METHODS

=head2 new($name,\@attributes)

Create a new B<DbFramework::Key> object.  I<$name> is the name of the
key. I<@attributes> is a list of B<DbFramework::Attribute> objects
from a single B<DbFramework::Table> object which make up the key.

=cut

sub new {
  my $DEBUG = 0;
  my $proto = shift;
  my $class = ref($proto) || $proto;
  print STDERR "=>$class::new(@_)\n" if $DEBUG;
  my $self  = bless { _PERMITTED => \%fields, %fields, }, $class;
  $self->name(shift);
  $self->incorporates_l(shift);
  print STDERR "<=$class::new()\n" if $DEBUG;
  return $self;
}

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

=head1 OBJECT METHODS

A key incorporates 0 or more attributes.  These attributes can be
accessed using the attribute I<INCORPORATES_L>.  See
L<DbFramework::Util/AUTOLOAD()> for the accessor methods for this
attribute.

=head2 name($name)

If I<$name> is supplied sets the data model name.  Returns the data
model name.

=head2 belongs_to($table)

I<$table> is a B<DbFramework::Table> object.  If supplied sets the
table to which this key refers to I<$table>.  Returns a
B<DbFramework::Table>.

=head2 bgcolor($bgcolor)

If I<$color> is supplied sets the background colour for HTML table
cells.  Returns the current background colour.

=head2 attribute_names()

Returns a list of the names of the attributes which make up the key.

=cut

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

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

=head2 as_sql()

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

=cut

sub as_sql {
  my $self = attr shift;
  return "KEY $NAME (" . join(',',$self->attribute_names) . ")";
}

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

sub _input_template {
  my $self   = attr shift;
  my $t_name = $BELONGS_TO ? $BELONGS_TO->name : 'UNKNOWN_TABLE';
  my $in;
  my $bgcolor = $self->bgcolor;
  for ( @INCORPORATES_L ) {
    my $a_name = $_->name;
    $in .= qq{<TD><DbField ${t_name}.${a_name}></TD>};
  }
  $in;
}

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

sub _output_template {
  my $self   = attr shift;
  my $t_name = $BELONGS_TO ? $BELONGS_TO->name : 'UNKNOWN_TABLE';
  my $out;
  for ( @INCORPORATES_L ) {
    my $a_name = $_->name;
    $out .= qq{<TD BGCOLOR='$BGCOLOR'><DbValue ${t_name}.${a_name}></TD>};
  }
  $out;
}

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

=head2 as_html_heading()

Returns a string for use as a column heading cell in an HTML table;

=cut

sub as_html_heading {
  my $self = attr shift;
  my $html = "<TD BGCOLOR='$BGCOLOR' COLSPAN=".scalar(@INCORPORATES_L).">";
  for ( @INCORPORATES_L ) { $html .= $_->name . ',' }
  chop($html);
  "$html</TD>";
}

1;

=head1 SEE ALSO

L<DbFramework::ForeignKey>, L<DbFramework::PrimaryKey> and
L<DbFramework::Catalog>.

=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