DBIx::Frame - a perl module for creating and maintaining DBI frameworks

  use DBIx::Frame;
  DBIx::Frame->init('server', 'dbtype') || exit(0);
  my $DB = DBIx::Frame->new('database', 'user', 'pass') 
    or die("Couldn't connect to database: ", DBI->errstr);

$VERSION = "1.06";
package DBIx::Frame;
our $VERSION = "1.06";

# -*- Perl -*- 		Wed May 26 09:23:06 CDT 2004 
###############################################################################
# Written by Tim Skirvin <tskirvin@ks.uiuc.edu>
# Copyright 2000-2004, Tim Skirvin and UIUC Board of Trustees.  
# Redistribution terms are below.
###############################################################################

use strict;
use DBI;
use SelfLoader;
require Exporter;

use vars qw( $SERVER $DBTYPE $USER $PASS $DBNAME %FIELDS %KEYS %LIST %HTML 
	     %REQUIRED %ADMIN %TEXT %ORDER $DEBUG $ERROR );
$DEBUG ||= 0;		# Default of $DEBUG is 0 - must set it elsewhere

SelfLoader->load_stubs();	# Prepare module so it can be loaded elsewhere

1;

__DATA__	# Comment me out to test the functions without SelfLoader;

sub init {
  my ($class, $server, $dbtype, $database, $user, $pass, $dbname) = @_;
  $SERVER = $server   || $SERVER || "localhost";
  $DBTYPE = $dbtype   || $DBTYPE || "mysql";
  $DBNAME = $database || $DBNAME || "";
  $USER   = $user     || $USER   || "";    
  $PASS   = $pass     || $PASS   || "";
  1;
}

sub new { shift->connect(@_) }
sub connect { 
  my ($class, $database, $user, $pass, $server, $dbtype, %args) = @_;
  $dbtype   ||= $DBTYPE;  $server ||= $SERVER;
  $user     ||= $USER;    $pass   ||= $PASS;
  $database ||= $DBNAME;

  return undef unless ($dbtype && $server && $database);
  my $self = {};
  my $db = DBI->connect("DBI:$dbtype:$database:$server", 
		$user || undef, $pass || undef, ref %args ); 
  unless ( $db ) { $ERROR = DBI->errstr; return undef; }
  
  # Internal data - just keeps track of stuff that might come in handy 
  # later, but which we aren't telling the world about.  It couldn't hurt.
  $$self{'DATABASE'} = $database || undef;
  $$self{'DBTYPE'}   = $dbtype   || undef; $$self{'SERVER'} = $server || undef;
  $$self{'USER'}     = $user     || undef; $$self{'PASS'}   = $pass   || undef;
  $$self{'ARGS'}     = \%args    || {};
  $$self{'DBNAME'}   = $DBNAME   || $database || undef;

  # Public data - things that the users will modify. 
  $$self{'DB'}       = $db; 		$$self{'ERROR'}    = undef;
  $$self{'FIELDS'}   = \%FIELDS; 	$$self{'ADMIN'}    = \%ADMIN;
  $$self{'LIST'}     = \%LIST; 		$$self{'ORDER'}    = \%ORDER;
  $$self{'KEYS'}     = \%KEYS; 		$$self{'REQUIRED'} = \%REQUIRED;
  $$self{'HTML'}     = \%HTML; 		$$self{'TEXT'}     = \%TEXT;
  $$self{'QUERIES'}  = [];

  bless $self, $class; 
  $self;
}

sub table_add {
  my ($self, $name, $fields, $keys, $list, $order, $admin, $required,
 	$html, $text, @rest) = @_;
  return undef unless ($name && $fields && ref $fields);

  $self->set_fields(   $name, $fields);
  $self->set_admin(    $name, $admin || '');
  $self->set_list(     $name, $list  || [ keys %{$fields} ]);
  $self->set_order(    $name, $order || 'ID');
  $self->set_keys(     $name, $keys  || 'ID' );
  $self->set_required( $name, $required || $keys || 'ID');
  $self->set_html(     $name, $html  || sub { "No table available" });
  $self->set_text(     $name, $html  || sub { "No text available" });

  1;
}

