Basset::DB::Table - used to define database tables, ways to load that data into memory

Basset documentation Contained in the Basset distribution.

Index

Code Index:

NAME

Top

Basset::DB::Table - used to define database tables, ways to load that data into memory and build queries based upon the table information

AUTHOR

Top

Jim Thomason, jim@jimandkoka.com

SYNOPSIS

Top

For example,

 my $table = Basset::DB::Table->new(
	'name'				=> 'user',
	'primary_column'	=> 'id',
	'autogenerated'		=> 1,
	'definition'		=> {
		'id'		=> 'SQL_INTEGER',
		'username'	=> 'SQL_VARCHAR',
		'password'	=> 'SQL_VARCHAR',
		'name'		=> 'SQL_VARCHAR'
	}
 );

print $table->insert_query, "\n"; print $table->update_query, "\n"; print $table->delete_query, "\n";

DESCRIPTION

Top

Basset::DB::Table provides an abstract and consistent location for defining database tables, building queries based upon them, and so on. It is rarely (if ever) used directly in code, but is used extensively in packages which subclass from Basset::Object::Persistent.

Any queries returned by the query methods are simply strings that must be prepared by DBI in order bo be used.

ATTRIBUTES

Top

name

The name of the database table.

For example, if you're creating an object to reference the table "foo",

 $table->name('foo');
primary_column

Stores the primary column or columns for this table. Either passed a single scalar or an array ref.

  $table->primary_column('id'); 		 #id is the primary column
 $table2->primary_column(['id', 'name']) #id & name are the primary columns

It is recommended to access the primary columns of a table via the primary_cols method, since that method will always return an array.

  $table->primary_cols   #returns ('id')
 $table2->primary_cols   #returns ('id', 'name')

  $table->primary_column #returns 'id'
 $table2->primary_column #returns ['id', 'name']
autogenerated

boolean flag, 1/0

Sometimes, you may have your database auto-generate a column value for you. If you are using unique IDs for instance, it may be easier to have the database manage the auto-generation of new unique IDs for you. Set this flag if that's the case.

 #in your db
 create table foo (id int unsigned not null primary key auto_generated);

 #in your code
 $table->name('foo');
 $table->primary_column('id');
 $table->autogenerated(1);
definition

This is the actual definition of your table. It should be given a hashref, with the keys being your column names, and the values being the sql_type as defined in DBI for that column.

 $table->definition(
 	{
 		'name'	=> 'SQL_VARCHAR',
 		'id'	=> 'SQL_INTEGER'
 	}
 );

Note that the type should be a quoted string containing the value, not the actual constant defined in DBI. If there is no corresponding sql_type for your column (for a MySQL text column, for example), then pass undef.

 $table->definition(
 	{
 		'name' => 'SQL_INTEGER',
 		'bigcomment' => undef
 	}
 );

Alternatively, if you happen to know the SQL type in advance, you can just pass that along.

 $table->definition(
 	{
 		'name' => SQL_INTEGER,	#if DBI was used here
 		'bigcomment' => undef
 	}
 );

 $table->definition(
 	{
 		'name' => 4,	#if you just know it's 4
 		'bigcomment' => undef
 	}
 );

You should always use the quoted version unless you've received the numeric type from an authoritative source, such as having it returned from the database as the column type.

Alternatively, if you don't want to use a definition, you can explicitly tell the constructor your non primary columns

 $table = Basset::DB::Table->new(
 	'primary_column' => 'id',
 	'non_primary_columns' => [qw(name age serial_number)],
 );

That takes the place of using the definition. It does a discover call behind the scenes, but only looks for the columns that you've specified, not everything in the table.

references

Naturally, since you're using a relational database, you're going to have tables referencing other tables. You can store them in your Basset::DB::Table object inside the references parameter.

 $table->references(
 	{
 		'user_id'	=> 'user.id',
 		'food_type'	=> 'food.type',
 	}
 );

That says that the 'user_id' column in your table is a foreign key into the user table and references its id column. 'food_type' is a foreign key into the food table and references its type column.

Any foreign keys referencing primary columns can be used to auto-join the tables in a multiselect_query.

extra_select

Okay, as of v1.01 (heh, I finally incremented a version number!) Basset::DB::Table has gotten a power boost. It's now arbitrary out the ying-yang. Much more power in terms of what you can and cannot select, insert, update, etc.

The first of the new toys is extra_select.

Let's assume the following definition:

 $table->name('test');
 $table->definition(
 	{
 		'name' => 'SQL_INTEGER',
 		'bigcomment' => undef
 	}
 );

That means that if you called select_query on that table, you'd get back this:

 select test.bigcomment, test.name from test

Which is peachy and marvelous. You can now initialize your object with the values from 'name' and 'bigcomment'. But what if you want more information from the database? Perhaps a value from a function, or some calculation upon the columns? Up until now, you'd have to do that stuff externally in Perl. Either calculating things yourself, or calling arbitrary_sql to get the data you need out of there.

No more. extra_select does what it sounds like, it allows you to pass in extra information to select. Takes a hashref.

 $table->extra_select(
 	{
 		'current_time' => 'NOW()'
 	}
 );

Now, if you called select_query, you'd get back:

 select test.bigcomment, test.name, NOW() as current_time from test

And voila. Instant extra information.

Keep in mind, naturally, that if you want that extra column you're getting out to *go* anywhere, that your object must have a method by that name ("current_time" in this case). Otherwise, the data will be loaded and then silently forgotten.

If you're skipping ahead, you'll see that there are attributes called "db_write_translation", and "db_read_translation". Use whichever thing is appropriate for you.

extra_select only affects select queries.

db_read_translation

New addition to the various things, since I finally thought of a use for it. The db_read_translation alters your columns as they come back from the database. Takes a hash of the form column => translation

 $table->db_read_translation(
 	{
 		'name' => 'lower(name)'
 	}
 );

And that would change as follows:

 print $table->select_query; #prints select table.name as name from table

with the translation:

 print $table->select_query; #prints select lower(table.name) as name from table

Useful if you know at the database level that you'll need your data transformed in some fashion.

db_write_translation

This is the closest thing to an inverse method to extra_select. db_write_translation takes a hashref which decides how to re-write your insert, update, replace, or delete queries. Or all of them. An example is easiest.

Let's assume the following definition:

 $table->name('test');
 $table->definition(
 	{
 		'name' => 'SQL_INTEGER',
 		'bigcomment' => undef,
 		'current_time' => 'SQL_DATETIME',
 	}
 );
update test set current_time = ?, bigcomment = ?, name = ?

Then, if you called update_query, you'd get back:

 update test set current_time = ?, bigcomment = ?, name = ?

And your update_bindables are:

 current_time, bigcomment, name, name

