DbFramework::ForeignKey - Foreign Key class

DbFramework documentation Contained in the DbFramework distribution.

Index

Code Index:

NAME

Top

DbFramework::ForeignKey - Foreign Key class

SYNOPSIS

Top

  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;

DESCRIPTION

Top

The DbFramework::ForeignKey class implements foreign keys for a table.

SUPERCLASSES

Top

DbFramework::Key

CLASS METHODS

Top

new($name,\@attributes,$primary)

Returns a new DbFramework::ForeignKey object.

$name is the name of the foreign key. @attributes is a list of DbFramework::Attribute objects from a single DbFramework::Table object which make up the key. $primary is the DbFramework::Primary object which the foreign key references.

OBJECT METHODS

Top

references($primary)

$primary should be a DbFramework::PrimaryKey object. If supplied it sets the primary key referenced by this foreign key. Returns the DbFramework::PrimaryKey object referenced by this foreign key.

as_html_form_field(\%values)

Returns an HTML selection box containing values and labels from the primary key columns in the related table. %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 html_select_field() in DbFramework::PrimaryKey.

sql_where()

Returns a string containing SQL 'WHERE' condition(s) to join the foreign key against the primary key of the related table.

SEE ALSO

Top

DbFramework::Key, DbFramework::PrimaryKey and DbFramework::Catalog.

AUTHOR

Top

Paul Sharpe <paul@miraclefish.com>

COPYRIGHT

Top

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.

DbFramework documentation Contained in the DbFramework distribution. 
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
##-----------------------------------------------------------------------------


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
##-----------------------------------------------------------------------------


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

sub _input_template {
  my $self   = attr shift;
  my $t_name = $BELONGS_TO ? $BELONGS_TO->name : 'UNKNOWN_TABLE';
  return qq{<TD><DbFKey ${t_name}.$NAME></TD>};
}

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

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{<TD BGCOLOR='$BGCOLOR'><DbValue ${name}.$attributes></TD>};
  print STDERR "\$out = $out\n" if $_DEBUG;
  $out;
}

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


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);
}
#------------------------------------------------------------------------------


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;