# BingoX::Carbon
# -----------------
# $Revision: 2.30 $
# $Date: 2000/09/19 23:01:56 $
# ---------------------------------------------------------

=head1 NAME

BingoX::Carbon - An object oriented database abstraction superclass

=head1 SYNOPSIS

use BingoX::Carbon ( [ ':cache_all', ] [ ':no_dynmeth' ] );

  # $BR - Blessed Reference
  # $SV - Scalar Value
  # @AV - Array Value
  # $HR - Hash Ref
  # $AR - Array Ref
  # $SR - Stream Ref

  # $proto - BingoX::Carbon object OR sub-class
  # $object - BingoX::Carbon object

CONSTRUCTORS

  $BR = $proto->new( $dbh, \%data );
  $BR = $proto->get( $dbh, $ID );
  $BR = $object->duplicate;

STREAM CONSTRUCTOR METHODS

  $SR = $proto->stream_obj( $dbh, \%params, [\@fields,] [\@sort] );
  $SR = $proto->stream_hash( $dbh, \%params, [\@fields,] [\@sort] );
  $SR = $proto->stream_array( $dbh, \%params, [\@fields,] [\@sort] );

LIST CONSTRUCTOR METHODS

  $AR = $proto->list_obj( $dbh, \%params, [\@fields,] [\@sort] );
  $AR = $proto->list_hash( $dbh, \%params, [\@fields,] [\@sort] );
  $AR = $proto->list_array( $dbh, \%params, [\@fields,] [\@sort] );

RELATION METHODS

  $SV = $object->relate( $fobject | \@fobjects | (\@fids, $fclass, $fcolumn) );
  $SV = $object->unrelate( $fobject | \@fobjects | (\@fids, $fclass, $fcolumn) );
  $SV = $object->isrelated( $fobject );
  $AR = $object->list_related( $fclass [, \@fields] [, \@sort] );
  $SR = $object->stream_related( $fclass [, \@fields] [, \@sort] );
  $SV = $proto->unrelate_all( $fclass )

DATABASE MANIUPLATION METHODS

  $BR = $object->modify( \%new_data );
  $SV = $proto->modify( $dbh, \%params, \%new_data );
  $SV = $object->rm;
  $SV = $proto->rm( $dbh, \%params );

CLASS DATA ACCESSOR METHODS

  $SV = $proto->table( $dbh );
  $SV = $proto->identity( $dbh );
  $AR = $proto->primary_keys( $dbh );
  $HR = $proto->def_fields( $dbh );
  $AR = $proto->field_order( $dbh );
  $SV = $proto->identity( $dbh );
  $SV = $proto->sequence( $dbh );
  $SV = $proto->seqcol( $dbh );

DATABASE/SQL METHODS

  $SR = $proto->sql_select( $dbh );
  @AV = $proto->format_select( $dbh, \%params, \@fields, \@sort [,$alias] );
  @AV = $proto->format_conditions( $dbh, \%params [,$alias] );

=head1 REQUIRES

DBI, Carp, strict, Date::Parse, BingoX::Time

=head1 EXPORTS

Nothing

=head1 DESCRIPTION

BingoX::Carbon provides a database abstraction in which each row of data is represented
by an object blessed into a class representing the table.  Each Carbon Class represents
a table or view in the database.  The database and classes are described by variables
in said classes.  After Carbon classes have been set up to represent tables in a
database, creating, retrieving and modifying data is simply a matter of method calls
against Carbon objects and classes.  For a tutorial on setting up a Carbon project,
see L<carbontut> packaged with BingoX.

=head1 DATABASE SUPPORT

Currently, Carbon has been tested and is known to work with B<Sybase>, B<Oracle>, and
B<PostgreSQL>.  Carbon should with minimal change be able to support many other databases.

Due to Carbon's extensive use of transactions, it will not currently work with database engines that
do not support transactions - most notably MySQL.  

We tried to keep Carbon/BingoX as database agnostic as possible, but had to put some database specific
code to support such things as Sybase's Indentity columns, Oracles Sequences, the different date formats,
and Oracles use of all caps.

If you would like to help Carbon support MySQL or other database engines, feel free to send patches
or contact us for help.

=head1 CLASS VARIABLES

=head2 REQUIRED

Classes that inherit from BingoX::Carbon must have the following class variables:

=over 4

=item * $table

A scalar that contains the table name the class represents.

=item * @primary_keys

An array containing the primary key colulmn names.

=item * @field_order

An array containing all the table's column names in perferred order of use.  
Was formerly  used for order of display, but has since been replaced by the 
BingoX Display namespace modules.

=back

=head2 OPTIONAL

=over 4

=item * $identity

A scalar that contains the name of the column which is a Sybase IDENTITY column.  
There can be only one identity column per table.

=item * $seqcol

A scalar that contains the name of the column which should be populated by a sequence.

=item * $sequence

A scalar that contains the name of the sequence object in the database which new() 
will poll to determine what to populate $seqcol with.

=item * %relations

A hash containing relational data. The keys to the hash are class names of 
foreign objects. The values are class names that represents the referential class 
for any object blessed in the class of the key.

e.g. :

  %relations = ( ClassOne => 'ClassOne_ClassTwo' );

=item * %foreign_keys

A hash containing relational data present in referential classes.  The keys to the hash 
are class names representing the classes referred to.  The values are the names of the 
columns which contain the foreign key to the referred table.

e.g. :

 %foreign_keys = ( ClassOne => 'one', ClassTwo => 'two' );

=item * $title_field

The column which should be used to display the object in a list.

=item * %content_fields

This hash lets Carbon classes have virtual columns to hold large amounts of 
content data. The keys of this hash are virtual colum names whose values 
are Carbon classnames that handle those content columns.

e.g. :

 %content_fields = ( content	=> 'Class::Data::Content' );

=item * %date_fields

The keys of this hash are column names from the fieldorder array that have a 
database type of date.  Putting those columns in here make sure that you will 
get Unix time when asking for those columns.

e.g. :

 %date_fields = ( showdate	=> 1 );

=back

=head1 METHODS

=head2 CONSTRUCTORS AND STATIC METHODS

=over 4

=cut

package BingoX::Carbon;

use DBI;
use Carp qw(:DEFAULT cluck);
use strict;
use Date::Parse;
use BingoX::Time;
use vars qw($AUTOLOAD $debug);

BEGIN {
	$BingoX::Carbon::REVISION	= (qw$Revision: 2.30 $)[-1];
	$BingoX::Carbon::VERSION	= '1.91';

	$debug	= undef;

	if ($debug) {
		require Data::Dumper;
	}
}

=item C<import> (  )

Called from 'use BingoX::Carbon;'

Possible arguments are as follows:

=back

=over 4

=item * :cache_all

flag will put all data into the object at time of construction.  
The default action is to store only primary_keys in the object 
until data is needed, but this approach proved very inefficient 
in certain situations.

=item * :no_dynmeth

flag will stop the creation of methods in calling class for all 
the elements of the class' fieldorder.

=item * :full_dynmeth

flag will avoid using 'forwarder' methods and instead use full 
dynamic methods - each with it's own code resembling AUTOLOAD.  
By default, forwarder methods are used and all call 
_old_school_autoload

Any other element, not starting with the ':' character will be interpreted 
as a method name with which to create an access method in the calling class.

=back

=cut
sub import {
	my $self	= shift;
	my $myclass	= ref($self) || $self;
	my $class	= (caller)[0];
	my @args	= @_;
	warn "BingoX::Carbon: import: class=$class: @args myclass=$myclass" if ($debug);

	## Initialize special content and date field methods
	no strict 'refs';
	@{"${class}::ISA"}	= ( __PACKAGE__ ) unless ($class->isa( __PACKAGE__ ));
	BingoX::Carbon::_content_meth_init( $class );
	BingoX::Carbon::_date_meth_init( $class );

	my $no_dynmeth		= 0;
	my $full_dynmeth	= 0;
	## BingoX::Carbon methods are called as functions, passing $class (caller[0]).		##
	## This is needed because import is called before the $class @ISA is set.			##
	## Therefore, calling $class->method wouldn't work because $class doesn't inherit	##
	## from anything yet!																##
	my @fields	= ( );
	foreach (@args) {
		if (substr($_, 0, 1) eq ':') {
			if ($_ eq ':cache_all') {
				$BingoX::Carbon::cache_all{ $class }++;
			} elsif ($_ eq ':full_dynmeth') {
				$full_dynmeth	= 1;
			} elsif ($_ eq ':no_dynmeth') {
				$no_dynmeth		= 1;
				&BingoX::Carbon::_create_access_method( $class, 'AUTOLOAD' );
			}
		} else {
			warn "explicitly creating method $_ in class $class" if ($debug);
#			&BingoX::Carbon::_create_access_method( $class, $_ );
#			&BingoX::Carbon::_create_forwarder_method( $class, $_ );
			push(@fields, $_);

		}
	} # END foreach block

	push(@fields, @{ &BingoX::Carbon::fieldorder( $class ) || [] }) unless ($no_dynmeth);
	foreach my $name (@fields) {
		if ($full_dynmeth) {
			&BingoX::Carbon::_create_access_method( $class, $name );
		} else {
			&BingoX::Carbon::_create_forwarder_method( $class, $name );
		}
	}
} # END sub import


=over 4

=item C<new> ( [ $dbh, ] \%data )

Constructs a new object with the data in the hashref passed to it.  
You must supply a value for all primary key columns, unless the database 
provides a method for autogenerating this value.  If an ID isn't specified 
the ID will be the next number in the database sequence :

Sybase

Class data $identity contains name of column which is a Sybase IDENTITY.  
The IDENTITY field will be omitted from the insert statement so Sybase can autogenerate it. 
New will then select @@identity to retreive the result of triggering IDENTITY.  
Because it does this within a single statement, it will get the correct value.  

Oracle, Postgres

Class data $sequence contains name of Sequence object in database, and 
class data $seqcol contains name of column where BingoX::Carbon will insert the value 
returned by triggering $sequence.

=cut
sub new {
	my $self	= shift;
	my $class	= ref($self) || $self;
	my $dbh		= ref($self) ? $self->dbh : shift;
	ref($dbh) || return $self->error_handler("In ${class}::new() called without dbh object");
	my $data	= shift;
	ref($data) || return $self->error_handler("In ${class}::new() called without data hash");
	my ($sth, @insert_fields, @insert_values);		# used to hold data for INSERT
	$self		= { };								# initialize self

	## Get data out of data hash which should go in a content table. ##
	my %content;
	if (my $contentfields = $class->contentfields) {
		foreach (keys %$contentfields) {
			$content{$_} = delete $data->{$_};
		}
	}

	## Get data out of data hash which are date fields. ##
	if (my $datefields = $class->datefields) {
		foreach (keys %$datefields) {
			$data->{$_} = ''.$data->{$_} if ($data->{$_});
			warn "datefield $_ ==> " . $data->{$_} . "\n" if ($debug > 1);
		}
	}

	## Get data out of data hash which is for a related class. ##
	my %selected;
	if ($class->relations) {
		warn "In class->relations == \n" . Data::Dumper::Dumper( $data ) if ($debug > 1);
		foreach (keys %{ $class->relations }) {
			warn "relations $_ ==> [$_]\n" if ($debug > 1);
			$selected{$_} = { map{ $_ => 1 } @{ delete $data->{$_} } } if ($data->{$_});
		}
	}

	## prepare data to be inserted and build object ##
	foreach (keys %$data) {
		## make sure field exists in class deffields ##
		next if (/^_/);
		exists($class->deffields->{$_}) || return $class->error_handler("In ${class}::new : $_ doesn't exist in deffields [$class]\n");
		my $value	= $self->{$_} = $data->{$_};
		push(@insert_fields, (defined $value ? $_ : ( )));
		push(@insert_values, (defined $value ? $value : ( )));
	}

	local $dbh->{'AutoCommit'} = 0 if (%selected || %content);		# BEGIN TRANSACTION (if needed)
	eval {
		local $dbh->{'RaiseError'} = 1;
		## If ID not specified, get next ID from sequence ##
		foreach (@{ $class->primary_keys || [ ] }) {
			warn "Primary Key: $_... " if ($debug);
			next if ((defined $self->{$_}) || ($class->identity eq $_));
			my $sql;
			if (($class->seqcol eq $_) && defined(my $sequence = $class->sequence)) {
				## get the ID from the database sequence ##
				if ($dbh->{'Driver'}->{'Name'} eq 'Oracle') {
					$sql = 'SELECT ' . $sequence . '.nextval FROM DUAL';
				} elsif ($dbh->{'Driver'}->{'Name'} eq 'Pg') {
					$sql = "SELECT nextval('" . $sequence . "')";
				} else {
					die "don't know how to read sequences for database driver $dbh->{'Driver'}->{'Name'}\n";
				}
			} else {
				die "no data supplied for primary key $_\n";
			}
			$sth = $dbh->prepare( $sql )	|| croak "prepare\n$sql;\n" . $dbh->errstr . "\n\n";
			$sth->execute					|| croak "execute\n$sql;\n" . $sth->errstr . "\n\n";
			$self->{$_} = $sth->fetch->[0]	|| croak "fetch\n$sql;\n" . $sth->errstr . "\n\n";
			$sth->finish();
			push(@insert_fields, $_);
			push(@insert_values, $self->{$_});
		}

		## make INSERT statement ##
		my $INSERT = "INSERT INTO " . $class->table;
		$INSERT .= ' (' . join(',', @insert_fields). ')' if (@insert_fields); 
		$INSERT .= ' VALUES (' . join(',', ('?') x scalar(@insert_values)) . ')';
		$INSERT .= ' SELECT @@identity' if (($dbh->{'Driver'}->{'Name'} eq 'Sybase') && $class->identity && !defined($self->{$class->identity}));	# SYBASE IDENTITY support
		warn "$class->new:\t\t\t\"$INSERT\" [ @insert_values ]\n" if ($debug);

		## INSERT data or freak out! ##
		$sth = $dbh->prepare( $INSERT )	|| croak "prepare\n$INSERT;\n" . $dbh->errstr . "\n\n";
		$sth->execute( @insert_values )	|| croak "execute\n$INSERT\nwith VALUES: " . join(',', @insert_values) . "\n" . $sth->errstr . "\n\n";

		## GET SYBASE IDENTITY COLUMN VALUE ##
		if (($dbh->{'Driver'}->{'Name'} eq 'Sybase') && $class->identity && !defined($self->{$class->identity})) {
			$self->{ $class->identity } = $sth->fetch->[0];
			die "Sybase Identity failed\n" unless (defined($self->{$class->identity}));
		}
		$sth->finish;

		## bless object ##
		$self->{'_dbh'} = $dbh;
		bless $self, $class;

		## Start Relation Code ##
		if (%selected) {
			foreach my $relclass (keys %selected) {					# Itterates through classnames in $selected
				my %local_selected = %{ $selected{ $relclass } };	# puts cpkeys of $_ classname

				## Here we relate all newly related items (we also might			##
				## be related objects which are already related, but it won't mind)	##
				foreach my $cpk (keys %local_selected) {			# goes through all newly related cpkeys
					my $params = {
									map {
											shift @{ $relclass->primary_keys } => $_
									} $self->cpkey( $cpk )
								};
					$self->relate( $relclass->get( $dbh, $params ) ) || die "Could not relate object with $relclass";
				}
			}
		}

		## Save content data. ##
		foreach (keys %content) {
			$self->$_( $content{$_} ) || die "Could not add content field $_";
		}
	}; # END of eval

	## Caught exception, ROLLBACK TRANSACTION ##
	if ($@) {
		$class->errors( $@ );
		$dbh->rollback if (%selected || %content);
		return $class->error_handler("In ${class}::new - $@")
	}
	warn 'in new self ==> ' . Data::Dumper::Dumper( $self ) if ($debug);
	$dbh->commit if (%selected || %content);	## No errors ## COMMIT TRANSACTION ##

	return $self;
} # END sub new