However, that wouldn't be setting current_time to the proper current time: it's just relaying through the value in the object. So it's up to you, the programmer, to set it yourself.

 sub commit {
  my $self = shift;
  my ($sec,$min,$hour,$day,$mon,$year) = (localtime(time))[0..5];
  $mon++;
  $year+= 1900;
  $self->current_time("$year-$mon-$day $hour:$min:$sec");

  $self->SUPER::commit(@_);
 };

It works, it's effective, but it's a pain in the butt. More work for you. This is an instance where db_write_translation can come in handy.

 $table->db_write_translation(
 	{
 		'current_time' => {
 			'A' => {
 				'val' => 'NOW()',
 				'binds' => 0
 			}
 		}
 	}
 );

Now, your update_query is:

 update test set current_time = NOW(), bigcomment = ?, name = ?

And your update_bindables are:

 bigcomment, name, name

Voila. You no longer need to worry about setting current_time, the db does it for you.

The hashref that db_write_translation uses is of a specific format:

 method => {
  query_type => {
   'val' => new_value
   'binds' => 0/1
  }
 }

"method" is obviously the name of the method that's being re-written. "query_type" is the flag to indicate the type of query. "I" for insert, "U" for update, "D" for delete, "R" for replace, or "A" for all. "binds" is a boolean flag, 0 or 1. Set to 0 if you're inserting a new value that doesn't need a binded param, such as "NOW()". Set it to 1 if you're inserting a new value that does need a binded param, such as "LCASE(?)" to insert the value in lower case.

And voila. When the query is constructed, internally it first looks for a re-write of the method for the given query type. If it doesn't find one, it looks for a re-write of type "A" (all queries), if it doesn't find one of those, then it just leaves it alone and preps the query to insert the value in as is, unchanged.

One useful example that I will include, is to make a column read-only:

 $table->db_write_translation(
 	{
 		$column => {
 			'U' => {
 				'val' => $column,
 				'binds' => 0
 			}
 		}
 	}
 );

That way, when an object is committed on an update, $column's value will not change.

Also, please note that return values are not quoted. So you can't use a db_write_translation to set a value that the database wouldn't understand.

 'val' => 'some constant value'

will fail. Your query would become:

 update....set foo = some constant value...

which chokes, of course. Use a wrapper to alter the value you pass in at a higher level, or quote it yourself. The db_write_translation only alters your actual SQL statement.

column_aliases

You can define different aliases for columns as they come out of your table.

 $table->select_columns('id');

 print $table->select_query; 	#prints select id from foo

 $table->column_aliases(
 	{
 		'id' => 'user_id'
 	}
 );

 print $table->select_query		#prints select id as user_id from foo

Note that Basset::Object::Persistent assumes that if you're aliasing a column, that the aliased value is your method name. So in this case, any objects using that as a primary table would have a method name of 'user_id' that stores in the 'id' column in the table.

*_columns
 insert_columns
 update_columns
 delete_columns
 replace_columns
 select_columns

Normally, when you get back an insert_query, update_query, etc. from the various DB::Table methods here, all columns in the table are included. You can use these methods to restrict the queries to only be called on particular methods.

 print $table->insert_query; 	#prints insert into foo (this, that, those) values (?,?,?) for example
 $table->insert_columns('this');
 print $table->insert-query; 	#prints insert into foo (this) values (?) for example

These methods are not thread-safe.

You also have a set of negative non_*_columns that do an inverse.

 print $table->insert_query; 	#prints insert into foo (this, that, those) values (?,?,?) for example
 $table->non_insert_columns('this');
 print $table->insert-query; 	#prints insert into foo (that, those) values (?,?,?) for example

You may also use both at the same time

 print $table->insert_query; 	#prints insert into foo (this, that, those) values (?,?,?) for example
 $table->insert_columns('that', 'those');
 $table->non_insert_columns('that');
 print $table->insert-query; 	#prints insert into foo (those) values (?,?) for example
last_insert_query

All databases grab the last inserted ID in a different fashion. last_insert_query allows us to specify the query we use to grab the last inserted ID for a given insert. This should probably be specified in the conf file, but you can do it in the individual modules, if you prefer. Note that this is a trickling class accessor, so you can re-define it as many times as you want, or just use the default specified for Basset::Object::Persistent.

Certain databases don't need differeing queries. MySQL, for instance, is happy with just "SELECT LAST_INSERT_ID()" defined for the super class.

METHODS

Top

cols

Returns the columns defined for this table, in an unspecified order

 my @cols = $table->cols();
defs

Returns the column definitions defined for this table, in an unspecified order, but the same order as the columns returned by cols

 my @defs = $table->defs();
is_bindable

Fairly straightforward method, given a column and a query type, will tell you if the column is bindable.

 $table->is_bindable('U', 'foo'); #returns 1 or 0, whether or not 'foo' can be bound on an update.

Valid query types are 'U', 'I', 'R', 'D', 'S', and 'A'

is_selectable
alias_column

Returns the aliased version of the column if one is defined in the column_aliases hash. Returns the column otherwise.

 $table->column_aliases(
 	{
 		'id' => 'user_id'
 	}
 );

 print $table->alias_column('id');		#prints user_id (uses alias)
 print $table->alias_column('name');	#prints name (no alias)
column_for_alias

Returns the non-aliased version of the column if one is defined in the column_aliases hash. Returns the column otherwise.

 $table->column_aliases(
 	{
 		'id' => 'user_id'
 	}
 );

 print $table->alias_column('user_id');	#prints id (undoes alias)
 print $table->alias_column('name');	#prints name (no alias)
insert_bindables

Returns the columns in this table that should be bound with values upon an insert.

 my @insertables = $table->insert_bindables();
replace_bindables

Returns the columns in this table that should be bound with values upon a replace.

 my @replaceables = $table->replace_bindables();
update_bindables

Returns the columns in this table that should be bound with values upon an update.

 my @updatables = $table->update_bindables();
delete_bindables

Returns the columns in this table that should be bound with values upon an delete.

 my @deletables = $table->delete_bindables();
insert_query

Returns an insert query for this table.

 my $insert_query = $table->insert_query();

The query is a full insert with columns defined in the query. You may also pass in an array of columns to use in the insert. Otherwise, all columns defined in the table will be used.

 my $insert_qery = $table->insert_query('foo');

Returns the insert query but only to be able to insert into column 'foo'. If you try to use a column that is not in the table, you'll get an error.

replace_query

Returns an replace query for this table.

 my $replace_query = $table->replace_query();

The query is a full replace with columns defined in the query. You may also pass in an array of columns to use in the insert. Otherwise, all columns defined in the table will be used.

 my $replace_qery = $table->replace_query('foo');

