=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