view release on metacpan or  search on metacpan

lib/DbFramework/PrimaryKey.pm  view on Meta::CPAN

      $table_name = $fk->references->belongs_to->name;
      @labels     = @{$fk->references->labels_l};
      $where{$table_name} = $fk->sql_where;
    } else {
      $table_name = $BELONGS_TO->name;
      @labels     = ($label);
    }
    push @{$tables{$table_name}},@labels;
    for ( @labels ) { $order .= "$table_name.$_," }
  }
  chop $order;

  my $from  = 'FROM ' . join(',',keys(%tables));
  my $select = 'SELECT ';
  # do this table first so that pk columns are returned at the front
  for ( @{$tables{$table_name}} ) { $select .= "$table_name.$_," }
  delete $tables{$table_name};
  while ( my($table,$col_ref) = each %tables ) {
    for ( @$col_ref ) { $select .= "$table.$_," }
  }
  chop $select;
  my @where = values(%where);
  my $where = @where ? 'WHERE ' : '';
  for ( my $i = 0; $i <= $#where; $i++ ) {
    $where .= ' AND ' if $i;
    $where .= $where[$i];
  }
  my $sql = "$select\n$from\n$where\n$order\n";
  print STDERR $sql if $_DEBUG;
  my $sth = DbFramework::Util::do_sql($BELONGS_TO->dbh,$sql);

  # prepare arguments for CGI methods
  my (@pk_values,%labels,@row);
  my $i = 0;
  $pk_values[$i++] = ''; $labels{''} = '** Any Value **';
  $pk_values[$i++] = 'NULL'; $labels{'NULL'} = 'NULL';
  while ( my $row_ref = $sth->fetchrow_arrayref ) {
    @row = @{$row_ref};
    my $pk = join(',',@row[0..$#pk_columns]); # pk fields
    $pk_values[$i++] = $pk;

    # label fields
    for ( @row[$#pk_columns+1..$#row] ) {
      $labels{$pk} .= ' ' if defined($labels{$pk});
      $labels{$pk} .= defined($_) ? $_ : 'NULL';
    }
  }

  $name = $pk unless $name;

  my $html;
  my $cgi = new CGI('');  # we just want this object for its methods
  if ( $multiple ) {
    $html = $cgi->scrolling_list(-name=>$name,
				 -values=>\@pk_values,
				 -labels=>\%labels,
				 -multiple=>'true',
				 -default=>$default,
				);
  } else {
    $html = $cgi->popup_menu(-name=>$name,
			     -values=>\@pk_values,
			     -labels=>\%labels,
			     -default=>$default,
			    );
  }

  return $html;
}

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

sub _input_template {
  my($self,@fk_attributes) = @_;
  attr $self;
  print STDERR "$self: _input_template(@fk_attributes)\n" if $_DEBUG;
  my $t_name = $BELONGS_TO ? $BELONGS_TO->name : 'UNKNOWN_TABLE';
  my $in;
  for my $attribute ( @INCORPORATES_L ) {
    my $a_name = $attribute->name;
    unless ( grep(/^$a_name$/,@fk_attributes) ) { # part of foreign key
      print STDERR "Adding $a_name to input template for pk in $t_name\n" if $_DEBUG;
      $in .= qq{<TD><DbField ${t_name}.${a_name}></TD>
};
    }
  }
  $in;
}

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

sub _output_template {
  my($self,@fk_attributes) = @_;
  attr $self;
  my $t_name = $BELONGS_TO ? $BELONGS_TO->name : 'UNKNOWN_TABLE';
  my $out;
  for ( @INCORPORATES_L ) {
    my $a_name = $_->name;
    unless ( grep(/^$a_name$/,@fk_attributes) ) { # part of foreign key
      $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 @fk_attributes = @_;
  my @attributes;
  for ( @INCORPORATES_L ) {
    my $a_name = $_->name;
    push(@attributes,$_)
      unless grep(/^$a_name$/,@fk_attributes); # part of foreign key