sub add_table {
  my ($self, $name, $fields, $keys, $list, $html, $text, @rest) = @_;
  return undef unless $name;
  return undef unless ($fields && ref $fields);

  my $package = $self->_database;

  $self->set_fields($name, $fields);
  $self->set_keys($name, $keys || 'ID' );
  $self->set_list($name, $list || [ keys %{$fields} ]);

  $self->set_html($name, $html || sub { "No table available" });
  $self->set_text($name, $html || sub { "No text available" });

  1;
}

sub _set {
  my ($self, $hash, $name, $fields) = @_;
  return undef unless $name;

  my $package = $self->_database;

  $$hash{$package} ||= {};
  my $fullhash = $$hash{$package} || {};
  $fields ? $$fullhash{$name} = $fields : $$fullhash{$name};
}

sub set_fields   { shift->_set(\%DBIx::Frame::FIELDS,   @_) }
sub set_admin    { shift->_set(\%DBIx::Frame::ADMIN,    @_) }
sub set_list     { shift->_set(\%DBIx::Frame::LIST,     @_) }
sub set_order    { shift->_set(\%DBIx::Frame::ORDER,    @_) }
sub set_keys     { shift->_set(\%DBIx::Frame::KEYS,     @_) }
sub set_required { shift->_set(\%DBIx::Frame::REQUIRED, @_) }
sub set_html     { shift->_set(\%DBIx::Frame::HTML,     @_) }
sub set_text     { shift->_set(\%DBIx::Frame::TEXT,     @_) }

sub db { $_[0]{DB} }

sub connected { $_[0]{DB} ? 1 : 0 }

sub disconnect { $_[0]->{'DB'}->disconnect if $_[0]->db }

sub invoke {
  my ($self, $query) = @_;
  my $db = _db_or_die($self) || return undef;
  return undef unless defined($query);
  $self->add_query($query);
  my $return = $db->prepare($query)->execute;
  $return ? $return : $self->set_error(DBI->errstr) && return undef;
}

sub func { my $db = _db_or_die(shift) || return undef; $db->func(@_) }

sub quote     { shift->db->quote(@_) }
sub neat      { shift->db->neat(@_) }
sub neat_list { shift->db->neat_list(@_) }

sub insert {
  my ($self, $table, $datahash, $admin, @other)  = @_;  
  my $db = _db_or_die($self) || return undef;
  $self->_test_table($table) || return undef;	

  # Parse the insert information
  my $hash   = $self->_parse_hash($table, $datahash);
  unless ($hash) {
    $self->set_error("No data to insert into table '$table'");
    return undef;
  }

  # Unless we get an 'admin' flag, then don't let us work on admin fields
  my %present;
  unless ($admin) { 
    foreach my $field ($self->admin($table)) { 
      $present{$field}++ if 
	(defined $$datahash{$field} && $$datahash{$field} !~ m/^\s*$/);
    }
  }

  # Are all fields in 'required' present?
  my (%missing, %check);
  foreach my $field ($self->required($table)) {
    next if ($field eq 'ID');
    my $info = $$datahash{$field};  
    next unless defined $info; $info =~ s%^\s+|\s+$%%g; next if $info ne '';
    $missing{$field}++;
  }

  # Are all fields in 'key' present, and the entry used by 'key' unique?
  foreach my $field ($self->key($table)) { 
    if (defined $$datahash{$field} && $$datahash{$field} !~ m/^\s*$/) { 
      $check{$field} = $$datahash{$field}; 
    } else { $missing{$field}++ }
  }

  if (scalar keys %missing) {
    $self->set_error("Not all required fields set: still need " . 
		join(', ', keys %missing) );  
    return undef;
  } else {
    my @existing = $self->select($table, \%check);
    if (scalar @existing) { 
      $self->set_error("Entry already exists") && return undef;
    }
  }

  # We're good to go - proceed
  my $keys   = join(', ', keys %{$hash} ); 
  my $values = join(', ', values %{$hash} );  
  my $query = "INSERT INTO $table ( $keys ) VALUES ( $values )";

  $self->invoke($query);
}