Returns the replace query but only to be able to replace into column 'foo'. If you try to use a column that is not in the table, you'll get an error.

update_query

Returns an update_query query for this table.

 my $update_query = $table->update_query();

The query is a full update with columns defined in the query. You may also pass in an array of columns to use in the insert. Otherwise, all columns defined in the table will be used.

 my $update_query = $table->update_query('foo');

Returns the update query but only to be able to update column 'foo'. If you try to use a column that is not in the table, you'll get an error.

Be warned that no where clause is attached

delete_query

returns a delete query for this table.

 my $delete_query = $table->delete_query

Be warned that no where clause is attached

select_query

Returns an select_query query for this table.

 my $select_query = $table->select_query();

The query is a full update with columns defined in the query. You may also pass in an array of columns to use in the select. Otherwise, all columns defined in the table will be used.

 my $select_query = $table->select_query('foo');

Returns the select query but only to be able to select column 'foo'. If you try to use a column that is not in the table, you'll get an error.

Be warned that no where clause is attached

multiselect_query

Magic time. The multiselect_query allows you to auto-build and execute select queries across multiple tables. Expects up to two arguments, in a hash.

tables

The table objects that will be joined in this select statement. You need at least one table, but if you're only selecting one table, you should probably just use its select_query.

cols

The list of columns to select in the join. If this is not specified, then all columns in all tables will be used. NOTE THAT COLUMN ALIASES WILL NOT BE USED UNLESS YOU PASS THE use_aliases flag.

 $table->multiselect_query('tables' => $tables, 'use_aliases' => 1);

This is by design, it is assumed that most of the time, you're using a multi select query when doing an arbitrary_sql call to get back massive amounts of data and you need to know the original column name, and the table it was from.

Most of the time, hiding behind Basset's object persistence capabilities are more than sufficient. You can load up objects, manipulate them, write them back out. Everything's peachy. But some of the time, you just need data. Lots of data. And you need it fast. Real fast. Basset doesn't deal well with that.

Let's say you have a table of users and a table (that serves as a log) of login information. Each time the user logs in, you insert an entry into the login table. You want to get a list of all users and the number of times they've logged in.

You can do this with the standard methods.

 my $users = Some::User->load_all();

 foreach my $user (@$users) {
 	print $user->name, " logged in : ", $user->logininformation, "\n";	#assuming logininformation wrappers what we want
 }

But there's a lot of overhead involved in that and it's not necessarily the fastest way to do it. Sure, in this case, it makes sense. But it might not always. So, instead, you can do a multiselect_query. Let's define the tables for clarity, and we'll even assume they're in different packages.

 my $user_table = Basset::DB::Table->new(
 	'name' => 'user',
 	'primary_column' => 'id',
 	'definition' => {
 		'id'	=> 'SQL_INTEGER',
 		'name'	=> 'SQL_VARCHAR'
 	}
 );

 my $login_table = Basset::DB::Table->new(
 	'name' => 'login',
 	'primary_column' => 'id',
 	'definition' => {
 		'id' => 'SQL_INTEGER'
 		'user_id'	=> 'SQL_INTEGER',
 		'login_time'=> 'SQL_TIMESTAMP'
 	},
 	'references' => {
 		'user_id' => 'user.id'
 	}
 );

 my $q = Basset::DB::Table->multiselect_query(
 	'tables' => [$user_table, $login_table],
 );

 print "$q\n";

This prints out:

 select
 	user.name,
 	user.id,
 	login.login_time,
 	login.user_id,
 	login.id,
 from
 	user inner join login
 on user.id = login.user_id

So now we have one query that will get us back all of our data. But we're still yanking back too much. We actually only care about the user and the total login info. We can fix that by specifying the columns we want. Please note that you need to qualify the column names.

 my $q = Basset::DB::Table->multiselect_query(
 	'tables' => [$user_table, $login_table],
 	'cols'	=> [qw[user.id user.name count(*)]]
 ) or die Basset::DB::Table->errstring;

 print "$q\n";

This prints out:

 select
 	user.id,
 	user.name,
 	count(*)
 from
 	user inner join login
 on user.id = login.user_id

Closer, but still not quite there. For one thing, this will ignore any users that have never logged in, since they don't have an entry in the login table. Easy to fix, specify the join type:

 my $q = Basset::DB::Table->multiselect_query(
 	'tables' => [
 		$user_table,
 		['left', $login_table]
 	],
	'cols'	=> [qw[user.id name], 'coalesce(count(*), 0) as count'],
 ) or die Basset::DB::Table->errstring;

 print "$q\n";

This prints out:

 select
 	user.id as id,
 	user.name as name,
	coalesce(count(*), 0) as count
 from
 	user left join login
 on user.id = login.user_id

That's all of the data we want, but we're still missing something - the group by clause. So we attach one. We'll even tack on an order by clause for good measure so we don't need to sort later.

 my $q = Basset::DB::Table->attach_to_query(
 	Basset::DB::Table->multiselect_query(
		'tables' => [
			$user_table,
			['left', $login_table]
		],
		'cols'	=> [qw[user.id name], 'coalesce(count(*), 0) as count'],
	 ) ,
 	{
 		'group by' => 'user.id, name',
 		'order by' => 'count',
 	}
 );

 print "$q\n";

This prints out:

 select
 	user.id as id,
 	user.name as name,
 	coalesce(count(*), 0) as count
 from
 	user left join login
 on user.id = login.user_id
 group by
 	user.id, name
 order by
 	count

And voila! We're done. Hand that query off to whatever method it is you use to run sql queries (such as Basset::Object::Persistent's arbitrary_sql method), get back your data, and you're all set.

count_query

Returns a count query ("select count(*) from $table").

 my $count_query = $table->count_query();

Be warned that no where clause is attached.

optimize_query

Returns an optimize table query.

 my $optimize_query = $table->optimize_query();
describe_query

Returns an describe table query.

 my $describe_query = $table->describe_query();
reference_query

Given a column, returns a count query referencing the other table to determine whether the key is valid.

 $table->references(
 	{
 		'user_id' => 'user.id',
 		'user_name' => 'user.name'
 	}
 );

 print $table->reference_query('user_id');	#prints select count(1) from user where id = ?

 print $table->reference_query('login');	#prints nothing
is_column

When passed a column name, returns a 1 if it is a column in this table, a 0 if it is not.

 print $table->is_column('foo');
is_primary

When passed a column name, returns a 1 if it is a primary column in this table, a 0 if it is not

 print $table->is_primary('foo');
non_primary_cols

Returns a list of all of the non primary columns in the table.

 my @nons = $table->non_primary_cols();
primary_cols