=item C<get> ( [ $dbh, ] \%params )

Constructs an object from the database using the parameters passed.  
NOTE: Passing one scalar variable as an ID to get has been deprecated!  
get will assume the parameters { $self->primary_keys->[0] => shift() } 
if a scalar is passed in place of \%params. Future version of BingoX::Carbon 
will not support this!

For instructions on the format of \%params, see L<"item_format_conditions">.

=cut
sub get {
	my $self	= shift;
	my $class	= ref($self) || $self;
	my $dbh		= ref($self) ? $self->dbh : shift;
	my $params	= shift || return undef;
	unless (ref($params) eq 'HASH') {
		$params	= { $self->primary_keys->[0] => $params };
	}

	my $code = $class->stream_obj( $dbh, $params, @_ ) || return undef;
	my $obj = $code->();
	$code->(1);			# finish
	undef $code;
	return $obj;
} # END sub get


=item C<modify> ( \%new_data )

Object method:

Modify instance data with \%new_data and sync with database.
Returns $self if success, undef if failure.

=item C<modify> ( $dbh, \%params, \%new_data )

Static method:

Modify all rows satisfied by conditions in \%params with \%new_data
Returns true if success, undef if failure.

N.B. - You CAN NOT modify non-columnar information (i.e., relationships or extra-tabular "content" fields)
for multiple rows simultaneously.

For instructions on the format of \%params, see L<"item_format_conditions">.

=cut
sub modify {
	my $self	= shift;
	my $class	= ref($self) || $self;
	my $dbh		= ref($self) ? $self->dbh : shift;
	ref($dbh) || return $class->error_handler("In ${class}::modify() called without dbh object");
	my ($data, $params);

	return undef unless ref($dbh);
	#### Object method section
	if (ref $self) {
		$data	= shift || return undef;
		return undef unless (ref($data) eq 'HASH');
		## Use values of primary keys as conditional parameters (to effect this row only) ##
		$params = { map { $_ => $self->$_() } @{ $self->primary_keys } };

	## Static method section ##
	} else {
		$params = shift;
		$data   = shift;
		ref($data) || return $class->error_handler("In ${class}::modify() called without data hash");
		## Must have all three of these, and $data must contain something ##
		return undef unless (((ref($params) eq 'HASH') || (ref($params) eq 'ARRAY')) && (ref($data) eq 'HASH') && %$data);
	}

	## Start Content Fields Code ##
	my %content;
	if (my $contentfields = $class->contentfields) {
		foreach (keys %$contentfields) {
			$content{$_} = delete $data->{$_};
			warn "contentfield $_ ==> " . $content{$_} . "\n" if ($debug > 1);
		}
		(%content && !ref($self)) && return $class->error_handler("In ${class}::modify() - static (group) modify called specifying special content fields");
	}
	## End Content Fields Code ##

	## Start Date Fields Code ##
	if (my $datefields = $class->datefields) {
		foreach (keys %$datefields) {
			$data->{$_} = ''.$data->{$_} if ($data->{$_});
			warn "datefield $_ ==> " . $data->{$_} . "\n" if ($debug > 1);
		}
	}
	## End Date Fields Code ##

	## Start Relation Code ##
	my %selected;
	if (ref $class->relations) {
		foreach (keys %{ $class->relations }) {
			$selected{$_} = { map{ $_ => 1 } @{ delete $data->{$_} } } if ($data->{$_});
		}
		(%selected && !ref($self)) && return $class->error_handler("In ${class}::modify() - static (group) modify called specifying relationships");
	}
	## End Relation Code ##

	local $dbh->{'AutoCommit'} = 0 if (%selected || %content);		# BEGIN TRANSACTION (if needed)
	eval {
		local $dbh->{'RaiseError'} = 1;
		if (keys %$data) {
			my (@update_fields, @update_values);
			foreach (keys %{ $data }) {
				next if ({map { $_ => 1 } @{ $self->primary_keys || []}}->{$_});
				exists($class->deffields->{$_}) || croak "method $_ doesn't exist in \%${class}::deffields\n"; 

				my $value = $data->{$_};
				$self->{$_} = $value if (ref $self);

				if (index($value, '##') != -1) {
					while ($value =~ s/##(.+?)##/?/o) {
						push(@update_values, $1);
					}
					push(@update_fields, $_ . ' = ' . $value);
					$self->{$_} = '' if (ref $self);
				} else {
					push(@update_fields, $_ . ' = ' . (defined $value ? '?' : 'NULL'));
					push(@update_values, (defined $value ? $value : ( )));
				}
			}

			## make UPDATE statement ##
			my ($where, @wherevals)	= $class->format_conditions( $dbh, $params );
			my $UPDATE = "UPDATE " . $class->table . " SET " . join(',', @update_fields) . " $where";
			warn "$class->modify :\t\t\t\"$UPDATE\" [@update_values] [@wherevals]\n" if ($debug);

			## UPDATE data ##
			my $sth = $dbh->prepare( $UPDATE )			|| croak "$UPDATE;\n" . $dbh->errstr . "\n";
			$sth->execute( @update_values, @wherevals )	|| croak "execute\n$UPDATE;\n" . $sth->errstr . "\n";
			$sth->finish;
		}	

		######################### BEGIN Relations Code ########################
		###	This next block itterates through the class names in $selected	###
		###	hashref and does the following:									###
		###		1. Gets previously related objects of said class.			###
		###		2. Compares previously related objects to new list of		###
		###			related objects.										###
		###			-	In order to do this it gets the cpkey() of each		###
		###				previously related object and puts					###
		###				them all in a hash.									###
		###		3. Unrelates no longer related objects.						###
		###		4. Relates all newly related objects.						###
		#######################################################################
		if (%selected) {
			## Iterates through classnames in $selected ##
			foreach my $relclass (keys %selected) {
				## puts cpkeys of $_ classname ##
				my %local_selected	= %{ $selected{$relclass} };

				## get already related objects ##
				my $current_objs	= $self->list_related( $relclass );

				## creates a hash of cpkeys => objects. ##
				my %cpkeys			= map { $_->cpkey => $_ } @$current_objs;

				## remove keys from cpkeys that are also in local selected. ##
				%cpkeys = map { $_ => $cpkeys{$_} } grep {!$local_selected{$_}} keys %cpkeys;
				foreach my $cpk (keys %cpkeys) {			# go through previously related cpkeys
					$self->unrelate( $cpkeys{$cpk} );		# unrelate
				}

				## Here we relate all newly related items (we also might be related objects	##
				## which are already related, but it won't mind)							##
				foreach my $cpk (keys %local_selected) {	# goes through all newly related cpkeys
					my $params = {
									map {
											shift @{ $relclass->primary_keys } => $_
									} $self->cpkey( $cpk )
								};
					$self->relate( $relclass->get( $self->dbh, $params ) );	# relates
				}
			}
		}
		################################### END RELATIONS CODE ################################################

		## Save content data. ##
		foreach (keys %content) {
			warn "Saving content: $_ ==> $content{$_}" if ($debug > 1);
			$self->$_( $content{$_} );
		}
	}; # END of eval

	## Caught exception, ROLLBACK TRANSACTION ##
	if ($@) {
		$self->errors( $@ );
		$dbh->rollback if (%selected || %content);
		return $class->error_handler("In ${class}::modify() - $@");
	}
	$dbh->commit if (%selected || %content);

	return ref($self) ? $self : 1;
} # END sub modify

=item C<duplicate> ( [ $dbh, ] [ $object ] )

Returns a duplicate object, differing only by the primary key.

=cut
sub duplicate {
	my $self	= shift;
	my $class	= ref($self) || $self;
	my $dbh		= ref($self) ? $self->dbh : shift;

	$self		= ref($self) ? $self : $class->get( shift() );
	my $data	= { %$self };
	foreach (@{ $self->primary_keys }) {
		delete $data->{$_};
	}

	$class->new( $dbh, $data );
} # END sub duplicate

=item C<rm> ( )

Object method:

Deletes the object and all database records associated with it.

=item C<rm> ( $dbh, \%params )

Static method:

Deletes all database rows satisfied by the conditions in \%params.

For instructions on the format of \%params, see L<"item_format_conditions">.

=cut
sub rm {
	my $self	= shift;
	my $class	= ref($self) || $self;
	my $dbh		= ref($self) ? $self->dbh : shift;
	ref($dbh) || return $class->error_handler("In ${class}::rm() called without dbh object");
	my $params;

	local $dbh->{'AutoCommit'} = 0;					# BEGIN TRANSACTION
	eval {
		local $dbh->{'RaiseError'} = 1;

		## Object method section ##
		if (ref $self) {
			## Use values of primary keys as conditional parameters	##
			## (to effect this row only)							##
			$params = { map { $_ => $self->$_() } @{ $self->primary_keys } };

			## Start Content Fields Code ##
			my @contentfields = keys %{ $class->contentfields };
			map { $self->$_('') } @contentfields;	# this deletes the content fields
			## End Content Fields Code ##

			## Start Unrelate related objects Code ##
			if ($class->relations) {
				foreach (keys %{ $class->relations }) {
					$self->unrelate( $self->list_related( $_ ) );
				}
			}
			## End Unrelate related objects Code ##

		## Static method section ##
		} else {
			$params	= shift;
			return undef unless (ref($params) eq 'HASH' || ref($params) eq 'ARRAY');
		}

		my ($where, @wherevals)	= $class->format_conditions( $dbh, $params );
		die "invalid conditions\n" unless ($where);

		my $DELETE	= 'DELETE FROM ' . $class->table . ' ' . $where;
		warn "$class->rm :\t\t\t\"$DELETE\" [@wherevals]\n" if ($debug);

		## execute statement or error out ##
		my $sth	= $dbh->prepare( $DELETE )	|| croak "$DELETE;\n" . $dbh->errstr . "\n";
		$sth->execute( @wherevals )			|| croak "$DELETE;\n" . $sth->errstr . "\n";
		$sth->finish;
	}; # END of eval

	## Caught exception, ROLLBACK TRANSACTION ##
	if ($@) {
		$self->errors( $@ );
		$dbh->rollback;
		return $class->error_handler("In ${class}::rm() - $@");
	}
	$dbh->commit;

	## delete sucessful ##
	ref($self) && undef( %{ $self } );				# Scoop out creamy filling
	return 1;
} # END sub rm

=back

=cut

################################################################################
############################## Data List Methods: ##############################
################################################################################


=head2 DATA LIST CONSTRUCTOR METHODS

=over 4

=item C<list_obj> ( [ $dbh, ] \%params, \@fields, \@sort )

Returns an arrayref of objects meeting all specifications in \%params.

For instructions on the format of \%params, see L<"item_format_conditions">.

=cut
sub list_obj {
	my $self	= shift;
	my $class	= ref($self) || $self;
	my $dbh		= ref($self) ? $self->dbh : shift;
	ref($dbh)	|| return $self->error_handler('BingoX::Carbon::list_obj called without dbh object');
	my $params	= shift || { };
	my $fields	= shift;
	if (!$BingoX::Carbon::cache_all{ $class } && ref($fields) eq 'ARRAY') {
		## Make sure primary keys are included in $fields (map construct removes duplicates) ##
		$fields 	= [
						keys %{
								{
									map { $_ => 1 } (@$fields, @{ $class->primary_keys })
								}
							}
					];
	} else {
		## No fields passed, use the default ##
		$fields		= $BingoX::Carbon::cache_all{$class} ? $class->fieldorder : $class->primary_keys;
	}
	my $sort	= shift || $class->primary_keys;
	my ($SELECT, @bindings)	= $class->format_select( $dbh, $params, $fields, $sort );
	unless ($SELECT) {
		warn "no select statement" if ($debug);
		return undef;
	}
	warn "list_obj: $SELECT" if ($debug);
	my $code	= $class->sql_select( $dbh, $SELECT, \@bindings );
	return undef unless (ref $code);
	my (@data, $data);
	while ($data = $code->()) {
		$data->{'_dbh'} = $dbh;
		push @data, bless($data, $class);
	}
	return \@data;
} # END sub list_obj