sub update {
  my ($self, $table, $datahash, $selecthash, $admin ) = @_;
  my $db = _db_or_die($self) || return undef;
  $self->_test_table($table) || $self->set_error("Bad table") &&  return undef;

  my $hash   = $self->_parse_hash($table, $datahash)    || {};
  my $select = $self->_make_select($table, $selecthash, 0, 1) || "";
  unless ($select) {
    my @return = keys %{$selecthash};  my $return = join(', ', @return);
    $self->set_error("Couldn't get a selection out of $return");
    return undef;
  }

  my @list;
  foreach (keys %{$hash}) { 
    next unless defined($_) && defined($$hash{$_}); 
    $$hash{$_} =~ s%(^\s+|\s+$)%%;	# Lose the leading/trailing whitespace
    push (@list, "$_ = $$hash{$_}") 
  }

  # Unless we get an 'admin' flag, then don't let us work on admin fields
  my %present;
  unless ($admin) { 
    foreach my $field ($self->admin($table)) { 
      $present{$field}++ if 
	(defined $$datahash{$field} && $$datahash{$field} !~ m/^\s*$/);
    }
  }

  my $setlist = join(', ', @list);
  unless ($table && $setlist && $select) {
    $self->set_error("Not enough unformation for the update " . 
		                    "(S: $setlist S: $select)" );
    return undef;
  }
  my $query = "UPDATE $table SET $setlist $select";

  $self->invoke($query);
}

sub select {
  my ($self, $table, $datahash, $limit, $other, @extra) = @_;
  my $db = _db_or_die($self) || return undef;
  $table ||= {};  $limit ||= {};  $other ||= "";
  $self->_test_table($table) || return undef;

  # If LIMITHASH is actually a scalar, assume that this was the value of 
  # $limit{MATCH} (this was what it used to be before).
  if (ref($limit) eq '') { my $m = $limit; $limit = {};  $$limit{'MATCH'} = $m }

  # Make the query; note that _make_select() does most of the work.
  my $match = $$limit{'MATCH'} || "*"; 
  my $select = $self->_make_select($table, $datahash, $limit, 0, @extra) || "";
  my $query = "SELECT $match FROM $table $select $other";

  return undef unless $query;

  # Do the stuff that invoke would normally do
  $self->add_query($query);
  my $sth = $db->prepare($query);
  my $return = $sth->execute;  
  unless ($return) { $self->set_error(DBI->errstr) && return undef }

  # Get the results
  my @return;
  while (my $val = $sth->fetchrow_hashref) { push (@return, $val) }
  @return;
}

sub select_multi {
  my ($self, $tablehash, $limithash, $other, @extra) = @_;
  my $db = _db_or_die($self) || return undef;
  my $match = "*";  $other ||= "";

  # Create a complete hash out of all of the different hashes, using the
  # table names as extra indices.

  ( $self->set_error("Bad usage: select_multi()") && return undef )  
					unless ref $tablehash;
  my (%fullhash, @fields, @original);
  foreach my $table (keys %{$tablehash}) {
    $self->_test_table($table) || next;
    foreach (sort keys %{$self->fields($table)}) { 
      push @fields, \$_; push @original, "$table.$_";
    }
    my $hash = $$tablehash{$table};
    foreach (keys %{$hash}) { $fullhash{"$table.$_"} = $$hash{$_} }
  }

  # May eventually want to do something with 'match' as well

  my $table = join(", ", keys %{$tablehash});
  my $select = $self->_make_select_multi(
                [ keys %{$tablehash} ], \%fullhash, @extra ) || "";
  my $query = "SELECT $match FROM $table $select $other";

  return undef unless $query;

  # Do the stuff that invoke would normally do
  $self->add_query($query);
  my $sth = $db->prepare($query);
  my $return = $sth->execute;  
  unless ($return) { $self->set_error(DBI->errstr) && return undef }
  $sth->bind_columns( @fields );

  # Get the results, and reformat them appropriately
  my @return;
  while (my $val = $sth->fetchrow_arrayref) { 
    my %hash;
    for (my $i = 0; $i < @$val; $i++) {
      my $field = $original[$i]; my $value = $$val[$i];  
      $hash{$field} = $value; 
    }
    push @return, \%hash;
  }
  @return;
}