Returns a list of all the primary columns in the table.

 my @primaries = $table->primary_cols();
foreign_cols

Given a table and an optional list of columns, returns all of the columns in the present table that reference the columns in the second table. If no columns are passed, then the second table's primary columns are assumed.

 $table->references(
 	{
 		'user_id' => 'user.id',
 		'user_name' => 'user.name'
 	}
 );

 $table->foreign_cols($user_table);	#prints user_id
 $table->foreign_cols($user_table, 'id', 'name'); #prints user_id, user_name
 $table->foreign_cols($user_table, 'last_name', 'login'); #prints nothing - we have no references to those columns
referenced_column

Given a column, returns the column it references in a foreign table or sets an error if references nothing.

 $table->references(
 	{
 		'user_id' => 'user.id',
 		'user_name' => 'user.name'
 	}
 );

 print $table->referenced_column('user_id');	#prints user.id
 print $table->referenced_column('password');	#prints nothing
discover_columns

Takes a table name as an argument. Returns a hashref of the columns in that table, suitable to be used in a definition call.

 my $definition = Basset::DB::Table->discover_columns('user_table');

This should be typically be invoked via the discover flag to the constructor.

 my $table = Basset::DB::Table->new(
 	'discover' => 1
 );
attach_to_query

Given a query string and a hashref of clauses, attaches the clauses to the query.

 my $update_query = $table->attach_to_query(
 	$table->update_query,
 	{
 		'where' => 'id = ?'
 	}
 );

 Valid clauses are "where", "group by", "having", "order by" and "limit", reflecting the
 SQL clauses of the same kind.
join_tables

Magic time.

join_tables is used internally by the multiselect_query, but you can use it yourself if you want.

Takes an array of table objects or arrayrefs. arrayrefs must be of the following form:

join type

The type of join to be performed. Should be a string. "inner", "outer", "left outer", that sort of thing. Defaults to inner. This parameter is optional.

table object

The table object you're using.

columns

SQL clauses to override the auto-join. This parameter is optional.

So, for example, if you have a usertable and a movietable, and movie.user references user.id, you could do:

 Basset::DB::Table->join_tables(
 	$usertable,
 	$movietable,
 ) || die Basset::DB::Table->errstring;

which returns:

 user
	inner join
		movie
			on user.id = movie.user

Say that user.movie was a foreign key to movie.id. Then you'd get back:

 user
	inner join
		movie
			on user.id = movie.user
			and user.movie = movie.id

I can't say why you'd want to have two tables referencing each other, but it's important to know that it happens.

3 tables is the same thing. Say that movie.genre references genre.id

 Basset::DB::Table->join_tables(
 	$usertable,
 	$movietable,
 	$genretable,
 ) || die Basset::DB::Table->errstring;

 user
	inner join
		movie
			on movie.user = user.id
	inner join
		genre
			on movie.user = genre.id

Okay, say that you want to use a left join between the user table and the movie table.

 Basset::DB::Table->join_tables(
 	$usertable,
 	['left', $movietable],
 	$genretable,
 ) || die Basset::DB::Table->errstring;

 user
	left join
		movie
			on movie.user = user.id
	inner join
		genre
			on movie.user = genre.id

You can also join with earlier tables. Say that snack.user references user.id

 Basset::DB::Table->join_tables(
 	$usertable,
 	['left', $movietable],
 	$genretable,
 	$snacktable,
 ) || die Basset::DB::Table->errstring;

 user
	left join
		movie
			on movie.user = user.id
	inner join
		genre
			on movie.user = genre.id
	inner join
		snack
			on user.id = snack.user

Or, you can override the defaults specified in the table's references. For example, if the references don't exist for the table.

 Basset::DB::Table->join_tables(
 	$usertable,
 	['left', $movietable],
 	$genretable,
 	[$snacktable, 'user.id = snack.user AND user.status = snack.status'],
 ) || die Basset::DB::Table->errstring;

 user
	left join
		movie
			on movie.user = user.id
	inner join
		genre
			on movie.user = genre.id
	inner join
		snack
			on user.id = snack.user
			and user.status = snack.status
many_clause

Convenience method. Given a column and a list of values, returns a foo in (???) clause for use in queries.

 print $table->many_clause('id', qw(1 2 3 4));	#prints "id in (?, ?, ?, ?)"

You may optionally pass your values in an arrayref, if it's more convenient.

 print $table->many_clause('id', [qw(1 2 3 4)]);	#prints "id in (?, ?, ?, ?)"

Finally, if you pass your values in an arrayref, you may specify the 'not' parameter to build a 'not in' clause

 print $table->many_clause('id', 'not', qw(1 2 3 4));	#prints "id not in (?, ?, ?, ?)"
qualified_name

Given a column name, returns the column name with the table name prepended.

 print $user->qualified_name('id');	#prints user.id
nonqualified_name

Given a column name, returns the column name without the table name prepended.

 print $user->qualified_name('id');	#prints id
 print $user->qualified_name('user.id');	#prints id
construct_where_clause

The where clause constructor is a class method that takes an arrayref of tables as its first argument, and then an arbitrary set of clauses in a list.

 my ($clause, @bindvalues) = Basset::DB::Table->construct_where_clause($tables, @clauses);

This is used to hide SQL from your application layer. You can specify arbitrarily complex statements here to build where clauses. The tables array is used to qualify the names of the columns passed. The array will be walked and the first table encounted that has the given column will be used to qualify the name. Hence, if a column exists in multiple tables, you should qualify it to ensure that you get it from the place you expect.

Easily pass in key value pairs.

 my ($stmt, @values) = Basset::DB::Table->construct_where_clause(
 	$tables,
 	'id' => 7
 );  #returns ('tablename.id = ?', 7)

To specify an 'in' clause, pass in an array.

 my ($stmt, @values) = Basset::DB::Table->construct_where_clause(
 	$tables,
 	'id' => [7, 8, 9]
 );  #returns ('tablename.id in (?, ?, ?)', 7, 8, 9)

Additional values are joined by AND statements.

 my ($stmt, @values) = Basset::DB::Table->construct_where_clause(
 	$tables,
 	'id' => [7, 8, 9],
 	'status' => 1,
 );  #returns ('tablename.id in (?, ?, ?) AND tablename.status = ?', 7, 8, 9, 1)