=item C<list_hash> ( [ $dbh, ] \%params, \@fields, \@sort )

Returns an arrayref of hashrefs meeting all specifications in \%params

For instructions on the format of \%params, see L<"item_format_conditions">.

=cut
sub list_hash {
	my $self	= shift;
	my $class	= ref($self) || $self;
	my $dbh		= ref($self) ? $self->dbh : shift;
	ref($dbh)	|| return $self->error_handler('BingoX::Carbon::list_hash called without dbh object');
	my $params	= shift || { };
	my $fields	= shift || $class->fieldorder;
	my $sort	= shift || $class->primary_keys;
	my ($SELECT, @bindings)	= $class->format_select( $dbh, $params, $fields, $sort );
	unless ($SELECT) {
		warn "no select statement" if ($debug);
		return undef;
	}
	warn "list_hash: $SELECT" if ($debug);
	my $code	= $class->sql_select( $dbh, $SELECT, \@bindings );
	return undef unless (ref $code);
	my @data;
	while (my $data = $code->()) {
		push(@data, $data);
	}
	return \@data;
} # END sub list_hash

=item C<list_array> ( [ $dbh, ] \%params, \@fields, \@sort )

Returns an arrayref of arrayrefs meeting all specifications in \%params. Data is sorted 
in the order of $class->deffields.

For instructions on the format of \%params, see L<"item_format_conditions">.

=cut
sub list_array {
	my $self	= shift;
	my $class	= ref($self) || $self;
	my $dbh		= ref($self) ? $self->dbh : shift;
	ref($dbh)	|| return $self->error_handler('BingoX::Carbon::list_array called without dbh object');
	my $params	= shift || { };
	my $fields	= shift || $class->fieldorder;
	my $sort	= shift || $class->primary_keys;
	my ($SELECT, @bindings)	= $class->format_select( $dbh, $params, $fields, $sort );
	unless ($SELECT) {
		warn "no select statement" if ($debug);
		return undef;
	}
	warn "list_array: $SELECT" if ($debug);
	my $code	= $class->sql_select( $dbh, $SELECT, \@bindings );
	return undef unless (ref $code);
	my @data;
	while (my $data = $code->()) {
		my @row	= map { $data->{$_} } @{ $fields };
		push(@data, \@row);
	}
	return \@data;
} # END sub list_array

=back

=cut

################################################################################
############################# Data Stream Methods: #############################
################################################################################


=head2 DATA STREAM CONSTRUCTOR METHODS

=over 4

=item C<stream_obj> ( [ $dbh, ] \%params, \@fields, \@sort )

Returns an code reference which, when dereferenced, will continue to return objects 
meeting all specifications in \%params until all matching rows have been returned, then 
it will return undef.  Will optionally limit itself to the fields specified in \@fields, 
and optionally sorted in the order of \@sort.

For instructions on the format of \%params, see L<"item_format_conditions">.

=cut
sub stream_obj {
	my $self 	= shift;
	my $class 	= ref($self) || $self;
	my $dbh		= ref($self) ? $self->dbh : shift;
	ref($dbh) || return $self->error_handler('BingoX::Carbon::stream_obj called without dbh object');
	my $params	= shift || { };
	my $fields	= shift;
	if (!$BingoX::Carbon::cache_all{ $class } && ref($fields) eq 'ARRAY') {
		## Make sure primary keys are included in $fields (map construct removes duplicates) ##
		$fields 	= [
						keys %{
								{
									map { $_ => 1 } (@$fields, @{ $class->primary_keys })
								}
							}
					];
	} else {
		## No fields passed, use the default ##
		$fields		= $BingoX::Carbon::cache_all{ $class } ? $class->fieldorder : $class->primary_keys;
	}
	my $sort	= shift || $class->primary_keys;
	my ($SELECT, @bindings)	= $class->format_select( $dbh, $params, $fields, $sort );
	unless ($SELECT) {
		warn "no select statement" if ($debug);
		return undef;
	}
	my $code	= $class->sql_select( $dbh, $SELECT, \@bindings );
	return undef unless (ref $code);
	return bless(sub {
					my $data		= $code->(@_) || return undef;
					$data->{'_dbh'}	= $dbh;
					return bless( $data, $class );
				}, 'BingoX::Carbon::Stream');
} # END sub stream_obj

=item C<stream_hash> ( [ $dbh, ] \%params, \@fields, \@sort )

Returns an code reference which, when dereferenced, will continue to return a hashref 
meeting all specifications in \%params until all matching rows have been returned, then 
it will return undef.  Will optionally limit itself to the fields specified in \@fields, 
and optionally sorted in the order of \@sort.

For instructions on the format of \%params, see L<"item_format_conditions">.

=cut
sub stream_hash {
	my $self	= shift;
	my $class	= ref($self) || $self;
	my $dbh		= ref($self) ? $self->dbh : shift;
	ref($dbh)	|| return $self->error_handler('BingoX::Carbon::stream_hash called without dbh object');
	my $params	= shift || { };
	my $fields	= shift || $class->fieldorder;
	my $sort	= shift || $class->primary_keys;
	my ($SELECT, @bindings)	= $class->format_select( $dbh, $params, $fields, $sort );
	unless ($SELECT) {
		warn "no select statement" if ($debug);
		return undef;
	}
	my $code	= $class->sql_select( $dbh, $SELECT, \@bindings );
	return undef unless (ref $code);
	return bless(sub {
					my $data	= $code->(@_) || return undef;
					return $data;
				}, 'BingoX::Carbon::Stream');
} # END sub stream_hash

=item C<stream_array> ( [ $dbh, ] \%params, \@fields, \@sort )

Returns an code reference which, when dereferenced, will continue to return an arrayref 
meeting all specifications in \%params until all matching rows have been returned, then 
it will return undef. Will optionally limit itself to the fields specified in \@fields, 
and optionally sorted in the order of \@sort.

For instructions on the format of \%params, see L<"item_format_conditions">.

=cut
sub stream_array {
	my $self	= shift;
	my $class	= ref($self) || $self;
	my $dbh		= ref($self) ? $self->dbh : shift;
	ref($dbh)	|| return $self->error_handler('BingoX::Carbon::stream_array called without dbh object');
	my $params	= shift || { };
	my $fields	= shift || $class->fieldorder;
	my $sort	= shift || $class->primary_keys;
	my ($SELECT, @bindings)	= $class->format_select( $dbh, $params, $fields, $sort );
	unless ($SELECT) {
		warn "no select statement" if ($debug);
		return undef;
	}
	my $code	= $class->sql_select( $dbh, $SELECT, \@bindings );
	return undef unless (ref $code);
	return bless(sub {
					my $data	= $code->(@_) || return undef;
					my @row		= map { $data->{$_} } @{ $fields };
					return \@row;
				}, 'BingoX::Carbon::Stream');
} # END sub stream_array

=back

=cut

################################################################################
############################# Relational Methods: ##############################
################################################################################


=head2 RELATIONAL METHODS

=over 4

=item C<relate> ( $OBJ )

=item C<relate> ( \@OBJECTS )

=item C<relate> ( \@IDS, $ID_CLASS, $ID_COLUMN )

Relates object to $OBJ, all objects in \@OBJECTS, or objects represented by 
\@IDS from the $ID_CLASS class in the $ID_COLUMN column of the database. Returns 
the number of objects passed that have been related to the object.