sub delete {
  my ($self, $table, $datahash) = @_;
  return undef unless ($datahash && ref $datahash);
  my $db = _db_or_die($self) || return undef;
  $self->_test_table($table) || return undef;

  my $select = $self->_make_select($table, $datahash, 0, 1) || return undef;
  $select =~ s/ORDER BY.*//;	# Deletes don't need these
  my $query = "DELETE FROM $table $select";

  $self->invoke($query);
}

sub create_table {
  my ($self, $table, $hash) = @_;
  my $db = _db_or_die($self) || return undef;

  # Figure out if we can actually create this table
  unless ($table) { $self->set_error("No table to create");  return undef }
  if ($self->_test_table($table)) { 
    $self->set_error("Table '$table' already exists");  
    return undef;
  } else { $self->clear_error(); }

  $hash ||= $self->fieldhash->{$table};
  return undef unless ref $hash;

  # Create the query
  my @query;
  foreach (sort keys %{$hash}) { push(@query, "$_ $$hash{$_}"); }
  my $query = "CREATE TABLE $table ( " . join(', ', @query) . " )";
  
  # Perform the query
  $self->invoke($query);
}

sub drop_table {
  my ($self, $table) = @_;
  my $db = _db_or_die($self) || return undef;
  $self->_test_table($table) || return undef;
  my $query = "DROP TABLE $table";	
  $self->invoke($query);
}

sub reset_table { $_[0]->drop_table($_[1]) && $_[0]->create_table($_[1]) }

sub set_error { 
  my ($self, @args) = @_;  
  my $error;
  foreach (@args) {  
    chomp;  next unless defined($_); 
    $error ? $error = join(' ', $error, $_)
	   : $error = $_ ; 
  }
  $$self{'ERROR'} = $error;
  $$self{'ERROR'} || undef;
}

sub error { ref $_[0] ? shift->{'ERROR'} || DBI->errstr || undef : $ERROR }
sub clear_error { shift->{'ERROR'} = ""; }

sub _return_error { shift->set_error(@_); undef }

sub add_query {
  my ($self, $query) = @_;
  return undef unless $query;
  push @{$self->{'QUERIES'}}, $query;
  @{$self->{'QUERIES'}};
}

sub clear_queries { shift->{'QUERIES'} = [] }

sub queries { wantarray ? @{$_[0]->{'QUERIES'}} : join("\n", $_[0]->{'QUERIES'}) }

sub version { $VERSION }

sub tables { 
  my $hash = fieldhash(@_); 
  $hash && ref $hash ? keys %{$hash} : "";
}

sub fields { 
  my ($self, $table, $database) = @_;
  $database ||= $self->_database() || "";
  return $self->fieldhash($database) unless $table;

  my $fieldhash = $self->fieldhash($database);  
  return undef unless $fieldhash && ref $fieldhash;

  my $fields = $$fieldhash{$table};  
  return undef unless $fields && ref $fields;

  return wantarray ? keys %{$fields} : $fields;
}

sub list {
  my ($self, $table, $database) = @_;
  $database ||= $self->_database() || "";
  return $self->listhash($database) unless $table;

  my $listhash = $self->listhash($database);  
  return undef unless $listhash && ref $listhash;

  my $list = $$listhash{$table};  
  return undef unless $list && ref $list;

  return wantarray ? @{$list} : $list;
}

sub key      { shift->_generic_list(\&keyhash, @_) }
sub required { shift->_generic_list(\&requiredhash, @_) }
sub admin    { shift->_generic_list(\&adminhash, @_) }
sub order    { shift->_generic_list(\&orderhash, @_) }

sub _generic_list {
  my ($self, $coderef, $table, $database) = @_;
  $database ||= $self->_database || "";
  my $hash = $self->$coderef($database);
  return $hash unless $table;
  return undef unless ($hash && ref $hash);
  
  my $return = $$hash{$table} || return undef;
  return ref $return ? wantarray ? @{$return} : $return
		     : wantarray ? $return : ( $return ) ;
}