You may specify alternative values for columns in a hashref.

 my ($stmt, @values) = Basset::DB::Table->construct_where_clause(
 	$tables,
 	'id' => {
 		'>' => 7,
 		'<' => 14,
 	'status' => 1,
 );  #returns ('(tablename.id > ? OR tablename.id < ?) AND tablename.status = ?', 7, 14, 1)

Groups of sets of values are joined with OR clauses.

 my ($stmt, @values) = Basset::DB::Table->construct_where_clause(
 	$tables,
 	['id' => 7,'status' => 1,],
 	['id' => {'>' => 18'}, 'status' => 3],
 	['status' => 5'],
 );  #returns ('(tablename.id = ? OR tablename.status = ?) OR (tablename.id > ? AND status = ?) OR (status = ?)', 7, 1, 18, 3, 5)

groups may be nested

 my ($stmt, @values) = Basset::DB::Table->construct_where_clause(
 	$tables,
 	'id' => 7,
 	['id' => {'>' => 20}, ['name' => 'test', status => 5]]
 );  #returns ('(tablename.id = ?) OR (tablename.id > ? OR (tablename.name = ? AND tablename.status = ?))', 7, 20, test, 5)

Column order may not be preserved.

 my ($stmt, @values) = Basset::DB::Table->construct_where_clause(
 	$tables,
 	'id' => 7,
 	['id' => 8],
 	'name' => 'foo',
 );  #returns ('(tablename.id = ? AND tablename.name = ?) OR (tablename.id = ?)', 7, 'foo', 8)

To group different columns with different and clauses, repeat the clause.

 my ($stmt, @values) = Basset::DB::Table->construct_where_clause(
 	$tables,
 	'id' => {'>' => 8},
 	'id' => {'<' => 25},
 );  #returns ('tablename.id > ? AND tablename.id < ?', 8, 25)

Finally, sometimes you just need to have a literal value in there that you can't bind to a place holder. In that case, you want to pass in a reference.

 my ($stmt, @values) = Basset::DB::Table->construct_where_clause(
 	$tables,
 	'id' => {'>' => \8},
 	'id' => {'<' => \25},
 );  #returns ('tablename.id > 8 AND tablename.id < 25')

 This is most useful, obviously, for NULLs.

  my ($stmt, @values) = Basset::DB::Table->construct_where_clause(
 	$tables,
 	'id' => {'is' => \'NULL', '=' => 4},
 );  #returns ('tablename.id is NULL or tablename.id = ?', 4)
arbitrary_sql

Wrappers Basset::Object::Persistent's arbitrary_sql method.

Basset documentation Contained in the Basset distribution. 
package Basset::DB::Table;

#Basset::DB::Table Copyright and (c) 2002, 2003, 2004, 2005, 2006 James A Thomason III
#Basset::DB::Table is distributed under the terms of the Perl Artistic License.

our $VERSION = '1.02';


use Basset::Object;
our @ISA = Basset::Object->pkg_for_type('object');

use strict;
use warnings;


__PACKAGE__->add_attr('name');



__PACKAGE__->add_attr('primary_column');



__PACKAGE__->add_attr('autogenerated');



__PACKAGE__->add_attr('definition');


__PACKAGE__->add_attr('references');


__PACKAGE__->add_attr('extra_select');


__PACKAGE__->add_attr(['db_read_translation', '_isa_translation_accessor']);


__PACKAGE__->add_attr(['db_write_translation', '_isa_translation_accessor']);


__PACKAGE__->add_attr('column_aliases');

# internally stores all previously built queries for this table, for speed.
# caches are generated per table/query/columns
__PACKAGE__->add_attr('_cached_queries');


# internally stores all previously built bindables for this table, for speed.
# caches are generated per table/query/columns
__PACKAGE__->add_attr('_cached_bindables');


__PACKAGE__->add_attr('last_insert_query');


__PACKAGE__->add_attr(['insert_columns',  '_isa_column_list_accessor']);
__PACKAGE__->add_attr(['update_columns',  '_isa_column_list_accessor']);
__PACKAGE__->add_attr(['delete_columns',  '_isa_column_list_accessor']);
__PACKAGE__->add_attr(['replace_columns', '_isa_column_list_accessor']);
__PACKAGE__->add_attr(['select_columns',  '_isa_column_list_accessor']);

__PACKAGE__->add_attr(['noninsert_columns',  '_isa_column_list_accessor']);
__PACKAGE__->add_attr(['nonupdate_columns',  '_isa_column_list_accessor']);
__PACKAGE__->add_attr(['nondelete_columns',  '_isa_column_list_accessor']);
__PACKAGE__->add_attr(['nonreplace_columns', '_isa_column_list_accessor']);
__PACKAGE__->add_attr(['nonselect_columns',  '_isa_column_list_accessor']);


sub _isa_column_list_accessor {
	my $pkg = shift;
	my $attr = shift;
	my $prop = shift;

	return sub {
		my $self	= shift;
	
		my $prefix = $self->system_prefix;
		(my $propname = $prop) =~ s/^$prefix//;
	
		if (@_) {
			foreach my $col (@{$_[0]}) {
				return $self->error("Cannot add $col for $propname - not a column", "BDT-13")
					unless $self->is_column($col);
			}
	
			$self->$prop(@_);
		}
	
		my $vals = $self->$prop() || [];
	
		my @vals = @$vals ? @$vals : $self->cols;
	
		#weed out our non-columns, if they were provided.
		if ($propname !~ /non/) {
			my $nonprop = $prefix . 'non' . $propname;
			my $nonvals = {map {$_, 1} @{$self->$nonprop() || []}};
	
			@vals = grep {! $nonvals->{$_}} @vals;
		}
	
		return @vals;
	}
}

sub _isa_translation_accessor {
	my $pkg = shift;
	my $attr = shift;
	my $prop = shift;

	return sub {
		my $self = shift;
		$self->_cached_queries({}) if @_;
		$self->_cached_bindables({}) if @_;
		return $self->$prop(@_);
	};
}



#just a bubble-up initializer. Initializes some values and passes them through.
sub init {
	my $self = shift;

	my %init = (
		'definition'				=> {},
		'extra_select'				=> {},
		'db_write_translation'		=> {},
		'db_read_translation'		=> {},
		'column_aliases'			=> {},
		'references'				=> {},
		'_cached_queries'			=> {},
		'_cached_bindables'			=> {},
		'attributes_not_to_create'	=> [],
		'create_attributes'			=> 0,
		'last_insert_query'			=> 'SELECT LAST_INSERT_ID()',
		@_
	);

	if ($init{'discover'}) {
		$init{'definition'} = $self->discover_columns($init{'name'}) or return;
	} elsif ($init{'non_primary_columns'}) {
		my @primary = ref $init{'primary_column'} ? @{$init{'primary_column'}} : ($init{'primary_column'});
		$init{'definition'} = $self->discover_columns($init{'name'}, (@primary, @{$init{'non_primary_columns'}})) or return;
	}

	#$self->definition($init{'definition'});

	return $self->SUPER::init(
		'definition' => $init{'definition'},
		%init
	);
};

__PACKAGE__->add_attr('_attributes_to_create');
__PACKAGE__->add_attr('attributes_not_to_create');

__PACKAGE__->add_attr('create_attributes');

sub attributes_to_create {
	my $self = shift;
	if (@_) {
		$self->_attributes_to_create($_[0]);
	};
	
	my %not = map {$_, 1} @{$self->attributes_not_to_create};
	
	return grep {! $not{$_} } $self->alias_column($self->_attributes_to_create ? @{$self->_attributes_to_create} : $self->cols);
}


sub cols {
	my $self = shift;
	return keys %{$self->definition};
};


sub defs {
	my $self = shift;
	return values %{$self->definition};
};


sub is_bindable {
	my $self	= shift;
	my $type	= shift or return $self->error("Cannot check bindableness w/o type", "BDT-31");
	my $col		= shift or return $self->error("Cannot check bindableness w/o column", "BDT-30");

	my $db_write_translation = $self->db_write_translation;

	if (defined $db_write_translation->{$col}) {
		if (defined $db_write_translation->{$col}->{$type}){
			return $db_write_translation->{$col}->{$type}->{'binds'};
		}
		elsif (defined $db_write_translation->{$col}->{'A'}){
			return $db_write_translation->{$col}->{'A'}->{'binds'};
		}
	};
	return 1;
};


sub is_selectable {
	my $self = shift;

	my $value = shift or return $self->error("Cannot determine selectable-ness w/o value", "BDT-44");

	return 1 if $self->is_column($value);									#columns are selectable

	return 1 if $value =~ /^(\d+(\.\d+)?|\.\d+)(\s+(as|AS)\s*.+)?$/;		#numbers are selectable

	return 1 if $value =~ /^(['"]).*\1(\s+(as|AS)\s*.+)?$/;					#quoted strings are selectable

	return 1 if $value =~ /^[a-zA-Z]+\(.*\)(\s+(as|AS)\s*.+)?$/;			#functions are selectable

	return 0;

}

# this is used internally to do translations required by db_write_translation
#
# gets two args, $type and $col, and returns the 'val' in the hash if it is specified.
# otherwise, there is no change, so it returns a normal '?' placeholder.


sub db_translate_write {
	my $self	= shift;
	my $type	= shift or return $self->error("Cannot do db_translate_write w/o type", "BDT-33");
	my @cols	= @_ or return $self->error("Cannot do db_translate_write w/o column", "BDT-32");

	my $db_write_translation = $self->db_write_translation;

	foreach my $col (@cols) {

		if (defined $db_write_translation->{$col}) {
			if (defined $db_write_translation->{$col}->{$type}){
				$col = $db_write_translation->{$col}->{$type}->{'val'};
			}
			elsif (defined $db_write_translation->{$col}->{'A'}){
				$col = $db_write_translation->{$col}->{'A'}->{'val'};
			} else {
				$col = '?';
			}
		} else {
			$col = '?';
		};
	}

	return wantarray ? @cols : $cols[0];
};

# this is used internally to do translations required by db_read_translation
#
# gets one argument, $col, and returns the 'val' in the hash if it is specified.
# otherwise, there is no change, so it returns the column


sub db_translate_read {
	my $self	= shift;
	my @cols		= @_ or return $self->error("Cannot do db_translate_read w/o col", "BDT-34");

	my $db_read_translation = $self->db_read_translation;

	foreach my $col (@cols) {
		if (defined $db_read_translation->{$col}) {
			$col = $db_read_translation->{$col};
		} else {
			$col = $self->qualified_name($col);
		}
	}

	return wantarray ? @cols : $cols[0];
};


sub alias_column {
	my $self	= shift;
	my @cols	= @_ or return $self->error('Cannot alias column w/o column', "BDT-36");

	my $aliases = $self->column_aliases;

	foreach my $col (@cols) {

		$col = $self->nonqualified_name($col);	
		$col = $aliases->{$col}
			if defined $aliases->{$col};
	}

	return wantarray ? @cols : $cols[0];
};


sub column_for_alias {
	my $self	= shift;
	my $col		= shift or return $self->error("Cannot get column w/o alias", "BDT-35");

	$col = $self->nonqualified_name($col);

	my %rev;
	@rev{values %{$self->column_aliases}} = keys %{$self->column_aliases};
	if (defined $rev{$col}) {
		return $rev{$col};
	} else {
		return $col;
	};
};


sub insert_bindables {
	my $self = shift;
	if (my $bindables = $self->_cached_bindables->{'insert'}) {
		return @$bindables;
	} else {
		my @bindables = grep {$self->is_bindable('I', $_)} $self->insert_columns;
		$self->_cached_bindables->{'insert'} = \@bindables;
		return @bindables;
	};
};


sub replace_bindables {
	my $self = shift;
	return grep {$self->is_bindable('R', $_)} $self->replace_columns;
};


__PACKAGE__->add_attr('_cached_bindables');

sub update_bindables {
	my $self = shift;
	if (my $bindables = $self->_cached_bindables->{'update'}) {
		return @$bindables;
	} else {
        my @excess = $self->primary_cols;
		my @bindables = grep {$self->is_bindable('U', $_)} ($self->update_columns, @excess);
		$self->_cached_bindables->{'update'} = \@bindables;
		return @bindables;
	};
}


sub delete_bindables {
	my $self = shift;
	return $self->primary_cols;
};


sub select_bindables {
	my $self = shift;

	return $self->primary_cols;
}


sub insert_query {
	my $self = shift;

	my @cols = @_;

	if (@cols){
		foreach my $col (@cols){
			return $self->error("Cannot insert column not in table : $col", "BDT-07")
				unless $self->is_column($col);
		};
	} else {
		@cols = $self->insert_columns;
	}

	my $querykey = join(',', 'insert', @cols);

	my $query = $self->_cached_queries->{$querykey} || "insert into " . $self->name . " ("
		. join(', ', @cols)
		. ") values ("
		. join(", ", $self->db_translate_write('I', @cols)) #map { $self->db_translate_write($_, 'I') } @cols)
		. ")";

	$self->_cached_queries->{$querykey} = $query;

	return $query;
};


sub replace_query {
	my $self = shift;

	my @cols = @_;

	if (@cols){
		foreach my $col (@cols){
			return $self->error("Cannot replace column not in table : $col", "BDT-08")
				unless $self->is_column($col);
		};
	};

	@cols = $self->replace_columns unless @cols;

	my $querykey = join(',', 'replace', @cols);

	my $query = $self->_cached_queries->{$querykey} || "replace into " . $self->name . " ("
		. join(', ', @cols)
		. ") values ("
		. join(", ", $self->db_translate_write('R', @cols)) #map { $self->db_translate_write($_, 'R') } @cols)
		. ")";

	$self->_cached_queries->{$querykey} = $query;

	return $query;
};


sub update_query {
	my $self = shift;

	my @cols = @_;

	if (@cols){
		foreach my $col (@cols){
			return $self->error("Cannot update column not in table : $col", "BDT-06")
				unless $self->is_column($col);
		};
	} else {
		@cols = $self->update_columns;
	}

	#my $where = " where " . join(' and ', map {"$_ = ?"} $self->primary_cols);

	my $querykey = join(',', 'update', @cols);

	my $query = $self->_cached_queries->{$querykey} || "update " . $self->name . " set "
		. join(', ', map {$_ . " = " . $self->db_translate_write('U', $_)} @cols)
		;#	. $where;

	$self->_cached_queries->{$querykey} = $query;

	return $query;
};


sub delete_query {
	my $self = shift;

	return "delete from " . $self->name;
};


sub select_query {
	my $self = shift;

	my @cols = @_;

	if (@cols){
		foreach my $col (@cols){
			return $self->error("Cannot select column not in table : $col", "BDT-05")
				unless $self->is_selectable($col);
				#regex matches numbers, "foo", 'foo', or function(), also used below
				#in constructing the query
		};
	} else {
		@cols = ($self->select_columns, keys %{$self->extra_select});
	};

	my $querykey = join(',', 'select', @cols);

	my $query = $self->_cached_queries->{$querykey} || "select "
		. join(', ', map {
						$self->extra_select->{$_}
							? $self->extra_select->{$_} . ' as ' . $_
							: $self->is_column($_)
								? $self->db_translate_read($_) . ' as ' . $self->alias_column($_)
								: $_
			}
			@cols)
		. " from " . $self->name;

	$self->_cached_queries->{$querykey} = $query;

	return $query;

};


sub multiselect_query {
	my $class = shift;

	my %init = (
		'cols'			=> [],
		'use_aliases'	=> 0,
		@_
	);

	return $class->error("Cannot multi-select w/o tables", "BDT-47") unless defined $init{'tables'};

	$init{'tables'} = [$init{'tables'}] unless ref $init{'tables'} eq 'ARRAY';
	$init{'cols'} = [$init{'cols'}] unless ref $init{'cols'} eq 'ARRAY';

	if (@{$init{'tables'}} == 1) {
		return $init{'tables'}->[0]->select_query(@{$init{'cols'}});
	};

	my $joined_tables = $class->join_tables(@{$init{'tables'}}) or return;

	my %omit = ();

	if ($init{'omit_columns_from_tables'}) {
		%omit = map {$_->name, 1} @{$init{'omit_columns_from_tables'}};
	}

	unless (@{$init{'cols'}}) {
		#we duplicate the for loop to keep from doing the condition constantly in the loop. Lazy, I know.
		if ($init{'use_aliases'}) {
			foreach my $table (@{$init{'tables'}}) {
				next if $omit{$table->name};
				push @{$init{'cols'}}, map {$table->db_translate_read($_) . ' as ' . $table->alias_column($_)} $table->select_columns;
			}
		} else {
			foreach my $table (@{$init{'tables'}}) {
				next if $omit{$table->name};
				push @{$init{'cols'}}, map {$table->db_translate_read($_)} $table->select_columns;
			}
		}
	};

	return "select\n\t" . join(",\n\t", @{$init{'cols'}}) . "\nfrom\n" . $joined_tables;
}


sub count_query {
	my $self = shift;

	return "select count(1) as count from " . $self->name;
};


sub optimize_query {
	my $self = shift;

	return "optimize table " . $self->name;
};



sub describe_query {
	my $self = shift;

	return "desc " . $self->name;
};


sub reference_query {
	my $self = shift;
	my $column = shift;

	if (my $def = $self->referenced_column($column)) {
		my ($table, $col) = split(/\./, $def);
		my $tempTable = $self->pkg->new('name' => $table);
		return $tempTable->attach_to_query(
			$tempTable->count_query,
			{
				'where' => "$col = ?"
			}
		);
	} else {
		return $self->error("Cannot build query...$column is not a referenced column", "BDT-14");
	}
};


sub is_column {
	my $self	= shift;
	my $col		= shift or return $self->error("Cannot column-ness without column", "BDT-04");

	foreach my $column ($self->cols){
		return 1 if $column eq $col;
	}
	return 0;
};


sub is_primary {
	my $self	= shift;
	my $col		= shift or return $self->error("Cannot determine primary-ness without column", "BDT-01");

	my %primaries = map {$_, 1} grep {defined} $self->primary_cols();

	return 1 if $primaries{$col};
	return 0;
};


sub non_primary_cols {
	my $self	= shift;

	return grep {! $self->is_primary($_)} $self->cols;
};


sub primary_cols {
	my $self	= shift;

	my $primary = $self->primary_column;

	if (! ref $primary) {
		return ($primary);
	} elsif (ref $primary) {
		return @{$primary};
	} else {
		return ();
	};
};


sub foreign_cols {
	my $self = shift;

	my $foreign_table = shift or return $self->error("Cannot get foreign cols w/o table", "BDT-45");

	my @foreign_table_cols = map {$foreign_table->qualified_name($_)} grep {defined} (@_ ? @_ : $foreign_table->primary_cols);

	my $idx = 0;
	my %foreign_table_cols = map {$_, ++$idx} @foreign_table_cols;

	return
		sort {$foreign_table_cols{$self->references->{$a}} <=> $foreign_table_cols{$self->references->{$b}}}
		grep {$foreign_table_cols{$self->references->{$_}}}
	keys %{$self->references};
}


sub referenced_column {
	my $self = shift;
	my $column = shift or return $self->error("Cannot determine reference w/o column", "BDT-15");

	return $self->references->{$column} 
		|| $self->error("Column does not reference any other table", "BDT-16");

}


sub discover_columns {
	my $self = shift;
	my $table = shift or return $self->error("Cannot discover columns w/o table", "BDT-51");

	my $columns = join(', ', @_ ? @_ : ('*'));

	my $stmt = $self->arbitrary_sql(
		'query' => "select $columns from $table where 1 = 0",
		'iterator' => 1,
	) or do {
		if ($columns) {
			return { map {$_, undef} @_};
		} else {
			return;
		}
	};

	my $definition = {};
	for (my $idx = 0; $idx < $stmt->{'NUM_OF_FIELDS'}; $idx++) {
		$definition->{$stmt->{'NAME_lc'}->[$idx]} = $stmt->{'TYPE'}->[$idx];
	}

	$stmt->finish or return $self->error($stmt->errstr, 'BDT-37');

	return $definition;

}


sub attach_to_query {
	my $class = shift;

	my $query	= shift or return $class->error("Cannot attach to query w/o query", "BDT-02");
	my $clauses	= shift || {};

	unless (keys %$clauses) {
		$class->notify("warnings", "No clauses to attach to query");
		return $query;
	};

	return $class->error("Cannot have having without group", "BDT-09")
		if defined $clauses->{'having'} && ! defined $clauses->{'group by'};

	foreach my $clause ('where', 'group by', 'having', 'order by', 'limit'){
		if (defined $clauses->{$clause}){
			my $value = $clauses->{$clause};

			$query .= "\n  " . $clause . " " . $value;
		};
	};

	return $query;
};



sub join_tables {
	my $self = shift;

	my @tables = @_;

	my @last_tables = ();

	{
		my $first_table = shift @tables or return $self->error("Cannot join tables w/o table", "BDT-28");

		if (ref $first_table eq 'ARRAY') {
			$first_table = ref $first_table->[0] ? $first_table->[0] : $first_table->[1];
		};

		unshift @last_tables, $first_table;

	}

	my $joined_tables = $last_tables[0]->name;

	while (@tables) {
		my $table = shift @tables;
		my ($join, $cols) = ('inner', []);

		if (ref $table eq 'ARRAY') {
			if (@$table == 3) {
				($join, $table, $cols) = @$table;
				$cols = [$cols] unless ref $cols;
			} elsif (@$table == 2) {
				if (! ref $table->[0]) {
					($join, $table) = @$table;
				} else {
					($table, $cols) = @$table;
					$cols = [$cols] unless ref $cols;
				}
			}
			else {
				($table) = @$table;
			};

		}

		if (@$cols == 0 && $join ne 'natural') {
			my $found = 0;
			my $idx = 0;
			while (! $found && $idx < @last_tables) {

				my $last_table = $last_tables[$idx++];

				my @foreign_cols = $table->foreign_cols($last_table);
				if (@foreign_cols) {
					$found++;
					foreach my $col (@foreign_cols) {
						push @$cols, $table->qualified_name($col) . ' = ' . $table->referenced_column($col);
					}
				}
				my @last_foreign_cols = $last_table->foreign_cols($table);

				if (@last_foreign_cols) {
					$found++;
					foreach my $col (@last_foreign_cols) {
						push @$cols, $last_table->qualified_name($col) . ' = ' . $last_table->referenced_column($col);
					}
				}
			}
			unless ($found) {
				return $self->error("Cannot auto-join table " . $table->name . " : not referenced by prior table", "BDT-27");
			}
		}

		$joined_tables .= "\n\t$join join\n\t\t" . $table->name;
		$joined_tables .= "\n\t\t\ton " . join("\n\t\t\tand ", @$cols) if @$cols;
		unshift @last_tables, $table;
	}

	return $joined_tables;
}


sub many_clause {
	my $self = shift;
	my $column = shift or return $self->error("Cannot build many clause w/o column", "BDT-21");
	my $negative = 0;

	my @columns = @_ or return $self->error("Cannot build many clause w/o values", "BDT-22");

	if (ref $columns[-1] eq 'ARRAY') {
		$negative = shift @columns if @columns == 2;
		@columns = @{$columns[-1]} or return $self->error("Cannot build many clause w/o values", "BDT-22");
	}

	$column = $self->column_for_alias($column);

	$negative = $negative ? ' not' : '';

	return $self->qualified_name($column) . "$negative in (" . join(', ', ("?") x @columns) . ')';
};


sub qualified_name {
	my $self	= shift;
	my @cols	= @_ or return $self->error("Cannot qualify name w/o column", "BDT-23");
	my $name = $self->name or return $self->error("Cannot qualify name w/o table name", "BDT-24");

	foreach my $column (@cols) {
		next if index($column, '.') != -1;
		$column = "$name.$column";
	}
	
	return wantarray ? @cols : $cols[0];
};


sub nonqualified_name {
	my $class = shift;
	my $column = shift or return $class->error("Cannot unqualify name w/o column", "BDT-46");

	return substr($column, index($column, '.') + 1);
}


sub construct_where_clause {
	my $class = shift;

	my $tables	= shift or return $class->error("Cannot construct_where_clause w/o tables", "BDT-48");
	my @clauses = @_ or return $class->error("Cannot construct_where_clause w/o clauses", "BDT-49");

	my @where = ();
	my @values = ();
	my @extra = ();

	while (@clauses) {
		my $clause = shift @clauses;

		if (ref $clause eq 'ARRAY') {
			my @subvalues = $class->construct_where_clause($tables, @$clause)
				or return;
			push @extra, \@subvalues;
			next;
		}

		my @relational = ();
		my @myvalues = ();

		my $value	= shift @clauses;
		if (ref $value eq 'HASH') {
			push @relational, sort keys %$value;
			push @myvalues, map {$value->{$_}} sort keys %$value;
		} else {
			push @myvalues, $value;
		};

		my $table = undef;
		my ($name, $col);
		if ($clause =~ /^(\w+)\.(\w+)$/) {
			($name, $col) = ($1, $2);
		};

		foreach my $t (@$tables) {

			if (defined $t->definition->{$t->column_for_alias($clause)}) {
				if (! defined $name || $name eq $t->name) {
					$table = $t;
					last;
				}
			}
		};

		return $class->error("Cannot construct_where_clause with clause $clause : not in any object table", "BDT-50")
			unless defined $table;

		my @mywhere = ();

		while (@myvalues) {
			my $value = shift @myvalues;
			my $relation = shift @relational || '=';

			if (ref $value eq 'ARRAY') {
				push @mywhere, $table->many_clause($clause, @$value);
				if (ref $value->[-1] eq 'ARRAY') {
					push @values, @{$value->[-1]};
				} else {
					push @values, @$value
				}
			} else {
				if (ref $value) {
					push @mywhere, $table->qualified_name($clause) . " $relation $$value";
				} else {
					push @mywhere, $table->qualified_name($clause) . " $relation ?";
					push @values, $value;
				}
			}
		}

		my $mywhere = join(' OR ', @mywhere);
		$mywhere = "($mywhere)" if @mywhere > 1;
		push @where, $mywhere;

	}

	my $where = join(' AND ', @where);
	if (@extra) {
		while (@extra) {
			my $extra = shift @extra;
			my $clause = shift @$extra;
			$where .= " OR " if $where;
			$where .= "($clause)";
			push @values, @$extra;
		}
	}
	return ($where, @values);
}


sub arbitrary_sql {
	my $class = shift;

	my $persistent_class = $class->pkg_for_type('persistentobject');
	return $persistent_class->arbitrary_sql(@_) || $class->error($persistent_class->errvals);
}

1;