=cut
sub relate {
	my $self		= shift;
	my $class		= ref($self) || return $self->error_handler('relate must be called as an object method');
	my $dbh			= $self->dbh;
	my $data		= shift;
	my (@OBJECTS, $fclass, $rclass);
	############################################################################
	##  code duped from get_relation_info so that grep can be used to single  ##
	##                 out relations that don't exist already                 ##
	############################################################################
	if (ref($data) eq 'ARRAY') {
		if ($#{ $data } >= 0) {
			if ($fclass = ref($data->[0])) {	# Array of objects
				@OBJECTS	= @{ $data };
			} else {							# Array of IDs
				$fclass		= shift;
				my $column	= shift;
				@OBJECTS	= @{ $fclass->list_obj( $dbh,
													{
														$column => [ 'IN', @$data ]
													}
												  )
								};
			}
		} else {
			carp "empty array reference passed to relate" if ($debug);
			return undef;
		}
	} elsif ($fclass = ref($data)) {			# Single object
		@OBJECTS	= ( $data );
	} else {
		carp "relate called with invalid parameters - check documentation" if ($debug);
		return undef;
	}
	############################################################################

	## OBJECTS to be related are in the ARRAY @OBJECTS ##
	my $related		= 0;
	my $toberelated	= $#OBJECTS;
	@OBJECTS		= grep { 1 ^ $self->isrelated( $_ ) } @OBJECTS;
	$related		= ($toberelated - $#OBJECTS);	# Add already related objects

	($rclass, $data)	= $self->get_relation_info( 'I', \@OBJECTS );
	return $related unless (ref($data) eq 'ARRAY');
	foreach (@{ $data }) {
		$rclass->new( $dbh, $_ ) || next;
		$related++;
	}
	return $related;
} # END sub relate


=item C<unrelate> ( $OBJ )

=item C<unrelate> ( \@OBJECTS )

=item C<unrelate> ( \@IDS, $ID_CLASS, $ID_COLUMN )

Unrelates object from $OBJ, all objects in \@OBJECTS, or objects represented by 
\@IDS from the $ID_CLASS class in the $ID_COLUMN column of the database. Returns 
the number of objects that no longer are related to the object. 

=cut
sub unrelate {
	my $self	= shift;
	my $class	= ref($self) || carp "unrelate must be called as an object method";
	my $dbh		= ref($self) ? $self->dbh : return undef;
	my $data	= shift;
	my (@OBJECTS, $fclass, $rclass);
	############################################################################
	##  code duped from get_relation_info so that grep can be used to single  ##
	##                 out relations that don't exist already                 ##
	############################################################################
	if (ref($data) eq 'ARRAY') {
		if ($#{ $data } >= 0) {
			if ($fclass = ref($data->[0])) {	# Array of objects
				@OBJECTS	= @{ $data };
			} else {							# Array of IDs
				$fclass	= shift;
				my $column	= shift;
				@OBJECTS	= @{ $fclass->list_obj( $dbh,
													{
														$column => [ 'IN', @$data ]
													}
												)
								};
			}
		} else {
			carp "empty array reference passed to unrelate" if ($debug);
			return undef;
		}
	} elsif ($fclass = ref($data)) {			# Single object
		@OBJECTS	= ( $data );
	} else {
		carp "unrelate called with invalid parameters - check documentation" if ($debug);
		return undef;
	}
	############################################################################

	## OBJECTS to be unrelated are in the ARRAY @OBJECTS ##
	my $removed			= scalar(@OBJECTS);
	@OBJECTS			= grep { $self->isrelated( $_ ) } @OBJECTS;

	($rclass, $data)	= $self->get_relation_info( 'S', \@OBJECTS );
	return $removed unless (ref($data) eq 'HASH');
	my $list			= $rclass->list_obj( $dbh, $data );
	return undef unless (ref $list);
	foreach my $OBJ (@$list) {
		$removed-- unless ($OBJ->rm);
	}
	return $removed;
} # END sub unrelate


=item C<unrelate_all> ( $fclass [ , $unary_rev ] )

Unrelates all related objects in class $fclass from current object.  
Optional $unary_rev does reverse operation for unary relationships 

i.e.:

 unrelates "parent" objects from current

=cut
sub unrelate_all {
	my $self		= shift;
	my $class		= ref($self) || return $self->error_handler("unrelate_all must be called as an object method");
	my $dbh			= $self->dbh;
	my $fclass		= shift;
	my $unary_rev	= shift;			# UNARY REVERSE FLAG (use second column)
	my $rclass		= $self->relations->{ $fclass } || return $self->error_handler("class $class is not related to class $fclass");
	my $params		= $self->_related_subquery_conditions( $fclass, $unary_rev );
	$rclass->rm( $dbh, $params );
} # END sub unrelate_all


=item C<isrelated> ( $OBJ )

Returns a true value if $OBJ is related to the object, false otherwise.

=cut
sub isrelated {
	my $self			= shift;
	my $class			= ref($self) || carp "isrelated must be called as an object method";
	my $dbh				= ref($self) ? $self->dbh : return undef;
	my $OBJECT			= shift || return undef;
	my ($rclass, $data)	= $self->get_relation_info( 'S', $OBJECT );
	return undef unless (ref($data) eq 'HASH');
	return ref($rclass->get( $dbh, $data )) ? 1 : 0;
} # END sub isrelated


=item C<list_related> ( $class [, \@fields] [, \@sort] [, $unary_rev_flag ] )

Returns an arrayref of objects of $class related to the object.

=cut
sub list_related {
	my $self		= shift;
	my $class		= ref($self) || return $self->error_handler('method list_related must be called as an object method');
	my $dbh			= ref($self) ? $self->dbh : return undef;
	my $fclass		= shift || return undef;
	my $fields		= shift || $fclass->primary_keys;
	my $sort		= shift || $fclass->primary_keys;
	my $unary_rev	= shift;			# UNARY REVERSE FLAG (use second column)
	my $code		= $self->stream_related( $fclass, $fields, $sort, $unary_rev );
	return undef unless (ref $code);
	my @array;
	while (my $data = $code->()) {
		push(@array, $data);
	}
	return \@array;
} # END sub list_related


=item C<stream_related> ( $class [, \@fields] [, \@sort] [, $unary_rev_flag ] )

Returns an code reference which, when dereferenced, will continue to return objects 
of $class related to the object until all matching rows have been returned, then 
it will return undef.

=back

=cut
sub stream_related {
	my $self		= shift;
	my $class		= ref($self) || return $self->error_handler('method list_related must be called as an object method');
	my $dbh			= ref($self) ? $self->dbh : return undef;
	my $fclass		= shift || return undef;
	my $fields		= shift || $fclass->primary_keys;
	my $sort		= shift || $fclass->primary_keys;
	my $unary_rev	= shift;			# UNARY REVERSE FLAG (use second column)
	my $params		= $self->_related_conditions( $fclass, $unary_rev );
	return $fclass->stream_obj( $dbh, $params, $fields, $sort );
} # END sub stream_related


=begin private_method

	_related_subquery_conditions ( $fclass [, $unary_rev ] )
		- $fclass is the "foreign" class (related class)
		- in scalar context, returns \%fparams (see unrelate_all())
		- in array context, returns (\%fparams, \@fcolumns, \@columns) (see _related_conditions())
			%fparams  : parameters of query (can be passed to format_conditions())
			@fcolumns : relevant columns in foreign class
			@columns  : relevant columns in this class

=end private_method

=cut
sub _related_subquery_conditions {
	my $self		= shift;
	my $class		= ref($self) || return $self->error_handler('method _related_subquery_conditions must be called as an object method');
	my $fclass		= shift || return undef;
	my $unary_rev	= shift;			# UNARY REVERSE FLAG (use second column)
	my $relations	= $class->relations;
	my $rclass		= $relations->{ $fclass } || return undef;
	my $rfkeys		= $rclass->foreign_keys;
	my @columns		= ( $class );		# Doesn't belong in the array, but it'll get shifted
	my @fcolumns	= ( $fclass );		# off at the beginning of the block below.
	my %fparams;

	if ($class eq $fclass) {			# UNARY RELATIONSHIP
		my $data 	= $rfkeys->{ $class };
		@columns = @fcolumns = ( );
		foreach my $key (keys %{ $data }) {
			next unless (ref($data->{ $key }) eq 'ARRAY');
			push @columns, $key;
			push @fcolumns, $data->{ $key };
		}
		%fparams = map {
							$fcolumns[$_]->[($unary_rev ? 1 : 0)] => $self->${\$columns[$_]}()
						} (0 .. $#columns);
	} else {							# BINARY RELATIONSHIP
		foreach my $arrayref (\@fcolumns, \@columns) {
			my $data = $rfkeys->{ shift(@$arrayref) };
			if (ref($data) eq 'HASH') {
				foreach my $key (keys %{ $data }) {
					if (ref($data->{ $key }) eq 'ARRAY') {
						next;			# Aieee, unary syntax in binary relationship
					} else {
						push(@$arrayref, $data->{ $key });
					}
				}
			} elsif (ref($data) eq 'ARRAY') {
				@$arrayref	= @{ $data };
			} elsif (!(ref $data)) {
				@$arrayref	= ( $data );
			} else {
				return undef;
			}
		}
		%fparams = map { $_ => $self->$_() } @columns;
	}
	return wantarray ? (\%fparams, \@fcolumns, \@columns) : \%fparams;
} # END sub _related_subquery_conditions


=begin private_method

	_related_conditions ( $fclass [, $unary_rev ] )
		- $fclass is the "foreign" class (related class)
		- generates conditions suitable for using with stream_obj()
		- used only by stream_related() and list_related()

=end private_method

=cut
sub _related_conditions {
	my $self		= shift;
	my $class		= ref($self) || return $self->error_handler('method _related_conditions must be called as an object method');
	my $dbh			= ref($self) ? $self->dbh : return undef;
	my $fclass		= shift || return undef;
	my $unary_rev	= shift;			# UNARY REVERSE FLAG (use second column)
	my $relations	= $class->relations;
	my $rclass		= $relations->{ $fclass } || return undef;
	my $rfkeys		= $rclass->foreign_keys;

	my($fparams, $fcolumns, $columns) = $self->_related_subquery_conditions( $fclass, $unary_rev );
	my %params;
	if ($class eq $fclass) {
		foreach my $i (0 .. $#{ $fcolumns }) {
			$params{ $columns->[$i] }	= [
											'IN',
											$rclass->format_select(
												$dbh,
												$fparams,
												[
													$fcolumns->[$i]->[($unary_rev ? 0 : 1)]
												],
												undef,
												'rel'
											)
										];
		}
	} else {
		foreach my $i (0 .. $#{ $fcolumns }) {
			$params{ $fcolumns->[$i] }	= [
											'IN',
											$rclass->format_select(
												$dbh,
												$fparams,
												[
													$fcolumns->[$i]
												],
												undef,
												'rel'
											)
										];
		}
	}
	return \%params;
} # END sub _related_conditions


=over 4

=item C<get_relation_info> ( ('I' | 'S'), $OBJ )

=item C<get_relation_info> ( ('I' | 'S'), \@OBJECTS )

=item C<get_relation_info> ( ('I' | 'S'), \@IDS, $ID_CLASS, $ID_COLUMN )

Returns as the first element the relational class on which the second data element 
is associated. If the first argument is an 'I' (INSERT), the second element is a 
hashref suitable to pass to new or modify. If the first argument is an 'S' (SELECT), 
returns a hashref suitable to pass to get, list_*, stream_*, etc. This method is 
primarily used by methods relate, unrelate, isrelated, and related.

=cut
sub get_relation_info {
	my $self		= shift;
	my $class		= ref($self) || return $self->error_handler('relate must be called as an object method');
	my $dbh			= $self->dbh;
	my $type		= shift || return undef;
	my $data		= shift;

	my ($OBJECTS, $fclass);
	if (ref($data) eq 'ARRAY') {
		if ($#{ $data } >= 0) {
			if ($fclass		= ref($data->[0])) {	# Array of objects
				$OBJECTS	= $data;
			} else {								# Array of IDs
				$fclass	= shift;
				my $column	= shift;
				$OBJECTS	= $fclass->list_obj( $dbh, { $column => [ 'IN', @$data ] } );
			}
		} else {
			return undef;
		}
	} elsif ($fclass = ref($data)) {				# Single object
		$OBJECTS = [ $data ];
	} else {
		return undef;
	}

	## OBJECTS to be related are in the ARRAYREF $OBJECTS ##
	my $relations	= $self->relations		|| return $self->error_handler("No relations found for the $class class");
	my $rclass		= $relations->{$fclass}	|| return undef;
	my $rfkeys		= $rclass->foreign_keys	|| return $self->error_handler("No foreign keys found for the $rclass class");
	my (%objects, %relational_columns);
	$relational_columns{'local'}	= $rfkeys->{ $class };
	$relational_columns{'foreign'}	= $rfkeys->{ $fclass };
	@objects{ 'local', 'foreign' }	= ( [ $self ], $OBJECTS );
	if ($type eq 'S') {
		my %params;
		foreach (qw(local foreign)) {
			my $data	= $relational_columns{$_};
			my (%column_info, $columns);
			if (ref($data) eq 'HASH') {			# Multiple columns represent the same primary key (to relate two of the same type of item)
				%column_info	= %{ $data };
				$columns		= [ keys %column_info ];
			} elsif (ref($data) eq 'ARRAY') {
				$columns		= $data;
			} elsif (!(ref $data)) {
				$columns		= [ $data ];
			} else {
				return $self->error_handler("Relation misconfiguration in $class or $fclass");
			}
			foreach my $column (@{ $columns }) {
				my $method	= $column;
				if (ref($column_info{ $column })) {
					my $i	= 0;
					do {
						last unless (defined($column = $column_info{ $method }->[$i++]));
					} while (exists $params{ $column });
					return undef if (exists $params{ $column });
				}
				next unless (ref $objects{$_}->[0]);
				if ($#{ $objects{ $_ } } == 0) {
					$params{ $column }	= $objects{$_}->[0]->$method();
				} else {
					$params{ $column }	= [
											'IN',
											map { $_->$method() } @{ $objects{$_} }
										];
				}
			}
		}
		warn "get_relation_info returning SELECT to " . (caller 1)[3] . " data: " . Data::Dumper::Dumper(\%params) if ($debug);
		return ($rclass, \%params);
	} elsif ($type eq 'I') {
		my $data	= $relational_columns{'local'};
		my (%gparams, %column_info, $columns);
		if (ref($data) eq 'HASH') {			# Multiple columns represent the same primary key (to relate two of the same type of item)
			%column_info	= %{ $data };
			$columns		= [ keys %column_info ];
		} elsif (ref($data) eq 'ARRAY') {
			$columns		= $data;
		} elsif (!(ref $data)) {
			$columns		= [ $data ];
		} else {
			return $self->error_handler("Relation misconfiguration in $class");
		}
		foreach my $column (@{ $columns }) {
			my $method			= $column;
			$column				= $column_info{ $column }->[0] if (ref($column_info{ $column }) eq 'ARRAY');
			$gparams{ $column }	= $self->$method();
		}

		my @params;
		$data = $relational_columns{'foreign'};
		foreach my $OBJECT (@{ $OBJECTS }) {
			my %params = ( %gparams );
			my (%column_info, $columns);
			if (ref($data) eq 'HASH') {			# Multiple columns represent the same primary key (to relate two of the same type of item)
				%column_info	= %{ $data };
				$columns		= [ keys %column_info ];
			} elsif (ref($data) eq 'ARRAY') {
				$columns		= $data;
			} elsif (!(ref $data)) {
				$columns		= [ $data ];
			} else {
				return $self->error_handler("Relation misconfiguration in $fclass");
			}
			foreach my $column (@{ $columns }) {
				my $method	= $column;
				$column	= $column_info{ $column }->[1] if (ref($column_info{ $column }) eq 'ARRAY');
				$params{ $column }	= $OBJECT->$method();
			}
			push(@params, \%params);
		}
		warn "get_relation_info returning INSERT to " . (caller 1)[3] . " data: " . Data::Dumper::Dumper(\@params) if ($debug);
		return ($rclass, \@params);
	} else {
		return undef;
	}
} # END sub get_relation_info

=back

=cut

################################################################################
######################## Class Variable Access Methods: ########################
################################################################################


=head2 CLASS DATA ACCESSOR METHODS

=over 4

=item C<table> ( [ $dbh ] )

Returns class defined table name

=cut
sub table {
	no strict 'refs';
	my $self	= shift;
	my $class	= ref($self) || $self;
	my $dbh		= ref($self) ? $self->dbh : shift;
	return ${"${class}::table"} || $self->error_handler("Package variable ${class}::table not defined");
} # END sub table


=item C<identity> ( [ $dbh ] )

Returns class defined identity column as a string.

=cut
sub identity {
	no strict 'refs';
	my $self	= shift;
	my $class	= ref($self) || $self;
	my $dbh		= ref($self) ? $self->dbh : shift;
	return ${"${class}::identity"} || $self->error_handler("Package variable ${class}::identity not defined");
} # END sub identity


=item C<sequence> ( [ $dbh ] )

Returns class defined sequence used by this table as a string.

=cut
sub sequence {
	no strict 'refs';
	my $self	= shift;
	my $class	= ref($self) || $self;
	my $dbh		= ref($self) ? $self->dbh : shift;
	return ${"${class}::sequence"} || $self->error_handler("Package variable ${class}::sequence not defined");
} # END sub sequence


=item C<seqcol> ( [ $dbh ] )

Returns class defined seqcol used by this table as a string.

=cut
sub seqcol {
	no strict 'refs';
	my $self	= shift;
	my $class	= ref($self) || $self;
	my $dbh		= ref($self) ? $self->dbh : shift;
	return ${"${class}::seqcol"} || $self->error_handler("Package variable ${class}::seqcol not defined");
} # END sub seqcol


=item C<def_fields> (  )

Returns class defined fields as a hash reference

=cut
sub deffields { $_[0]->def_fields }
sub def_fields {
	my $self	= shift;
	my $class	= ref($self) || $self;
	no strict 'refs';
	return \%{"${class}::deffields"} if (defined %{"${class}::deffields"});
	return \%{"${class}::def_fields"} if (defined %{"${class}::def_fields"});
	return { %{"${class}::def_fields"} = map { $_ => 1 } @{ $class->field_order || [ ] } };
} # END sub def_fields


=item C<field_order> (  )

Returns class defined field order as an anonymous array

=cut
sub fieldorder { $_[0]->field_order }
sub field_order {
	my $self	= shift;
	my $class	= ref($self) || $self;
	no strict 'refs';
	return [ @{"${class}::fieldorder"} ] if (@{"${class}::fieldorder"});
	return [ @{"${class}::field_order"} ] || $self->error_handler("Package variable ${class}::field_order not defined");
} # END sub field_order


=item C<relations> (  )

Returns class defined relations as a hash reference

=cut
sub relations {
	my $self	= shift;
	my $class	= ref($self) || $self;
	no strict 'refs';
	return { %{"${class}::relations"} } || $self->error_handler("Package variable ${class}::relations not defined");
} # END sub relations


=item C<foreign_keys> (  )

Returns class defined foreign_keys as a hash reference

=cut
sub foreign_keys {
	my $self	= shift;
	my $class	= ref($self) || $self;
	no strict 'refs';
	return { %{"${class}::foreign_keys"} } || $self->error_handler("Package variable ${class}::foreign_keys not defined");
} # END sub foreign_keys


=item C<cpkey> (  )

Returns a string representing a single composite primary key joined by $self->pkd.

B<OPTIMIZE>

=cut
sub cpkey {
	my $self	= shift;
	my $pkey	= shift;
	return undef unless (ref $self);
	return $self->{'_cpkey'} if ($self->{'_cpkey'});
	$self->{'_cpkey'} = join($self->pkd, map { $self->$_() } @{ $self->primary_keys } );
	return $self->{'_cpkey'};
} # END sub cpkey

=item C<cpkey_params> ($cpkey) 

Returns a params hash from the cpkey string passed.

=cut
sub cpkey_params {
	my $self = shift;
	my $cpkey = shift;
	my $primary_keys = $self->primary_keys;
	
	my $hash = {
				map {
						shift(@{ $primary_keys }) => $_
					} split($self->pkd, $cpkey)
			};
	return $hash;

}

=item C<title_field> (  )

Returns class defined title_field as a string.

=cut
sub title_field {
	no strict 'refs';
	my $self	= shift;
	my $class	= ref($self) || $self;
	return ${"${class}::title_field"} || $self->error_handler("Package variable ${class}::title_field not defined");
} # END sub title_field


=item C<title_size> (  )

Returns class defined title_size as a string.

=cut
sub title_size {
	no strict 'refs';
	my $self	= shift;
	my $class	= ref($self) || $self;
	return ${"${class}::title_size"} || $self->error_handler("Package variable ${class}::title_size not defined");
} # END sub title_size


=item C<content_fields> (  )

Returns class defined content fields order as an hashref

=cut
sub contentfields { $_[0]->content_fields }
sub content_fields {
	no strict 'refs';
	my $self	= shift;
	my $class	= ref($self) || $self;
	return { %{"${class}::contentfields"} } if (keys %{"${class}::contentfields"});
	return { %{"${class}::content_fields"} } || $self->error_handler("Package variable ${class}::content_fields not defined");
} # END sub content_fields


=item C<date_fields> (  )

Returns class defined date fields order as an hashref

=cut
sub datefields { $_[0]->date_fields }
sub date_fields {
	no strict 'refs';
	my $self	= shift;
	my $class	= ref($self) || $self;
	return { %{"${class}::datefields"} } if (keys %{"${class}::datefields"});
	return { %{"${class}::date_fields"} } || $self->error_handler("Package variable ${class}::date_fields not defined");
} # END sub date_fields


=item C<primary_keys> ( [ $dbh ] )

Returns class defined primary keys as an array ref.  
NOTE: The use of the class variable $primary_key has been deprecated!  
primary_keys will construct an array ref with $primary_key if it is used. 
Future verson of BingoX::Carbon will not support this!

=cut
sub primary_keys {
	my $self	= shift;
	my $class	= ref($self) || $self;
	my $dbh		= ref($self) ? $self->dbh : shift;
	no strict 'refs';
	my @pkeys	= @{"${class}::primary_keys"};
	unless (@pkeys) {
		@pkeys	= ( ${"${class}::primary_key"} );
		$self->error_handler("Package variable ${class}::primary_keys not defined") unless (@pkeys);
	}
	return \@pkeys;
} # END sub primary_keys

=item C<dbh> ( )

Returns class database handler object.  
Keeps a global which gets removed with a $r->register_cleanup.

=cut
sub dbh {
	my $self	= shift;
	my $class	= ref($self) || $self;
	return $self->{'_dbh'} if (ref($self) && ref($self->{'_dbh'}));
	if (ref(my $dbh = $self->cached_dbh)) {
		return $dbh;
	} else {
		$dbh			= $self->connectdb;
		$self->{'_dbh'}	= $dbh if (ref $self);
		$self->cached_dbh( $dbh );
		return $dbh;
	}
} # END sub dbh


=item C<cached_dbh> ( [ $dbh ] )

Returns the cached database handle if it has been set.  
Optionally sets the cached database handle to $dbh.

=cut
sub cached_dbh {
	my $self		= shift;
	my $class		= ref($self) || $self;
	my $dclass		= $self->dataclass( $class );
	no strict 'refs';
	if ($#_ >= 0) {
		my $new	= shift;
		if (ref $new) {
			warn "setting new dbh [${dclass}::dbh]" if ($debug > 2);
			${ "${dclass}::dbh" }	= $new;
			Apache->register_cleanup(sub { ${ "${dclass}::dbh" }	= undef; })
				if (exists $ENV{MOD_PERL});
		} else {
			warn "clearing cached dbh [${dclass}::dbh]" if ($debug > 2);
			${ "${dclass}::dbh" }	= undef;
		}
		warn "\tnew value: " . ${ "${dclass}::dbh" } if ($debug > 2);
	}
	return ${ "${dclass}::dbh" };
} # END sub cached_dbh


=item C<purge_dbh> (  )

Clears the database handle cache variable.

=cut
sub purge_dbh {
	my $self	= shift;
	my $class	= ref($self) || $self;
	my $dclass	= $self->dataclass( $class );
	$self->cached_dbh( undef );
	return 1;
} # END method purge_dbh


=item C<error_handler> (  )

Carps @_ and returns undef.

=cut
sub error_handler {
	Carp->cluck(@_) if ($debug > 2);
	carp @_ if ($debug);
	return undef;
} # END sub error_handler


=item C<errors> (  )

Returns $self->{'_errors'} if called as an object method.  
Returns $errstr of the called class otherwise.

=cut
sub errors {
	my $self	= shift;
	my $data	= shift;
	if (ref $self) {
		if ($data) {
			$self->{'_errors'} = $data;
			return $self->{'_errors'};
		} else {
			return delete $self->{'_errors'};
		}
	} else {
		no strict 'refs';
		if ($data) {
			${"${self}::errstr"} = $data;
			return ${"${self}::errstr"};
		} else {
			my $error = ${"${self}::errstr"};
			${"${self}::errstr"} = undef;
		}
	}
} # END sub errors


=item C<data_class> (  )

Returns the data class

=cut
sub dataclass { $_[0]->data_class }
sub data_class {
	my $self	= shift;
	my $class	= shift;
	my $lclass	= $class;
	no strict 'refs';
	my @isa		= @{ "${class}::ISA" };
	while ($isa[0] ne __PACKAGE__) {
		$lclass = shift(@isa);
		unshift( @isa, @{ "${lclass}::ISA" } );
		return undef unless (@isa);
	}
	return $lclass;
} # END sub dataclass


=item C<data_class_name> (  )

Returns the rightmost part of the data_class_name name (thats the text right of the ::)

=cut
sub data_class_name {
	my $self		= shift;
	return $self->{'_data_class_name'} if (ref $self);
	$self->db_class	=~ /^.*:(.*)/;
	$self->{'_data_class_name'} = $1 if (ref $self);
	return $1;
} # END sub data_class_name


=item C<connectdb> ( )

*** NEEDS ERROR HANDLER ****

Called as a static method, it just returns the DBH Object.

=cut
sub connectdb {
	my $self	= shift;
	my $class	= ref($self) || $self;
	no strict 'refs';
	my $dclass	= $self->dataclass( $class );
	my @connect	= @{ "${dclass}::connectarray" } || @DATABASE::connectarray;
	my $dbh = DBI->connect( @connect ) || return $self->error_handler("Could not connect to the database @connect " . DBI->errstr . "\n");
	$dbh->do("alter session set NLS_DATE_FORMAT = 'Mon DD YYYY HH12:MI:SSAM'") if ($dbh->{'Driver'}->{'Name'} eq 'Oracle');
	return $dbh;
} # END sub connectdb


=item C<pkd> ( )

Returns a constant for the primary key delimiter.

=cut
sub pkd { return '~' }


=item C<date_format> ( )

Returns a constant, the strftime template for what date strings are to be 
displayed as.

=cut
sub date_format { return '%d %b %Y %T' }


=item C<str2time> ( [ $string ] )

This is method is used to parse your default date format into a format 
that str2time understands, such as:

  Date: 961221               (yymmdd)
  Date: 12-21-96             (mm-dd-yy)    ( '-', '.' or '/' )
  Date: 12-June-96           (dd-month-yy) ( '-', '.' or '/' )
  Date: June 12 96 00:00PM   (month dd yy hh:mmPM)
  Date: June 12 96 00::00:00 (month dd yy hh:mm::ss)

If time is not passed then time defaults to 00:00:00.

=cut
sub str2time {
	my $self	= shift;
	my $string	= shift;

	Date::Parse::str2time( $string );
} # END sub str2time


=back

=cut

################################################################################
################################# SQL Methods: #################################
################################################################################


=head2 SQL GENERATION METHODS

=over 4

=item C<sql_select> ( [ $dbh, ] $SELECT [, \@bindings] )

Excutes the prepared select statement and returns an arrayref of objects. The @bindings 
array contains values of SQL placeholders if used. Returns a code reference that will 
return a hashref when dereferenced.

=cut
sub sql_select {
	my $self		= shift;
	my $class		= ref($self) || $self;
	my $dbh			= ref($self) ? $self->dbh : shift;
	ref($dbh) || return $self->error_handler('BingoX::Carbon::sql_select called without dbh object');
	my $SELECT		= shift || return $self->error_handler("In ${class}::sql_select(), called without SELECT statement");
	my $bindings	= shift;
	my @bindings	= ref($bindings) ? @$bindings : ( );
	warn "$class->sql_select:\t\t\"$SELECT\" [@bindings]\n" if ($debug);
	my $sth;
	$sth = $dbh->prepare( $SELECT )	|| return $self->error_handler("In ${class}::sql_select(), prepare\n$SELECT;\n" . $dbh->errstr . "\n\n");
	$sth->execute( @bindings )		|| return $self->error_handler("In ${class}::sql_select(), execute\n$SELECT;\n" . $sth->errstr . "\n\n");
	return ($dbh->{'Driver'}->{'Name'} eq 'Oracle')
		? (bless(sub {									# Oracle version (slower!) 
			if ($_[0]) {
				$sth->finish if (defined $sth);
				undef $sth;
				return undef;
			}
			return undef unless ($sth->{'Active'});
			my $resultdata	= $sth->fetchrow_hashref;
			unless (ref($resultdata) eq 'HASH') {
				$sth->finish;
				return undef;
			}
			my $data = {
						map {
								(((join ' ',@{ $class->fieldorder }) =~ /\b($_)\b/i)[0] || $_) => $resultdata->{$_}
							} keys %$resultdata
					};
			return $data;
		}, 'BingoX::Carbon::Stream'))
		: (bless(
				sub {									# Normal version
					if ($_[0]) {
						$sth->finish if (defined $sth);
						undef $sth;
						return undef;
					}
					return undef unless ($sth->{'Active'});
					my $data	= $sth->fetchrow_hashref;
					unless (ref($data) eq 'HASH') {
						$sth->finish;
						return undef;
					}
					return $data;
				}, 'BingoX::Carbon::Stream'
			));
} # END sub sql_select


=item C<format_select> ( [ $dbh, ] \%params, \@fields, \@sort [, $alias ] )

Returns formatted SQL 'SELECT' statement, selecting @fields that meet all specifications 
in %params, sorted by @sort.  Also returns bindings of all dynamic placeholders in SQL statement.
Optionally, $alias may specify the table alias to be used in the statment
(" WHERE alias.name = 'myname'"). Sub-values should be surrounded by ##, 
ie "name LIKE ##me##", for conditions involving: ( LIKE, NOT, <, >, SELECT )
Finally, and sort terms may be reversed (made descending) by prepending them with a '-'. (e.g.,
to sort by 'col1' ascending and 'col2' descending, pass 'qw(col1 -col2)'.)

For instructions on the format of \%params, see L<"item_format_conditions">.

=cut
sub format_select {
	my $self	= shift;
	my $class	= ref($self) || $self;
	my $dbh		= ref($self) ? $self->dbh : shift;
	my $params	= shift;
	my $fields	= shift || $class->primary_keys;
	my $sort	= shift;
	my $alias	= shift;
	## make sure we have params ##
	return undef unless ((ref $params eq 'HASH') || (ref $params eq 'ARRAY'));
	$fields		= $class->primary_keys unless ($#{ $fields } >= 0);
	$fields		= join(', ', grep { $_ } @{ $fields });
	my $table	= $class->table;
	$table		.= " $alias" if ($alias);
	my ($WHERE, @bindings);
	if ((defined $params) && (((ref($params) eq 'HASH') && %{ $params }) || (ref($params) eq 'ARRAY' && @{ $params }))) {
		($WHERE, @bindings)	= $class->format_conditions( $params, $alias );
		unless (defined $WHERE) {
			carp 'select conditions failed' if ($debug);
			return undef;
		}
	}

	# Don't complain to me about the lowercase SQL
	# -- for some reason the caps screw up on views in Oracle 8i (doesn't make 
	#    much sense to me)
	my @order	= (
					'select',
					$fields,
					'from',
					$table
				);

	push(@order, $WHERE) if ($WHERE);
	if (ref($sort) && (grep { $_ } @{ $sort })) {
		## ORDER ##
		push(@order, 'ORDER BY ' . join(', ', map { substr($_,0,1) eq '-' ? substr($_,1) . ' DESC' : $_ } @{ $sort }));
	}
	my $SELECT	= join(' ', @order);
	warn "$class->format_select:\t\t\"$SELECT\" [@bindings]\n" if ($debug);
	return($SELECT, @bindings);
} # END sub format_select


=item C<format_conditions> ( [ $dbh, ] \%params [, $alias ] )

Returns formatted sql 'WHERE' block, and an array of values to be bound (passed to 
DBI->execute().)  Optionally, $alias may specify the table alias to be used in the statment 
(" WHERE alias.name = 'myname'").  The keys of %params are the fields you are trying to match; 
the values of %params are specified as follows :

=back

=over 4

=item * equality condition

To test one equality, simply pass the value you wish to match as the value.

e.g. :

  { $field => 12 }
  { $field => 'twelve' }

=item * inequalities or multiple equalities (LIKE, NOT, <, >, IN, BETWEEN)

Sub-values should be surrounded by ##, ie "name LIKE ##me##", for conditions involving: 
( LIKE, NOT, <, > ).

To use IN or BETWEEN (with or without NOT), params should contain something similar 
to ( $field => [ $type, @LIST ] ) where $type is '[NOT ]IN' or '[NOT ]BETWEEN' and 
@LIST is the set of values for the statement.

=item * NULL/NOT NULL conditions

To test for a NULL condition or NOT NULL condition, pass 'IS NULL' or 'IS NOT NULL' 
(respectively) as the value.

e.g. :

  { $field => 'IS NOT NULL' }

=item * subqueries

When using a SELECT statement in an IN block, the argument immediately following the select 
statement should be the arrayref containing any bindings for that statement.  
This means that you may use the output of format_conditions as the input for a subquery : 

 $conditions = $obj_class1->format_conditions(
        $dbh,
        {
           $field => [
                        'IN',
                        $obj_class2->format_conditions( $dbh, $field => $value )
                     ]
        }
 );

=item * multiple values

To match multiple conditions, pass an arrayref (that does not begin with 'IN' or 'BETWEEN'!) 
containing a list of conditions (any of the conditions above.)  You MUST delimit each condition 
with either '&&' (for AND) or '||' (for OR), and you may also use '(' or ')' to separate logical 
conditions.

e.g. :

  { $field => [ 1, '||', '(', 2, '&&', 3, ')' ] }

=back

=cut
sub format_conditions {
	my $self	= shift;
	my $class	= ref($self) || $self;
	my $dbh		= ref($self) ? $self->dbh : shift;
	my $params	= ((ref $dbh eq 'HASH') || (ref $dbh eq 'ARRAY')) ? $dbh : (shift || { });
	my $alias	= shift;
	my $order;
	## Allow caller to specify order (and logical operation) of parameters ##
	if (ref $params eq 'ARRAY') {
		($order, $params) = @$params;
		if (@$order) {					# add parameters not specified in list
			my %tmpparams = %$params;
			map { delete $tmpparams{$_} } @$order;
			if (%tmpparams) {			# %tmpparams remaining are parameters not in $order list
				unshift @$order, '(';
				push @$order, (')', 'AND', split (' ', join(' AND ', keys %tmpparams)));
			}
		} else {						# order list empty!
			$order = [ split (' ', join(' AND ', keys %$params)) ];
		}
	} elsif (ref $params eq 'HASH') {
		$order = [ split (' ', join(' AND ', keys %$params)) ];
	} else {							# make sure we have params
		return undef;
	}

	## parse each field and add to SQL statement ##
	my ($WHERE, @query, @bindings);
	foreach my $field (@$order) {
		if (($field eq 'AND') || ($field eq 'OR') || ($field eq '(') || $field eq ')') {
			next if (($field =~ /^(AND|OR)$/o) && (!@query || ($query[$#query] =~ /^(AND|OR)$/o)));
			next if (($field =~ /^(\(|\))$/o) && ($query[$#query] =~ /^(\(|\))$/o));
			push @query, $field;
			next;
		}
		## make sure field is in params ##
		unless (defined $class->deffields->{$field}) {
			pop @query;
			next;
		}
		## enforce precedence ##
		my $sql = '(';					# ) loathe BBEdit

		my @valuelist = $params->{$field};
		next unless (defined $valuelist[0]);

		## add relation prefix if $r_flag ##
		$field = "${alias}.${field}" if $alias;
		for (my $x = 0; $x <= $#valuelist; $x++) {
			my $value = $valuelist[$x];
			if (ref($value) eq 'ARRAY') {				# IN, BETWEEN, or multiple comparisons
				my ( $type, @values )	= @{ $value };
				if (substr(lc($type), -2) eq 'in') {	# 'IN' or 'NOT IN'
					unless (@values) {
						carp "no bindings passed to format_conditions for type ($type)" if ($debug);
						return undef;
					}
					my (@IN_bindings, @IN_sql);
					while (my $value = shift(@values)) {
						if (lc(substr($value, 0, 6)) eq 'select') {
							push (@IN_sql, $value);
							push (@IN_bindings, splice(@values, 0, $#values + 1));	# $/
						} else {
							push (@IN_sql, '?');
							push (@IN_bindings, $value);
						}
					}
					$sql .= "$field " . uc($type) . ' (' . join(', ', @IN_sql) . ')';
					push(@bindings, @IN_bindings);
				} elsif (substr(lc($type), -7) eq 'between') {	# 'BETWEEN' or 'NOT BETWEEN'
					unless (@values) {
						carp "no bindings passed to format_conditions for type ($type)" if ($debug);
						return undef;
					}
					$sql .= "$field " . uc($type) . ' ? AND ?';
					push(@bindings, @values[0,1]);
				} else {										# LIST of conditions
					splice (@valuelist, $x+1, 0, @$value);		# appending will push to next iterations
				}
			} elsif ($value =~ /^\/(.+?)\/$/) {					# regex
				$sql .= "$field ~ ?";
				push(@bindings, $1);
			} elsif ($value =~ /^(\d+?)-(\d+?)$/) {				# date or numeric range
				$sql .= "($field > ? AND $field < ?)";
				push(@bindings, $1, $2);
			} elsif ($value eq '&&') {							# AND
				$sql .= ' AND ';
			} elsif ($value eq '||') {							# OR
				$sql .= ' OR ';
																# BEGIN	BBEdit loathing 
			} elsif ($value eq '(')								# Open paren	) loathe BBedit
			{ # loathe BBedit here, too!
				$sql .= '(';									# ) loathe BBedit
			} # loathe BBedit here, too!						# ( loathe BBedit
			  elsif ($value eq ')') {							# Close paren	( loathe BBedit
				$sql .= ')';									# END	BBEdit loathing 
			} elsif (lc($value) =~ /(^(like|not|is)|<|>)/) {	# Allow LIKE,NOT,<,>,<=,>= blindly
				if ($value =~ /##/) {
					while ($value =~ s/##(.+?)##/?/o) {
						push(@bindings, $1);
					}
				}
				$sql .= "$field $value";						# can use with embeded SELECT
		### Why do we need this code?  Uncomment if you change the else!
		#	} elsif ($value =~ /^-?(\d+?)\.?(\d*?)$/) {			# exact match number
		#		$sql .= "$field = ?";
		#		push(@bindings, $value);
		###
			} else {											# exact match lexical
				$sql .= "$field = ?";
				push(@bindings, $value);
			}
		} # END for (multiple values loop)
		## enforce precedence ( ##
		$sql .= ')';

		## add to array to be joined later ##
		push(@query, $sql) if ($sql ne '()');
	} # END foreach (fields loop)

	$WHERE	= 'WHERE ' . join(' ', @query) if (@query);
	warn "$class->format_conditions:\t\"$WHERE\" [@bindings]\n" if ($debug);
	return ($WHERE, @bindings);
} # END sub format_conditions


=head2 AUTOLOAD

=over 4

=item AUTOLOAD

AUTOLOAD method - returns requested field data from object. 
If that requested data has not been cached, it is retrieved from the 
database, cached, and returned.  If data is passed then field value is 
modified in the database and instance data, and value is returned.


=cut
sub AUTOLOAD {
	my $self	= shift;
	ref($self)	|| return $self->error_handler("In ${self}::AUTOLOAD($AUTOLOAD)\n$self is not an object\n\n");
	my $class	= ref($self);

	return if ($AUTOLOAD =~ /::DESTROY$/);
	my $name	= substr($AUTOLOAD, rindex($AUTOLOAD, ':') + 1);	# strip fully-qualified portion
	
	return undef unless ($name);
	if ($self->can( $name )) {					# Accessor method already exists!
		local($AUTOLOAD)	= $AUTOLOAD;		#	This means I was called as SUPER::$name
		$self->_old_school_autoload( @_ );		#	Act like an AUTOLOAD should!
	} else {									# No accessor method
		$class->_create_access_method( $name );	#	Make a fresh one
		$self->$name( @_ );						#	Now call it
	}
} # END sub AUTOLOAD


=begin private_method

	_create_access_method($name)
		- dynamically creates accessor method for method $name
		- called by AUTOLOAD() or import()

=end private_method

=cut
sub _create_access_method {
	my $self	= shift;
	my $class	= ref($self) || $self;
	my $name	= shift;
	my $return	= 0;
	return undef unless ($name);
	if ($name eq 'AUTOLOAD') {					# No method constuction, just 
		no strict 'refs';						# make the plain old AUTOLOAD
		if ($class->can('AUTOLOAD')) {
			$return	= $class->can('AUTOLOAD');
			undef *{"${class}::AUTOLOAD"};
		}
		*{"${class}::AUTOLOAD"}	= \&BingoX::Carbon::_old_school_autoload;

	} elsif ($class->can($name)) {				# Already there!
		warn "access method '${class}::$name' already exists" if ($debug);
	} else {									# Let's make a method today! (Excited yet?)
		warn "creating access method '${class}::$name'..." if ($debug);
		eval qq`
			no strict 'refs';
			*{"${class}::$name"}	= sub {
				my \$self	= shift;
				my \$class	= ref(\$self) || return undef;
				if (defined(my \$data = shift)) {
					\$self->modify({$name => \$data})
						|| return \$self->error_handler("In dynamic method $name()\n\tmodify({$name => \$data}) failed\n\n\t");
					\$self->{'$name'} = \$data;
				} elsif (!exists \$self->{'$name'}) {
					map { ('$name' eq \$_) && return \$self->error_handler("In dynamic method $name()\n\tBingoX::Carbon ABUSE!  Object in class $class has no value for primary key $name in instance data!\n\n\t") }
						\@{ \$self->primary_keys };
					my \%params	= map { \$_ => \$self->\$_() } (\@{ \$self->primary_keys });
					my \$aref	= \$self->list_array( \\\%params, ['$name'] );
					\$self->{'$name'} = \$aref->[0]->[0];
				}
				return \$self->{'$name'};
			};
		`;
	}
	return $return;
} # END sub _create_access_method


=begin private_method

	_create_forwarder_method($name)
		- dynamically creates accessor method for method $name
		- called by AUTOLOAD() or import()

=end private_method

=cut
sub _create_forwarder_method {
	my $self	= shift;
	my $class	= ref($self) || $self;
	my $name	= shift;
	my $return	= 0;
	return undef unless ($name);
	if ($name eq 'AUTOLOAD') {		# No method constuction, just
		no strict 'refs';			# make the plain old AUTOLOAD
		if ($class->can('AUTOLOAD')) {
			$return	= $class->can('AUTOLOAD');
			undef *{"${class}::AUTOLOAD"};
		}
		*{"${class}::AUTOLOAD"}	= \&BingoX::Carbon::_old_school_autoload;

	} elsif ($class->can($name)) {	# Already there!
		warn "forwarder method '${class}::$name' already exists" if ($debug);
	} else {						# Let's make a method today! (Excited yet?)
		warn "creating forwarder method '${class}::$name'..." if ($debug);
		eval qq`
			no strict 'refs';
			*{"${class}::$name"}	= sub {
				local(\$AUTOLOAD)	= '$name';
				my \$self	= shift;
				return \$self->_old_school_autoload( \@_ );
			};
		`;
	}
	return $return;
} # END sub _create_forwarder_method


=begin private_method

	_old_school_autoload
		- this is what AUTOLOAD() used to be (this is your father's AUTOLOAD)
		- loading BingoX::Carbon with the ':no_dynmeth' tag will assign 
			$class::AUTOLOAD to this method

=end private_method

=cut
sub _old_school_autoload {
	my $self	= shift;
	ref($self)	|| return $self->error_handler("In " . $self . "::AUTOLOAD()\n$self is not an object\n\n");
	my $class	= ref($self);

	return if ($AUTOLOAD =~ /::DESTROY$/o);
	my $name	= substr($AUTOLOAD, rindex($AUTOLOAD, ':') + 1);	# strip fully-qualified portion 

	## Check to see if valid field name ##
	exists $self->deffields->{ $name }
		|| return $self->error_handler("In AUTOLOAD()\n\tMethod $name not defined in class $class\n\n\t");

	if (defined(my $data = shift)) {			# Data passed -- call modify()
		$self->modify({ $name => $data })
			|| return $self->error_handler("In AUTOLOAD()\n\tmodify({$name => $data}) failed\n\n\t");
	} elsif (!exists $self->{ $name }) {		# No data passed or cached, retrieve from database
		## Check for nasty BingoX::Carbon abuse  ##
		map { ($name eq $_) && return $class->error_handler("In AUTOLOAD()\n\tBingoX::Carbon ABUSE!  Object in class $class has no value for primary key $name in instance data!\n\n\t") }
			@{ $self->primary_keys };
		my %params	= map { $_ => $self->$_() } (@{ $self->primary_keys });
		my $aref	= $self->list_array( \%params, [$name] );
		$self->{$name} = $aref->[0]->[0];
	}
	return $self->{$name};
} # END sub _old_school_autoload

=begin private_method

	_content> ( $content_class, $column, $content )

	Object Method:
		If $content (optional) is passed, the content will either be reomoved 
		or modified in the db. If no content is passed, then the content will 
		be selected from the db.

=end private_method

=cut
sub _content {
	my $self			= shift;
	return undef unless (ref $self);
	my $content_class	= shift; 
	my $content			= shift;
	my $params;
	if (ref($content) eq 'HASH') {
		$params = $content;
		$content = undef;
	} else {
		$params = shift || {};
	}
	my $content_column	= delete $params->{'_column'} || 'content';	# standard content column name
	my $pos_column		= delete $params->{'_pos'} || 'pos'; # standard position column name
	map { $params->{$_} = $self->$_() } @{ $self->primary_keys };
	if (defined $content) {
		my @split_content;
		## splits the content string into 255 char elements into array ##
		unless ($content eq '') {
			my $pos = 0;
			for ($pos = 0; $pos <= length($content); $pos += 255) {
				push(@split_content, substr($content, $pos, 255));
			}
		}
		my $dbh = $self->dbh();
		local $dbh->{'AutoCommit'} = 0;			# BEGIN TRANSACTION
		eval {
			local $dbh->{'RaiseError'} = 1;
			$content_class->rm( $self->dbh, $params ) || die "Could not remove existing content field value " . $dbh->errstr();

			unless ($content eq '') {
				for (0 .. $#split_content) {
					warn "ADDING CONTENT: $content_class => " . $split_content[$_] if ($debug > 2);
					$content_class->new(
											$self->dbh,
											{
												%$params,
												$pos_column		=> $_ + 1,
												$content_column	=> $split_content[$_]
											}
										) || die "Could not add content field value " . $dbh->errstr();
				}
			}
			$self->{ $content_class } = $content;
		};	# END of EVAL

		if ($@) {							# if failure
			$dbh->rollback();
			return $self->error_handler("Failed to add content - $@");		# give error
		}
		return 1;
	} else {
		return join('', map { $_->[0] }
							@{ $content_class->list_array(
									$self->dbh,
									$params,
									[ $content_column ],
									[ $pos_column ]
								) || [ ]
							}
					);
	}
	1;
} # END sub _content


=item C<int_to_bitmap> ( $int )

Returns a 32-bit bit-string which corresponds to the integer $int.

=cut
sub int_to_bitmap {
	unpack ('B32', pack('N', ($_[1] || $_[0])));
} # END sub int_to_bitmap


=item C<bitmap_to_int> ( $bitmap )

Returns an integer that corresponds to the (at most) 32-bit bit-string $bitmap.

=cut
sub bitmap_to_int {
	unpack ('N', pack('B32', substr("0" x 32 . ($_[1] || $_[0]), -32)));
} # END sub bitmap_to_int

=item C<get_list_hash> (  )

=item C<get_list_hash> ( [ $dbh ] [, \%params ] )

If used as a static method then you must pass $dbh.

Returns a hash ref of all the objects in the class it was called against.  
The hash is built from the C<cpkey>, and the C<title_field>, substr()'d to 
the C<title_size> or by default 80 chars.


B<OPTIMIZE>

=cut
sub get_list_hash {
	my $self 	= shift;
	my $class 	= ref($self) || $self;
	my $dbh		= ref($self) ? $self->dbh : shift;
	ref($dbh) || return $self->error_handler('BingoX::Carbon::stream_obj called without dbh object');
	my $params	= shift || { };


	my $title_size	= $class->title_size || 80;
	my $title_field	= $class->title_field;
	my $fields		= $class->primary_keys;
	my $sort		= [ ];
	unless ($class->content_fields->{ $title_field }) {
		push(@$fields, $title_field);
		$sort		= [ $title_field ];
	}

	my $stream		= $class->stream_obj(
								$dbh,
								$params,
								$fields,
								$sort
					);

	my $hash = { };
	while (my $obj = $stream->()) {
		$hash->{ $obj->cpkey }
					= length($obj->$title_field()) > $title_size
					? substr($obj->$title_field(), 0, ($title_size - 3)) . '...'
					: $obj->$title_field();
	}

	warn Data::Dumper::Dumper( $hash ) if ($debug > 2);
	return $hash;
} # END sub get_list_hash


=begin private_method

initializes content methods

=end private_method

=cut
sub _content_meth_init {
	my $class			= shift;
	my $contentfields	= shift || $class->contentfields;
	foreach my $field (keys %$contentfields) {
		next if $class->can($field);
		## CREATE DYNAMIC ACCESS METHOD ##
		no strict 'refs';
		*{"${class}::$field"} =
			sub {
					my $self = shift;
					return undef unless (ref $self);
					warn "CONTENT: $field => '" . $_[0] . "'" if ($debug);
					$self->_content( $contentfields->{ $field }, @_ );
				};
	}
} # END sub _content_meth_init


=begin private_method

initializes date methods.  Makes a lot of assumptions.  The main date 
format is in Sybase.  If not it assumes that the date format is in a 
string format as that of strftime.

=end private_method

=cut
sub _date_meth_init {
	my $class			= shift;
	if (my $datefields	= $class->datefields) {
		foreach my $field (keys %$datefields) {
			next if $class->can($field);
			## CREATE DYNAMIC ACCESS METHOD ##
			eval qq`
				package $class;
				\*{ $field } =
					sub {
							my \$self = shift;
							return undef unless ref(\$self);
							my \$data = shift;
							my \$date;
							if (ref \$data) {
								\$date = \$data;
							} else {
								\$date = BingoX::Time->new( \$data );
							}

							if (defined \$data) {
								\$self->modify({ $field => "".\$date });
							} else {
								my \$meth	= "SUPER::$field";
								my \$value	= \$self->\$meth();
								my \$time_local = \$self->str2time( \$value );
								\$date = (\$value ? BingoX::Time->new( \$time_local ) : undef);
							}

							return \$date;
						}; # END sub
			`;
		}
	}
} # END sub _date_meth_init


package BingoX::Carbon::Stream;

# Objects are constructed in the BingoX::Carbon::stream_obj method above.
sub next {
	my $self	= shift;
	return $self->();
} # END sub next

sub close {
	my $self	= shift;
	return $self->(1);
} # END sub close


1;


=back

=head1 REVISION HISTORY

 $Log: Carbon.pm,v $
 Revision 2.30  2000/09/19 23:01:56  dougw
 Version update

 Revision 2.29  2000/09/19 22:59:04  david
 content() - no longer converts linebreaks into HTML break tags (must have seemed useful at the time...)

 Revision 2.28  2000/09/19 20:14:11  dougw
 Changed cluck fix  arround to always cluck instead of carp if debug is >2.
 Changed the use Carp to use Carp (:DEFAULT cluck) since cluck isn't exported
 by default.

 Revision 2.27  2000/09/19 19:36:31  dougw
 Took out Carp->longmess and replaced with Carp->cluck.

 Revision 2.26  2000/09/13 18:16:00  david
 new(), modify()
 	- now only open a transaction if necessary (multiple statements required)

 RATIONALE - This will allow you to use a new() or modify() call when you have an active stream open, so long as the new() or modify() call does not require changes made to a relationship or to a content_field.

 Revision 2.25  2000/09/13 02:21:32  david
 Some minor POD changes
 Now only requires Data::Dumper if $debug is on.
 new(), modify(), rm(), _content()
 	- Made all database transaction code more conventional (in the perl/DBI sense.)
 modify()
 	- static method mode now works again (broken by Carbonium code in rev. 2.1)
 	- will now return an error if you attempt to use statically to change contentfields or relationships
 	- no longer truncates trailing spaces (if you want to do that, do it yourself!)

 Revision 2.24  2000/09/08 03:08:15  adam
  - added cpkey_params method
  - changed cpkey (removed wantarray stuf)

 Revision 2.23  2000/09/07 20:00:58  thai
  - updated POD documentation to show all REQUIRED classes

 Revision 2.22  2000/09/07 19:57:29  thai
  - added data_class_name()
  - changed DateTime::Date usage to BingoX::Time

 Revision 2.21  2000/09/06 23:18:02  greg
 removed old POD, and make new POD more coherent and descriptive.

 Revision 2.20  2000/09/02 00:15:17  thai
  - fixed POD documentation for date_format()

 Revision 2.19  2000/09/01 23:26:30  thai
  - added:
     date_format() - the date format you want returned from the date object
 	str2time() - used to parse date from the database

 Revision 2.18  2000/08/31 22:53:12  greg
 added COPYING and MANIFEST files

 Revision 2.17  2000/08/31 21:54:18  greg
 Added COPYRIGHT information.
 Added file COPYING (LGPL).
 Cleaned up POD.
 Moved into BingoX namespace.
 References to Bingo::XPP now point to Apache::XPP.

 "To the first approximation, syntactic sugar is trivial to implement.
  To the second approximation, the first approximation is totally bogus."
 	-Larry Wall

 Revision 2.16  2000/08/10 21:08:41  thai
  - changed get_list_hash() to work a lot better
  - changed cpkey() to use wantarray and $cpkey for when you want only the
    primary keys
  - changed occurrances where you split the $cpkey to use $self->cpkey( $cpkey )

 Revision 2.15  2000/08/09 21:24:34  thai
  - added title_size()

 Revision 2.14  2000/08/07 23:08:41  thai
  - will return content fields with <BR> for (\r\n)|[\n\r]

 Revision 2.13  2000/08/07 17:58:30  thai
  - fixed bug in _content() where it tried to deference an undefined
    array ref

 Revision 2.12  2000/08/03 20:45:15  thai
  - addd pkd() method to handle the pkds

 Revision 2.11  2000/07/14 19:12:25  dougw
 Should fix the datefields and contentfields error. They were returning an arrayref and the meth_inits tried
 to dereference it as a hash. DOH!

 Revision 2.10  2000/07/13 22:12:44  thai
  - changed methods so they are more consistent
      deffields() is now def_fields()
 	 fieldorder() is now field_order()
 	 contentfields() is now content_fields()
 	 datefields() is now date_fields()
 	 dataclass() is now data_class()
    of course the other methods still work, but please use the new ones

 Revision 2.9  2000/07/12 19:29:02  thai
  - fixed POD, cleaned up code

 Revision 2.8  2000/07/11 01:18:40  zack
 removed explicit reference to Datatime::Date::Sybase from _date_meth_init()

 Revision 2.7  2000/07/11 00:05:39  zack
 in cached_dbh(), only use Apache->register_cleanup() if mod_perl
 is running

 Revision 2.6  2000/07/10 22:39:16  zack
 - added the ability to provide a selection to get_list_hash()

 Revision 2.5  2000/07/07 01:34:54  dougw
  - Took out Caching for _content methods until we decide on a method to 
    cache them other than just class name.

 Revision 2.4  2000/06/24 03:17:56  dougw
  - Modified _content to handle param passing when updating and retrieving 
    a content field. Made sure content_meth_init and date_meth_init check 
    to see if a method exists before mucking with other namespaces

 Revision 2.3  2000/05/31 02:39:20  greg
 changed use of s/.*:// to substr(...) in AUTOLOAD for efficiency.

 Revision 2.2  2000/05/24 20:45:11  thai
  - tried to weed out as much of the DateTime::Date::Sybase code as
    possible.  Still uses DateTime::Date, and only DateTime::Date::Sybase
    in _date_meth_init()

 Revision 2.1  2000/05/19 01:24:42  thai
  - cleaned up code
  - is now part of the Bingo user space
  - added code from Carbonium

 Revision 2.0  2000/05/02 00:54:33  thai
  - committed as 2.0

 Revision 1.58  2000/03/17 19:01:36  colin
 - changed format_conditions() so that it allows "IS " statements to work 
   (was formerly only matching "IS NOT" statements)

 Revision 1.57  2000/03/09 02:01:07  dougw
 Allows nulled numerics and values.
 Changed the push lines in &new and &modify to allow above.

 Revision 1.56  2000/03/08 23:24:36  zack
 Facilitated NULL updates

 Revision 1.55  2000/02/10 20:05:11  greg
 memory saver - now creates forwarder methods instead of full dynamic methods

 Revision 1.54  2000/02/10 08:56:40  greg
 lots of new TODO and TO BE INVESTIGATED items to think about or implement...

 Revision 1.53  2000/02/10 07:24:24  greg
 now doesn't pass empty string column names in sql to DBI...

 Revision 1.52  1999/12/30 04:40:18  thai
  - bug in format_conditions where if the param field was
    not in deffields, then it would "next" leaving behind
    the remnants of the joined condition "AND" or "OR"
    I pop'd the @query array to eliminate that

 Revision 1.51  1999/12/29 01:44:53  david
 More documentation improvements and additions.
 Fixed format_conditions() so BBEdit balances tags correctly. (loathe BBedit :-)

 Revision 1.50  1999/12/28 22:38:10  david
 new() now makes identity/sequence decisions based on actual driver type of $dbh.
 Better documentation of new().

 Revision 1.49  1999/11/21 02:19:24  adam
  - format_conditions() - you can now use 'is not' as well as 'not'

 Revision 1.48  1999/11/10 23:27:59  greg
 Cleaned up documentation and code. Documentation and debugging information
 now more accurately reflects what is actually happening in Carbon.

 Revision 1.47  1999/10/28 05:52:25  david
 AUTOLOAD(), _create_access_method(), _old_school_autoload()
 	- revised accessor code for efficiency (made an 8% improvement!)
 	- added private POD and lots of other useful comments

 I've wanted to do this for awhile...just never got around to it until now.

 Revision 1.46  1999/10/22 21:11:25  thai
  - fixed some typos in the warns and POD.

 Revision 1.45  1999/10/08 21:51:53  derek
 Fixed an error with over-sanitization in format_contditions.

 Revision 1.44  1999/10/08 21:01:48  david
 Merged 'oracle' branch (excluding r1.36.2.5-r1.36.2.7, merged previously 
 into r1.41), adding Oracle support to Carbon, as well as some other 
 improvements (listed below in revision history.)

 Oracle support in sql_select() still needs refining.

 Revision 1.36.2.8  1999/10/01 09:19:38  david
 Removed silly ($primary_keys >= 2) condition from new().
 	(If you don't know what it is, you probably don't care.)

 format_conditions() - added means to specify order and logic of parameters
 	(NEEDS DOCUMENTATION)

 _create_access_method() - changed warning of $AUTOLOAD to $name

 Revision 1.36.2.4  1999/09/21 21:45:05  colin
 Dave changed part of sql_select back so it works now. Huzzah!

 Revision 1.36.2.3  1999/09/21 19:46:30  colin
 changed format_select(): the actuall select statement use lowercase SQL 
 commands because uppercase ones don't work on views :P

 Revision 1.36.2.2  1999/09/21 18:49:57  david
 sql_select() - Minor fix to Oracleizing code -- now works for columns not in fieldorder.

 Revision 1.36.2.1  1999/09/10 07:46:51  david
 INITIAL ORACLE SUPPORT
 	Added seqcol() and sequence() class variables and corresponding static methods
 		$seqcol   - name of column which sequence applies to (like $identity)
 		$sequence - name of sequence object in the database
 	new() - will use nextval of $sequence to populate $seqcol (if no data supplied for that column)
 	- removed $DATABASE::database kluge (Sybase seems to need it -- don't forget!)
 	sql_select() - creates different closure for Oracle which does case matching
 		(Oracle columns return uppercase and are case-insensitive, Carbon is case-sensitive.)
 Tested
 	new() - seems to work as expected with sequences or without
 	modify() - works correctly as object method, as well as through accessor methods
 	rm() - works as object method
 	accessor methods - work
 To do :
 	test modify() and rm() in static form
 	test relationships
 	document changes to new() in POD

 I imagine most everything should work, since the change was made at sql_select() 
 -- the main point of database read access.  All methods which write to the database 
    should work normally, since Oracle is case-insensitive.  Still, more testing 
    should be done.

 Furthermore, the algorithm I used to make sql_select() work is slow, and can probably 
 be greatly improved.  Still, it's a start, and should preserve our API functionality.

 Revision 1.43  1999/10/08 01:13:29  david
 rm() (static) - sanity prevents you from removing entire table if params is empty
 Restructured stream/list_related :
 	_related() broken into _related_conditions() and _related_subquery_conditions()
 	stream_related() now calls sql_select() using result of related_conditions()
 	list_related() now calls stream_related() (like list_obj() calls stream_obj()

 unrelate() - now uses list_obj() instead of stream_obj() to get objects to unrelate
 	(this may bite us later, but for now it makes unrelate() "transaction-friendly")

 unrelate_all() - new method will unrelate all objects of a named class from an object
 	(uses new _related_subquery_conditions() to form its parameters to call rm() with)

 	"Think it'll work?"
 	"It'll take a miracle..."

 Revision 1.42  1999/10/07 23:39:02  greg
 fixed sql BETWEEN syntax

 Revision 1.41  1999/09/29 20:52:03  david
 Merged in changes from r1.36.2.5 through r1.36.2.7 :
 Support for multiple conditions/field in SELECTs.

 Revision 1.36.2.7  1999/09/29 00:27:46  david
 Removed spurious warn left behind in last commit.

 "Do as I say, not as I do."

 Revision 1.36.2.6  1999/09/28 23:08:31  david
 format_conditions() - added support for multiple conditions/field

 Revision 1.36.2.5  1999/09/24 00:48:19  david
 Fixed bug in format_conditions() - it didn't let you have a condition value of 0.

 Revision 1.40  1999/09/28 00:39:25  greg
  - Added blesses, and class Carbon::Stream to support streams as objects - this isn't 
    heavily test yet.
  - Changed cmps (ref($stream) eq 'CODE') to (ref($stream)) to support new stream class.
  - Lots of other small bug fixes.

 Revision 1.39  1999/09/25 21:31:16  david
 table() - no longer prepends table names with the value of $DATABASE::database

 Revision 1.38  1999/09/25 20:14:39  david
 modify() - added [@wherevals] bind information to debugging output
 format_conditions() - bug fix : did not allow conditions with 0 values
 **************************************************************************
 sql_select() - REMOVED CALL TO DBI->TRACE.
 		PEPPLER FIXED DBD::Sybase "Bind Placeholder" BUG
 **************************************************************************
 Just be nice to people, and they do nice things for you. :-)

 Revision 1.37  1999/09/10 07:41:38  david
 Bug fix :
 	The first time you called an accessor method and AUTOLOAD() creates a dynamic 
 	method, if you called it with content (i.e., to modify the object attribute) 
 	that content would not be forwarded to the new accessor method by AUTOLOAD().  
 	This is now fixed.

 (See the diff? Real tiny fix. :-)

 Revision 1.36  1999/09/10 03:22:22  david
 Bug Fixes
 	new() - can now insert a NULL into a non-IDENTITY primary key column which has 
 	        a default (sort of kludgy -- basically it allows this if there are multiple 
 	        primary keys.
 		    the SELECT MAX() thing should probably go the way of the Dodoe.)
 	- changed default sort parameters (ORDER BY) to primary_keys() instead of fieldorder()
 		(Many people have complained about this.  let me know if you disagree with it.)
 Miscellanea
 	- Changed all calls for DBI::errstr to $dbh->errstr or $sth->errstr
 	modify() - changed @update_values to @update_fields, and @values to @update_values
 		(basically, this just uses the same naming as new(), for consistency.)
 debugging improvments
 	- AUTOLOAD now reports what it was called as
 	- new(), modify(), and rm() now display which class is calling them
 documentation
 	- updated KNOWN BUGS section, added TO DO LIST section

    "We don't code bugs here!"

 Revision 1.35  1999/07/14 23:43:22  david
 Changed relations() method to not return %foreign_keys ref
 Added foreign_keys() method to replace functionality of relations() method
 Changed calls to relations() which should be calls to foreign_keys()

 Revision 1.34  1999/07/13 23:10:20  greg
 Added method _old_school_autoload so calling $obj->SUPER::method() works with
 dynamic methods. _create_access_method sets *Carbon::AUTOLOAD to
 \&_old_school_autoload when called with 'AUTOLOAD' (so as not to duplicate
 code).

 Revision 1.33  1999/07/02 03:36:27  david
 Changed a bunch of 'carp()' calls to $self->error_handler

 get() - fixed weird bug where extra arguments were forwarded to closure, signaling 
         termination of embedded $sth

 format_relations/conditions()
     - no longer require $dbh be first parameter (though it will still work)
     - commented out useless code to determine i f value is numeric
         (this was a throwback to our pre-placeholder-binding days)

 Unary relation fixes :
 _related()
     - renamed from related()
     - fixed unary relations for *_related methods()
     - added $unary_rev_flag to reverse unary operations (needs POD!)
 relate/unrelate()
     - fixed unary relations (reversed operands of grep operation, binaries don't care!)

 Unary relationships now work as undocumented.  That is, they work the way we 
 discussed they would work.  But they still need to be documented! ;=}

 Revision 1.32  1999/07/01 18:59:03  greg
 Made changes to modify to add sanity, and efficiency.

 Revision 1.31  1999/07/01 02:22:11  david
 mget() - extra 'my $params = shift;' caused wildly unpredictable results...

 BAD, NASTY, EVIL DARTH GREG BUG!

 Revision 1.30  1999/06/30 00:53:22  greg
 fixed bugs that were found when integrating with Conf with this version of Carbon.
 added workaround for sybase losing track of the current database - needs to be fixed.

 Revision 1.29  1999/06/25 22:23:42  david
 - Some minor POD corrections
 new()
     - Started changing new() to support inserting into identity fields (not finished)
     - Added minor debugging
 sanity - changed most verifications of (ref $params) to (ref $params eq 'HASH')
 get() - cleans up coderef before exiting
 modify() - added static method usage
 rm() - added static method usage
 - unanchored /##(.+?)##/ regular expression in modify() and format_conditions() 
   (so they will actually work)
 list/stream_obj() - adds primary_keys to \@fields if excluded

 Revision 1.28  1999/06/23 22:42:00  greg
 -import: Removed silliness; now you can pass options to classes that inherit
   from Carbon
 -format_contitions: now bindings in 'IN' are passes as an array and not an
   array ref
 -related: took advantage of new syntax for format_conditions
 -get_relation_into: added sanity and warnings

 Revision 1.27  1999/06/22 23:19:59  greg
 - submit: added sanity
 - rm: now removes hash data before undefining reference to object
 - format_conditions: added better support for 'IN' and 'BETWEEN'
 Rewrote relation methods relate and unrelate. Added list_related,
 stream_related, and isrelated based on the get_relation_info and
 related methods

 Revision 1.26  1999/06/15 18:41:31  greg
 import: changed to recognize all options starting with ':' as options,
 	all others as methods. Added ':no_dynmeth' as import option to
 	specify methods should not be generated dynamically, but left to
 	AUTOLOAD
 Changed method AUTOLOAD, and added method _create_access_method to
 	generate dynamic methods

 Revision 1.25  1999/06/11 19:29:09  greg
 Fixed cache_all option that broke with the introduction of the list_* and
 stream_* methods.

 Revision 1.24  1999/06/10 23:03:45  greg
 Added space to SQL statements using WHERE blocks returned by format_conditions.

 Revision 1.23  1999/06/10 21:13:13  greg
 Changed $Carbon::VERSION variable to contain the CVS revision number
 import - changed to use a class variable to control cache_all functionality
 new - Added sanity
 get/mget - changed to wrapper methods around the list_obj method
 _format_conditions - changed to public method format_conditions
 list - changed to wrapper method around list_obj and list_hash methods
 deffields - changed to construct a hash from the class fieldorder
 sql_select - Returns a coderef to stream hash data (no longer blesses objects)
 format_select - new method to construct and return a complete SELECT statement

 Added methods stream_obj, stream_hash, stream_array, list_obj, list_hash, list_array
 Removed scrolling_list, chop_blanks, escape
 Cleaned up code. Removed lots of warn statements.
 Updated POD to reflect new and changed methods.

 --
 "There is no conspiracy. Nobody is in charge. It's a headless blunder
 operating under the illusion of a master plan."    --Worth (Cube)

 Revision 1.22  1999/06/09 23:26:41  thai
  - moved the revision logs to the bottom.

 Revision 1.21  1999/05/08 20:16:23  adam
  - sql_select - added sanity to ensure that all retrieved objects have 
    primary keys.  Otherwise it creates bad objects.  It only does this 
    if there's no $nobless flag.  Added comments around it.
  - There may be a better way of checking.  Probably before the select.
  - identity - podified identity method.
  - AUTOLOAD - commented autoload sanity ensuring that the primary key 
    isn't autoloaded.  Maybe theres a better way to do this, like checking 
    right when you enter autoload. The object should always have a primary key.
  - new - updated pod to account for identity field.

 Revision 1.20  1999/05/07 22:25:46  greg
  - import - Added ability to specify caching of all data at object construction
             at time of require. To cache all data: use Carbon qw(cache_all);
             This will redefine the mget function from where objects are gotten
             (also from get, although get is just a convenient wrapper around mget)

 Revision 1.19  1999/05/07 16:47:37  greg
  - Changed names of variables set by return values of _format_conditions 
    to make more sense.
  - Added a bit of sanity to what _format_conditions does when something 
    isn't quite right.

 Revision 1.18  1999/05/06 22:30:13  adam
  - new() - Now properly handles identities.  It now puts the insert and 
    select @@identity in the same prepare to ensure it is getting the 
    correct identity value.

 Revision 1.17  1999/05/06 06:30:55  adam
  - Handles identity columns.
  - Changed new to look for identity information in class and use it 
    if it can.
  - Added identity method which looks for $identity in the class.
  - Split up insert statement in new to work with inserts of just the 
    identity field.

 Revision 1.16  1999/05/05 06:32:59  adam
  - Added if debug.

 Revision 1.15  1999/05/05 05:56:38  adam
  - Added if ($debug);

 Revision 1.14  1999/05/03 17:11:45  fred
  - added a line to chop_blancs to unescape single quotes.

 Revision 1.13  1999/04/30 00:56:49  thai
  - added more verbage to AUTOLOAD to explain how it returns $obj->name if
    its not already cached.
  - made a change in _format_conditions; ($value =~ /LIKE|NOT|IN|<|>/) to
    ($value =~ /^(LIKE|NOT|IN|<|>)/)

 Revision 1.12  1999/04/29 20:39:22  thai
  - removed $dbh = shift, because it doesn't need it.

 Revision 1.11  1999/04/15 19:44:56  greg
  - Silly me ;) New should return $self, not $dbh <G>

 Revision 1.10  1999/04/15 19:34:13  greg
  - Changed the instance data method dbh uses from 'dbh' to '_dbh'. Changed method
  - new to add dbh to the instance data.

 Revision 1.9  1999/04/13 17:04:37  thai
  - removed $fields->[1] from list(), so that it now returns only an array
    ref of hashes or objs.
  - removed $name from AUTOLOAD at (@{ $self->primary_keys }), causing infinite
    loops.

 Revision 1.8  1999/04/10 20:17:09  adam
  - AUTOLOAD - changed if (defined... to if (exists...

 Revision 1.7  1999/04/10 00:34:10  colin
  - new - changed the select max bit so that if there are no records, it makes it 1.

 Revision 1.6  1999/04/09 22:55:02  greg
  - Tiny work around in case primary_keys doesn't return an array ref.

 Revision 1.5  1999/04/09 22:41:58  greg
  - Added more POD. Removed duplicate primary_keys method.

 Revision 1.4  1999/04/09 20:21:29  greg
  - Removed some debugging information, and turned off all debugging.

 Revision 1.3  1999/04/09 20:10:54  greg
  - Ton of new changes. Multiple primary keys, multiple database support, relations.
  - This was rushed a little, so there may be bugs...

 Revision 1.2  1999/03/12 23:56:40  thai
  - added DBI->trace to modify().

 Revision 1.38  1999/03/12 22:16:36  thai
  - added cvs headers.


=head1 SEE ALSO

perl(1).

=head1 KNOWN BUGS

new() currently does not report failure if inserting with Sybase IDENTITY columns 
fails, because of an anomoly in the way DBI handles multiple result sets.  You can 
tell if a new() has failed if the value of the IDENTITY column is < 1.

=head1 TODO

=over 4

=item * REWRITE RELATIONAL CODE!!!

=item * ability to redirect debugging to a file instead of STDERR

=item * write test suite testing ALL documented carbon features

=item * document unary many-many relationships

(works, presently undocumented)

=item * one-many relationships

=item * multirow inserts (multinew?)

=back

=head1 TO BE INVESTIGATED

=over 4

=item * carbon profiling

carbon could use it's own debugging information to profile projects, and
generate statistics based on that information. it could optionally store
the profiling data to a sepearte table for later perusing... fields to
store would be global incremented unique number with PID, action (select,
modify, etc), sql statement, timestamp.

=item * join class

dynamically create a class based on a join between carbon classes.
class data from all joined classes would need to be stored to be able to modify data.

=item * read only objects (useful in view objects)

=item * view classes

store class data in such a way that modifying through the view wouldn't break
(one table at a time, or store info on how to modify the actual carbon class for the 
view tables).

=item * virtual classes

get rid of empty classes! carbon has worked to well, and there are far 
to many empty classes lying around. either generate classes at compile 
time, or pretending that the classes exist at run time (using some sort 
of Carbon object ($carbon->class->method). Using a carbon object would 
need to fill in class @ISA arrays so that calls to the class
could be caught.

=item * Change class data to be more flexible - containing meta data

=back

=head1 COPYRIGHT

    Copyright (c) 2000, Cnation Inc. All Rights Reserved. This module is free
    software. It may be used, redistributed and/or modified under the terms
    of the GNU Lesser General Public License as published by the Free Software
    Foundation.

    You should have received a copy of the GNU Lesser General Public License
    along with this library; if not, write to the Free Software Foundation, Inc.,
    59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

=head1 AUTHORS

 David Pisoni <david@cnation.com>
 Greg Williams <greg@cnation.com>
 Thai Nguyen <thai@cnation.com>

=cut

__END__