sub html { shift->_generic_code(\&htmlhash, @_) }
sub text { shift->_generic_code(\&texthash, @_) }

sub _generic_code {
  my ($self, $coderef, $table, $database) = @_;
  $database ||= $self->_database || "";
  my $hash = $self->$coderef($database);
  return $hash unless $table;	
  return undef unless ($hash && ref $hash);
  
  my $return = $$hash{$table} || return undef;
  $return || undef;
}

sub list_head {
  my ($self, $table) = @_;
  return undef unless $table;

  my @return;

  my @list = $self->list($table);	# Get items out of %LIST
  foreach (@list) { push @return, ref $_ ? join(' ', keys %{$_} ) : $_; }
  wantarray ? @return : join("\n", @return);
}

sub make_list {
  my ($self, $table, @items) = @_;
  return undef unless $table;
  my @list = $self->list($table);	# Get items out of %LIST

  my @return;
  
  # Go through all of the items in @list, replacing them with _replace, 
  foreach my $item (@items) {	
    foreach (@list) {
      push @return, join(' ', $self->_replace( $item, ref $_ ? values %{$_} 
				         : join('', '$$', $_, '$$')) );
    }
  }
  @return;
}

sub _gethash {
  my ($self, $type, $database) = @_;
  $database ||= $self->_database || "";
  $database ? $$self{$type}->{$database} : $$self{$type};
}

sub fieldhash { shift->_gethash('FIELDS', @_) }
sub keyhash   { shift->_gethash('KEYS',   @_) }
sub adminhash { shift->_gethash('ADMIN',  @_) }
sub listhash  { shift->_gethash('LIST',   @_) }
sub orderhash { shift->_gethash('ORDER',  @_) }
sub htmlhash  { shift->_gethash('HTML',   @_) }
sub texthash  { shift->_gethash('TEXT',   @_) }
sub requiredhash { shift->_gethash('REQUIRED', @_) }

## Has to be slightly different, since we look for KEYS here if there is
## no REQUIRED present.
# sub requiredhash {
#   my ($self, $database) = @_;
#   $database ||= $self->_database || "";
#   $database ? $$self{REQUIRED}->{$database} || $$self{KEYS}->{$database} 
# 	    : $$self{REQUIRED} || $$self{KEYS};
# }

sub select_fieldlist {
  my ($self, $table, $field, $datahash, @other) = @_;
  return undef unless ($table && $field);
  my @list;
  foreach ( $self->select($table, $datahash || {}, $field, @other) ) {
    push @list, $$_{$field} if ref $_;
  }
  scalar @list ? @list : undef;
}

# Maybe this should confirm that there is an ID field first?
sub select_fieldlist_id {
  my ($self, $table, $field, $datahash, @other) = @_;
  return undef unless ($table && $field);
  my %hash;
  my $match = "$field, ID";
  foreach my $entry ( $self->select($table, $datahash || {}, $match, @other) ) {
    next unless ref $entry;
    my $id = $$entry{ID};  my $value = $$entry{$field};
    $hash{$id} = $value;
  }
  %hash;
}

sub select_list_id {
  my ($self, $table, $datahash, @other) = @_;
  return undef unless $table;
  my %hash;
  foreach my $entry ( $self->select($table, $datahash || {}, @other) ) {
    next unless ref $entry;
    my $id = $$entry{ID};
    my $array = [ $self->make_list($table, $entry) ];
    $hash{$id} = $array;
  }
  %hash;
}

##### INTERNAL FUNCTIONS #####
### _parse_hash ( TABLE, DATAHASH )
# Parses a datahash and returns an updated hash that only contains data 
# for the appropriate table.  Returns undef if there was no appropriate 
# data.
sub _parse_hash {
  my ($self, $table, $hash) = @_;
  return undef unless $table;
  my $db = $self->db || return undef;

  # Parse the hash information
  return undef unless ($hash && ref $hash);

  my %newhash;
  foreach my $key (sort keys %{$hash}) { 
    next unless ( defined $key && defined $$hash{$key} );
    my $shortkey = $key;  $shortkey =~ s/ .*$//;	
    my $type = $self->fields($table)->{$key};
    next unless defined($type);		# Not in the database - bad data
    $newhash{$key} = $type =~ /^\s*int/i ? $$hash{$key} || "''"
					 : $db->quote($$hash{$key});
    $newhash{$key} =~ s%(^\s+|\s+$)%%;	# Lose the leading/trailing whitespace
  }
  
  scalar(keys %newhash) ? \%newhash : undef;
}

