=head1 NAME DbFramework::ForeignKey - Foreign Key class =head1 SYNOPSIS use DbFramework::ForeignKey; $fk = new DbFramework::ForeignKey($name,\@attributes,$primary); $pk = $fk->references($primary); $sql = $fk->as_sql; $html = $fk->as_html_form_field(\%values); $s = $fk->sql_where; =head1 DESCRIPTION The B class implements foreign keys for a table. =head1 SUPERCLASSES B =cut package DbFramework::ForeignKey; use strict; use base qw(DbFramework::Key); use Alias; use vars qw( $NAME $BELONGS_TO @INCORPORATES_L $BGCOLOR $_DEBUG ); # CLASS DATA my %fields = ( # ForeignKey 0:N References 1:1 PrimaryKey REFERENCES => undef, ); ##----------------------------------------------------------------------------- ## CLASS METHODS ##----------------------------------------------------------------------------- =head1 CLASS METHODS =head2 new($name,\@attributes,$primary) Returns a new B object. I<$name> is the name of the foreign key. I<@attributes> is a list of B objects from a single B object which make up the key. I<$primary> is the B object which the foreign key references. =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->references(shift); $self->bgcolor('#777777'); return $self; } ##----------------------------------------------------------------------------- ## OBJECT METHODS ##----------------------------------------------------------------------------- =head1 OBJECT METHODS =head2 references($primary) I<$primary> should be a B object. If supplied it sets the primary key referenced by this foreign key. Returns the B object referenced by this foreign key. =cut #----------------------------------------------------------------------------- sub _input_template { my $self = attr shift; my $t_name = $BELONGS_TO ? $BELONGS_TO->name : 'UNKNOWN_TABLE'; return qq{}; } #----------------------------------------------------------------------------- sub _output_template { my $self = attr shift; # output template consists of attributes from related pk table my $pk_table = $self->references->belongs_to; my $name = $pk_table->name; my $attributes = join(',',$pk_table->attribute_names); my $out = qq{}; print STDERR "\$out = $out\n" if $_DEBUG; $out; } #------------------------------------------------------------------------------ =head2 as_html_form_field(\%values) Returns an HTML selection box containing values and labels from the primary key columns in the related table. I<%values> is a hash whose keys are the attribute names of the foreign key and whose values indicate the item in the selection box which should be selected by default. See L. =cut sub as_html_form_field { my $self = attr shift; my %values = $_[0] ? %{$_[0]} : (); my $pk = $self->references; my $name = join(',',$self->attribute_names); # only handles single attribute foreign keys my $t_name = $BELONGS_TO->name; my @fk_value; $fk_value[0] = $values{"${t_name}.${name}"}; if ( $_DEBUG ) { print STDERR "\$t_name = $t_name, \$name = $name, \@fk_value = @fk_value\n"; print STDERR "pk table = ",$pk->belongs_to->name,"\n"; } $pk->html_select_field(undef,undef,\@fk_value,$name); } #------------------------------------------------------------------------------ =head2 sql_where() Returns a string containing SQL 'WHERE' condition(s) to join the foreign key against the primary key of the related table. =cut sub sql_where { my $self = shift; my $fk_table = $self->belongs_to->name; my @fk_columns = $self->attribute_names; my $pk_table = $self->references->belongs_to->name; my @pk_columns = $self->references->attribute_names; my $where; for ( my $i = 0; $i <= $#fk_columns; $i++ ) { $where .= ' AND ' if $where; $where .= "$fk_table.$fk_columns[$i] = $pk_table.$pk_columns[$i]"; } $where; } 1; =head1 SEE ALSO L, L and L. =head1 AUTHOR Paul Sharpe Epaul@miraclefish.comE =head1 COPYRIGHT Copyright (c) 1997,1998,1999 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