### _test_table ( TABLE )
# Makes sure that the table exists in the open database.  Returns 1 if it 
# does, undef otherwise.  
sub _test_table {
  my $self = shift;
  my $db = $self->db || return undef;

  my $table = shift;
  unless ($table) { $self->set_error("No table given");  return undef }

  unless ( grep /^$table$/, $db->func( '_ListTables') ) {
    $self->set_error("Table '$table' doesn't exist");  return undef;
  }

  1;
}

### _make_select ( TABLE, HASH, LIMIT, NOORDER )
# Makes the "WHERE blah=blah and blah2=blah2" part of the SELECT statement,
# based on TABLE and HASH.  Returns undef if nothing is passed in, or "" if 
# there's nothing to select.  LIMIT is another hash reference, and is
# optional; it can be used to add 'ORDER BY' or 'LIMIT' bits.
sub _make_select {
  my ($self, $table, $hash, $limit, $noorder, $other) = @_;
  my $db = $self->db || return undef;
  return undef unless ($table && $hash && ref $hash);
  
  $limit ||= {};	 

  my @list;
  foreach my $key (sort keys %{$hash}) { 
    my $value = $$hash{$key} || "";  next if ($value =~ /^\s*$/);
    my $type = $self->fieldhash->{$table}->{$key}; 
    next unless defined($type);		# Not in the database - bad data
    if (ref $value) {  
      my @newlist;
      foreach my $val (@{$value}) {
        push @newlist, " $key $val " if $val;
      }
      push @list, "( " . join(" AND ", @newlist) . " )" if @newlist;
    } elsif ($type =~ /^\s*int/i) {
      my $option = "=" unless $key =~ /^\d+$/; 
      $value =~ s/^%|%$//g;	# We don't want wildcard matches here
      push (@list, "$key $option $value") if defined($value);
    } else { 
      $value =~ s%(^\s+|\s+$)%% if $other;  # Lose the leading/trailing 
					    # whitespace (usually)
      push (@list, "$key like " . $db->quote( $value ) ) if $value;
    }
  }
  
  my @final;
  push @final, join(" ", "WHERE", join(" AND ", @list)) if scalar @list;

  # Canonicalize the hash; note that all-caps will win.  It'd be better if 
  # the users only knew that all-caps work, though.
  foreach (sort keys %{$limit}) { $$limit{uc($_)} = $$limit{$_}; }

  # Ordering data is now part of the deal
  my $order = _fix_order( $$limit{'ORDER'} || $self->order($table) || "");
  push @final, $order if ($order && !$noorder);

  # Limiting data doesn't work yet, probably.  Maybe later.  Let's at
  # least try, though.
  my $lim = _fix_limit( $$limit{'LIMIT'} || "");
  push @final, $lim if $lim;
  # if ($$limit{'LIMIT'}) { push @final, "LIMIT $$limit{'LIMIT'}" }

  scalar @final ? join(" " , @final) : "";
}

### _fix_order ( ENTRY [, ENTRY [...]])
# Splits on commas or whitespace, and makes an "ORDER BY [...]" bit for a
# SELECT statement.  
sub _fix_order {
  my @hash;
  my $canon = _canon(shift);
  foreach my $item (split /\s+|\s*,\s*/, $canon) {   
    $item =~ m%-(.*)% ? push @hash, "$1 DESC" : push @hash, $item;
  }
  scalar @hash ? join(" ", "ORDER BY ", join(", ", @hash)) : "";
}

### Not currently implemented
sub _fix_limit { ""; }

### _canon ( ITEM )
# Takes an item, returns a scalar of what's in it.  Not complicated, and
# occasionally useful, but there's probably a better way to do this that I
# don't know off the top of my head.
sub _canon {
  my $item = shift;
  if    ( ref($item) eq "ARRAY" )   { join(' ', @$item) }
  elsif ( ref($item) eq "HASH" )    { join(' ', %$item) }
  elsif ( ref($item) eq "" )        { $item }
  else                              { $item }
}


### _make_select ( TABLES, HASH )
# Makes the "WHERE blah=blah and blah2=blah2" part of the SELECT statement,
# based on TABLES (an array reference) and HASH.  Returns undef if nothing 
# is passed in, or "" if there's nothing to select.  Used with select_multi()
sub _make_select_multi {
  my ($self, $tables, $hash, $other) = @_;
  my $db = $self->db || return undef;
  return undef unless ($tables && ref $tables && $hash && ref $hash);

  my %tables; foreach (@{$tables}) { $tables{$_}++ }

  my @list;
  foreach my $key (sort keys %{$hash}) {
    my $value = $$hash{$key} || "";  next if ($value =~ /^\s*$/);
    my ($table, $row) = $key =~ /^([^\.]+)\.([^\.]+)$/;
    next unless ($table && $row && $tables{$table});
    my $type = $self->fieldhash->{$table}->{$row};
    next unless defined($type);         # Not in the database - bad data
    if (ref $value) {
      my @newlist;
      foreach my $val (@{$value}) {
        push @newlist, " $key $val " if $val;
      }
      push @list, "( " . join(" AND ", @newlist) . " )" if @newlist;
    } elsif ($type =~ /^\s*int/i) {
      my $option = "=" unless $key =~ /^\d+$/;
      $value =~ s/^%|%$//g;     # We don't want wildcard matches here
      push (@list, "$key $option $value") if defined($value);
    } else {
      $value =~ s%(^\s+|\s+$)%% if $other;  # Lose the leading/trailing
                                            # whitespace (usually)
      push (@list, "$key like " . $db->quote( $value ) ) if $value;
    }
  }

  scalar(@list) ? "WHERE " . join(' AND ', @list)
                : "";
}

### _database () 
# Returns the canonical database name that we're connected to, which is
# based on the class of $self and *not* $DBNAME.  Returns undef if $self
# is not offered.
sub _database {
  my $self = shift || return undef;
  $self =~ s/=.*$// if (ref $self);
  $self =~ s%.*::%%g;
  return $self;
}

### _replace ( HASH, LINES )
# Replaces '$$item$$' with $hash{item} for all of LINES, each of which is
# a string.  Also replaces code references as appropriate.  Returns the 
# updated LINES.
sub _replace {
  my ( $self, $hash, @lines ) = @_;
  return @lines unless ($hash && ref $hash);
  map { s/\$\$(\w+)\$\$/$$hash{$1} || ""/egx } @lines;
  map { if (ref $_ eq 'ARRAY') {
          my ( $code, @args ) = @{$_};
          $_ = join("", $code->( $self, $self->_replace ( $hash, @args )));
        } else { $_ } } @lines;
  map { $_ = join("", $_->( $self, $hash ) ) if ( ref $_ eq 'CODE' ) } @lines;

  wantarray ? @lines : join("\n", @lines);
}

### _db_or_die 
# Returns the database or sets an error message and returns undef; let us
# simplify a lot of other code
sub _db_or_die {
  my $self = shift;  
  $$self{'DB'} ? return $$self{'DB'} 
	       : $self->set_error("Not connected") && return undef;
}


### DESTROY 
# Auto-invoked when the object is removed from memory.  Disconnects from
#   the database, just to be nice and leave less errors.
sub DESTROY { shift->disconnect; }

1; 
__DATA__	# Here for SelfLoader

###############################################################################
##### Version History #########################################################
###############################################################################
# v0.9	 (sometime in late 2000)
### First version with a real amount of documentation.  It's been running
### our databases for the last few months, though, so I know it works well.

# v0.99  	Thu Mar 22 13:36:29 CST 2001
### Just about ready for a real release.  Documentation is good, the API (of 
### sorts) is ready to go, and our internal modules are ready for the slight 
### modifications necessary from the changes.  We still need to work out
### licensing issues, make TB::Test, and make a test suite, but this
### module is pretty much good to go.  Renamed it to DBI::Frame, while I
### was at it.

# v0.991 	Fri Mar 23 13:29:57 CST 2001
### Changed 'insert' to actually check for duplicate entries, and updated
### _make_select() so it would work properly.

# v0.992 	Thu Jun  7 09:00:58 CDT 2001
### Fixed htmlhash, texthash, etc so that they'd use their local information
### instead of the system-wide info.  Added 'DBNAME', to allow modules to
### use a canonical name for the database while using a different name for 
### the actual DB.

# v0.993 	Wed Jul 11 16:21:51 CDT 2001
### Fixed add_table to use DBNAME appropriately and correctly.

# v0.999 	Fri Jul 13 11:26:20 CDT 2001
### Finished DBI::Frame::CGI, and added references to it here.

# v1.0 	Tue Aug 21 16:04:19 CDT 2001
### Gave up on the licensing issue.  Added a dummy actions() function.

# v1.01 	Thu Sep  6 13:06:56 CDT 2001
### Slight change in tables(), returns a null string instead of 'undef'.
### Set better defaults for init().

# v1.02 	Thu Feb 21 11:16:09 CST 2002
### Changed to UIUC/NCSA Open Source License - essentially the BSD license.

# v1.03.02 	Fri Mar 22 13:35:49 CST 2002
### Took DBNAME out of _database(), so the name is actually canonical.
### Fixed add_table to match _database(). Took action() out of DBI::Frame to
### avoid a warning.

# v1.03.03 	Tue Apr  2 11:02:18 CST 2002
### Updated _replace() to work right, documented its full behaviour.
### Added the Helper Functions list of functions - select_fieldlist(), 
### select_fieldlist_id(), and select_list_id().  

# v1.03.04 	Fri Apr  5 14:49:28 CST 2002
### Added select_multi and _make_select_multi().

# v1.03.05 	Tue Jun 18 13:00:28 CDT 2002
### Split off set_html(), set_list(), etc.  

# v1.04		Wed Aug 14 16:37:59 CDT 2002
### Updated to match the current version.

# v1.05		Tue Oct  8 10:19:22 CDT 2002
### Added documentation about the 'options' hashref in html().
# v1.05.01	Thu Jan 16 13:34:21 CST 2003
### Updated license to indicate that we're now the TCBG instead of the TBG.
### Updated how select() does its work.  
### Added new fields to every table - REQUIRED, ADMIN, and ORDER.  All
###   of them are essentially optional.  Added set_table(), which will
###   replace add_table() for compatibility reasons, to use these fields.
###   There are also set_required(), set_admin(), set_order(), required(), 
###   admin(), and order() functions.
### Updated how select() works - if the old MATCH entry is a hash, then
###   we'll assume there's lots of data in there and use it.  This lets us 
###   do more sophisticated queries and, most importantly, use the ORDER
###   stuff.  
### Updated _make_select() as well to use the old MATCH entry.
### Using _gethash() to simplify the entire series of xxxxhash() functions.
### Still need to document all of this.
### Still need to update _make_select_multi().
### Still need to build in LIMIT things
# v1.05.02	Fri Jan 17 11:43:34 CST 2003
### Replacing the set_ functions with calls to _set(), created _set()
### Using SelfLoader to speed load times.
### More data abstraction, especially with _db_or_die().
### General code modifications
### Documented all of the major changes.
# v1.05.03 	Mon Jan 27 16:41:33 CST 2003
### Fixed how REQUIRED works.  I think.
# v1.05.04	Wed Feb  5 08:42:35 CST 2003
### delete() now removes everything after ORDER BY from the select
### statement
# v1.05.05	Mon Mar 24 12:58:41 CST 2003 
### Fixed update() and delete() to use _make_select() properly.  Updated
###   _make_select() to not return the ORDER BY bit if it's not necessary.
# v1.05.06	Thu Mar 27 14:18:10 CST 2003 
### Trying to work on this don't-order thing some more.  
# v1.05.07	Tue Oct 21 13:33:56 CDT 2003 
### Renamed to DBIx::Frame.  Getting ready for a release.
# v1.06		Wed May 26 09:24:06 CDT 2004 
### Lots of documentation updates.