[Rt-commit] r3521 - in Jifty-DBI/trunk: . SearchBuilder ex
ex/Example/Model lib lib/Jifty lib/Jifty/DBI
lib/Jifty/DBI/Handle lib/Jifty/DBI/Record t
jesse at bestpractical.com
jesse at bestpractical.com
Sun Jul 24 21:04:56 EDT 2005
Author: jesse
Date: Sun Jul 24 21:04:49 2005
New Revision: 3521
Added:
Jifty-DBI/trunk/lib/
Jifty-DBI/trunk/lib/Jifty/
Jifty-DBI/trunk/lib/Jifty/DBI/
Jifty-DBI/trunk/lib/Jifty/DBI/Collection.pm (contents, props changed)
Jifty-DBI/trunk/lib/Jifty/DBI/Handle/
Jifty-DBI/trunk/lib/Jifty/DBI/Handle.pm (contents, props changed)
Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Informix.pm
Jifty-DBI/trunk/lib/Jifty/DBI/Handle/ODBC.pm
Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Oracle.pm (contents, props changed)
Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Pg.pm (contents, props changed)
Jifty-DBI/trunk/lib/Jifty/DBI/Handle/SQLite.pm
Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Sybase.pm
Jifty-DBI/trunk/lib/Jifty/DBI/Handle/mysql.pm (contents, props changed)
Jifty-DBI/trunk/lib/Jifty/DBI/Handle/mysqlPP.pm
Jifty-DBI/trunk/lib/Jifty/DBI/Record/
Jifty-DBI/trunk/lib/Jifty/DBI/Record.pm (contents, props changed)
Jifty-DBI/trunk/lib/Jifty/DBI/Record/Cachable.pm (contents, props changed)
Jifty-DBI/trunk/lib/Jifty/DBI/SchemaGenerator.pm
Jifty-DBI/trunk/lib/Jifty/DBI/Union.pm
Jifty-DBI/trunk/lib/Jifty/DBI/Unique.pm
Removed:
Jifty-DBI/trunk/SearchBuilder/
Jifty-DBI/trunk/SearchBuilder.pm
Modified:
Jifty-DBI/trunk/ (props changed)
Jifty-DBI/trunk/Changes
Jifty-DBI/trunk/META.yml
Jifty-DBI/trunk/Makefile.PL
Jifty-DBI/trunk/README
Jifty-DBI/trunk/ex/Example/Model/Address.pm
Jifty-DBI/trunk/ex/Example/Model/Employee.pm
Jifty-DBI/trunk/ex/create_tables.pl
Jifty-DBI/trunk/t/00.load.t
Jifty-DBI/trunk/t/01basics.t
Jifty-DBI/trunk/t/01nocap_api.t
Jifty-DBI/trunk/t/01records.t
Jifty-DBI/trunk/t/01searches.t
Jifty-DBI/trunk/t/02records_object.t
Jifty-DBI/trunk/t/03rebless.t
Jifty-DBI/trunk/t/10schema.t
Jifty-DBI/trunk/t/11schema_records.t
Jifty-DBI/trunk/t/testmodels.pl
Jifty-DBI/trunk/t/utils.pl
Log:
r6993 at hualien: jesse | 2005-07-24 21:04:20 -0400
* basic restructuring. renaming. time for something deeper.
Modified: Jifty-DBI/trunk/Changes
==============================================================================
--- Jifty-DBI/trunk/Changes (original)
+++ Jifty-DBI/trunk/Changes Sun Jul 24 21:04:49 2005
@@ -1,13 +1,13 @@
-Revision history for Perl extension DBIx::SearchBuilder.
+Revision history for Perl extension Jifty::DBI.
* Removed {{{ and }}} fold markers. Patch from Ruslan
1.30_03 Thu Jun 9 01:35:49 EDT 2005
* Significant new tests from Ruslan Zakirov and Dave Glasser
-* You no longer need to explicitly bless a DBIx::SearchBuilder::Handle subclass
+* You no longer need to explicitly bless a Jifty::DBI::Handle subclass
-* Start of a major overhaul of the subclass API for DBIx::SearchBuilder::Record objects.
+* Start of a major overhaul of the subclass API for Jifty::DBI::Record objects.
A new "schema" method will define the data in _ClassAccessible and also generate database
schema using DBIx::DBSchema.
@@ -126,9 +126,9 @@
into the database.
- Started adding lowercase method name aliases
- Minor refactoring of 'id' method for a stupid, tiny perf improvement
- - Refactoring of DBIx::SearchBuilder::Record::Cachable for performance
+ - Refactoring of Jifty::DBI::Record::Cachable for performance
improvement
- - Added a FlushCache method to DBIx::SearchBuilder::Record::Cachable.
+ - Added a FlushCache method to Jifty::DBI::Record::Cachable.
- Started to flesh out a...test suite
- SearchBuilder now truncates strings before inserting them into character
types in the database as mysql generally does. Additionally, it truncates
@@ -157,7 +157,7 @@
1.10_05
- - Reworked the _Accessible mechanism in DBIx::SearchBuilder::Record to
+ - Reworked the _Accessible mechanism in Jifty::DBI::Record to
remove a horribly crufty old caching mechanism that created a copy
of the accessible hash for each and every object instantiated,
sometimes quite slowly.
@@ -183,7 +183,7 @@
1.10_02 Thu Aug 26 13:31:13 EDT 2004
1.10_01 Thu Aug 26 00:08:31 EDT 2004
- - Reimplemented DBIx::SearchBuilder:::Record::Cachable
+ - Reimplemented Jifty::DBI:::Record::Cachable
to use Cache::Simple::TimedExpiry. This should make it faster and more
memory efficient.
@@ -343,7 +343,7 @@
- No longer attempt to cache (and fail) objects that haven't been database-loaded
0.76 Dec 30 2002
- - Extra checking for cache misses in DBIx::SearchBuilder::Record::Cachable
+ - Extra checking for cache misses in Jifty::DBI::Record::Cachable
- The start of support for checking database version, so that we can do
version-specific SQL
- A patch from Autrijus Tang that allows utf-8 safe searching
@@ -382,7 +382,7 @@
0.30 Fri May 11 14:59:17 EDT 2001
- - Added DBIx::SearchBuilder::Record::Cachable from <mhat at netlag.com>
+ - Added Jifty::DBI::Record::Cachable from <mhat at netlag.com>
- Changed SearchBuilder->Count to do the right thing if no
query has been performed
- No longer specify a sort order if no sort order was specified ;)
Modified: Jifty-DBI/trunk/META.yml
==============================================================================
--- Jifty-DBI/trunk/META.yml (original)
+++ Jifty-DBI/trunk/META.yml Sun Jul 24 21:04:49 2005
@@ -1,5 +1,5 @@
-name: DBIx-SearchBuilder
-version: 1.30_03
+name: Jifty-DBI
+version: 0.01
license: perl
distribution_type: module
build_requires:
Modified: Jifty-DBI/trunk/Makefile.PL
==============================================================================
--- Jifty-DBI/trunk/Makefile.PL (original)
+++ Jifty-DBI/trunk/Makefile.PL Sun Jul 24 21:04:49 2005
@@ -1,8 +1,8 @@
use inc::Module::Install;
-name ('DBIx-SearchBuilder');
+name ('Jifty-DBI');
license ('perl');
-version_from('SearchBuilder.pm');
+version_from('lib/Jifty/DBI.pm');
requires('DBI');
requires('Want');
requires('Encode');
@@ -11,10 +11,6 @@
build_requires('Test::More' => 0.52);
features(
- 'Lower case API' => [
- -default => 0,
- 'capitalization' => '0.03',
- ],
'Schema generation' => [
-default => 1,
'DBIx::DBSchema' => '',
Modified: Jifty-DBI/trunk/README
==============================================================================
--- Jifty-DBI/trunk/README (original)
+++ Jifty-DBI/trunk/README Sun Jul 24 21:04:49 2005
@@ -1,5 +1,5 @@
NAME
- DBIx::SearchBuilder - Encapsulate SQL queries and rows in simple perl
+ Jifty::DBI - Encapsulate SQL queries and rows in simple perl
objects
DESCRIPTION
@@ -13,7 +13,7 @@
# make install
TESTING
- In order to test most of the features of "DBIx::SearchBuilder", you need
+ In order to test most of the features of "Jifty::DBI::Collection", you need
to provide "make test" with a test database. For each DBI driver that
you would like to test, set the environment variables "SB_TEST_FOO",
"SB_TEST_FOO_USER", and "SB_TEST_FOO_PASS" to a database name, database
Modified: Jifty-DBI/trunk/ex/Example/Model/Address.pm
==============================================================================
--- Jifty-DBI/trunk/ex/Example/Model/Address.pm (original)
+++ Jifty-DBI/trunk/ex/Example/Model/Address.pm Sun Jul 24 21:04:49 2005
@@ -1,6 +1,6 @@
package Example::Model::Address;
-use base qw/DBIx::SearchBuilder::Record/;
+use base qw/Jifty::DBI::Record/;
# Class and instance method
Modified: Jifty-DBI/trunk/ex/Example/Model/Employee.pm
==============================================================================
--- Jifty-DBI/trunk/ex/Example/Model/Employee.pm (original)
+++ Jifty-DBI/trunk/ex/Example/Model/Employee.pm Sun Jul 24 21:04:49 2005
@@ -1,6 +1,6 @@
package Example::Model::Employee;
-use base qw/DBIx::SearchBuilder::Record/;
+use base qw/Jifty::DBI::Record/;
sub Table { "Employees" }
Modified: Jifty-DBI/trunk/ex/create_tables.pl
==============================================================================
--- Jifty-DBI/trunk/ex/create_tables.pl (original)
+++ Jifty-DBI/trunk/ex/create_tables.pl Sun Jul 24 21:04:49 2005
@@ -15,8 +15,8 @@
Password => '',
);
-use DBIx::SearchBuilder::Handle;
-use DBIx::SearchBuilder::SchemaGenerator;
+use Jifty::DBI::Handle;
+use Jifty::DBI::SchemaGenerator;
my $BaseClass;
@@ -26,7 +26,7 @@
usage: $0 Base::Class [libpath ...]
This script will search \@INC (with the given paths added
to its beginning) for all classes beginning with Base::Class::,
- which should be subclasses of DBIx::SearchBuilder::Record implementing
+ which should be subclasses of Jifty::DBI::Record implementing
Schema and Table. It prints SQL to generate tables standard output.
While it does not actually create the tables, it needs to connect to your
@@ -42,11 +42,11 @@
use Module::Pluggable search_path => $BaseClass, sub_name => 'models', instantiate => 'new';
-my $handle = DBIx::SearchBuilder::Handle->new;
+my $handle = Jifty::DBI::Handle->new;
$handle->Connect( @CONNECT_ARGS );
-my $SG = DBIx::SearchBuilder::SchemaGenerator->new($handle);
+my $SG = Jifty::DBI::SchemaGenerator->new($handle);
die "Couldn't make SchemaGenerator" unless $SG;
Added: Jifty-DBI/trunk/lib/Jifty/DBI/Collection.pm
==============================================================================
--- (empty file)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Collection.pm Sun Jul 24 21:04:49 2005
@@ -0,0 +1,1614 @@
+
+package Jifty::DBI::Collection;
+
+use strict;
+use vars qw($VERSION);
+
+$VERSION = "1.30_03";
+
+=head1 NAME
+
+Jifty::DBI - Encapsulate SQL queries and rows in simple perl objects
+
+=head1 SYNOPSIS
+
+ use Jifty::DBI;
+
+ package My::Things;
+ use base qw/Jifty::DBI::Collection/;
+
+ sub _Init {
+ my $self = shift;
+ $self->Table('Things');
+ return $self->SUPER::_Init(@_);
+ }
+
+ sub NewItem {
+ my $self = shift;
+ # MyThing is a subclass of Jifty::DBI::Record
+ return(MyThing->new);
+ }
+
+ package main;
+
+ use Jifty::DBI::Handle;
+ my $handle = Jifty::DBI::Handle->new();
+ $handle->Connect( Driver => 'SQLite', Database => "my_test_db" );
+
+ my $sb = My::Things->new( Handle => $handle );
+
+ $sb->Limit( FIELD => "column_1", VALUE => "matchstring" );
+
+ while ( my $record = $sb->Next ) {
+ print $record->my_column_name();
+ }
+
+=head1 DESCRIPTION
+
+This module provides an object-oriented mechanism for retrieving and updating data in a DBI-accesible database.
+
+In order to use this module, you should create a subclass of C<Jifty::DBI> and a
+subclass of C<Jifty::DBI::Record> for each table that you wish to access. (See
+the documentation of C<Jifty::DBI::Record> for more information on subclassing it.)
+
+Your C<Jifty::DBI> subclass must override C<NewItem>, and probably should override
+at least C<_Init> also; at the very least, C<_Init> should probably call C<_Handle> and C<_Table>
+to set the database handle (a C<Jifty::DBI::Handle> object) and table name for the class.
+You can try to override just about every other method here, as long as you think you know what you
+are doing.
+
+=head1 METHOD NAMING
+
+Each method has a lower case alias; '_' is used to separate words.
+For example, the method C<RedoSearch> has the alias C<redo_search>.
+
+=head1 METHODS
+
+=cut
+
+
+=head2 new
+
+Creates a new SearchBuilder object and immediately calls C<_Init> with the same parameters
+that were passed to C<new>. If you haven't overridden C<_Init> in your subclass, this means
+that you should pass in a C<Jifty::DBI::Handle> (or one of its subclasses) like this:
+
+ my $sb = My::Jifty::DBI::Subclass->new( Handle => $handle );
+
+However, if your subclass overrides _Init you do not need to take a Handle argument, as long
+as your subclass returns an appropriate handle object from the C<_Handle> method. This is
+useful if you want all of your SearchBuilder objects to use a shared global handle and don't want
+to have to explicitly pass it in each time, for example.
+
+=cut
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = {};
+ bless( $self, $class );
+ $self->_Init(@_);
+ return ($self);
+}
+
+
+
+=head2 _Init
+
+This method is called by C<new> with whatever arguments were passed to C<new>.
+By default, it takes a C<Jifty::DBI::Handle> object as a C<Handle>
+argument, although this is not necessary if your subclass overrides C<_Handle>.
+
+=cut
+
+sub _Init {
+ my $self = shift;
+ my %args = ( Handle => undef,
+ @_ );
+ $self->_Handle( $args{'Handle'} );
+
+ $self->CleanSlate();
+}
+
+
+
+=head2 CleanSlate
+
+This completely erases all the data in the SearchBuilder object. It's
+useful if a subclass is doing funky stuff to keep track of a search and
+wants to reset the SearchBuilder data without losing its own data;
+it's probably cleaner to accomplish that in a different way, though.
+
+=cut
+
+sub CleanSlate {
+ my $self = shift;
+ $self->RedoSearch();
+ $self->{'itemscount'} = 0;
+ $self->{'tables'} = "";
+ $self->{'auxillary_tables'} = "";
+ $self->{'where_clause'} = "";
+ $self->{'limit_clause'} = "";
+ $self->{'order'} = "";
+ $self->{'alias_count'} = 0;
+ $self->{'first_row'} = 0;
+ $self->{'must_redo_search'} = 1;
+ $self->{'show_rows'} = 0;
+ @{ $self->{'aliases'} } = ();
+
+ delete $self->{$_} for qw(
+ items
+ left_joins
+ raw_rows
+ count_all
+ subclauses
+ restrictions
+ _open_parens
+ _close_parens
+ );
+
+ #we have no limit statements. DoSearch won't work.
+ $self->_isLimited(0);
+
+}
+
+
+
+=head2 _Handle [DBH]
+
+Get or set this object's Jifty::DBI::Handle object.
+
+=cut
+
+sub _Handle {
+ my $self = shift;
+ if (@_) {
+ $self->{'DBIxHandle'} = shift;
+ }
+ return ( $self->{'DBIxHandle'} );
+}
+
+
+
+=head2 _DoSearch
+
+This internal private method actually executes the search on the database;
+it is called automatically the first time that you actually need results
+(such as a call to C<Next>).
+
+=cut
+
+sub _DoSearch {
+ my $self = shift;
+
+ my $QueryString = $self->BuildSelectQuery();
+
+ # If we're about to redo the search, we need an empty set of items
+ delete $self->{'items'};
+
+ my $records = $self->_Handle->SimpleQuery($QueryString);
+ return 0 unless $records;
+
+ while ( my $row = $records->fetchrow_hashref() ) {
+ my $item = $self->NewItem();
+ $item->LoadFromHash($row);
+ $self->AddRecord($item);
+ }
+ return $self->_RecordCount if $records->err;
+
+ $self->{'must_redo_search'} = 0;
+
+ return $self->_RecordCount;
+}
+
+
+=head2 AddRecord RECORD
+
+Adds a record object to this collection.
+
+=cut
+
+sub AddRecord {
+ my $self = shift;
+ my $record = shift;
+ push @{$self->{'items'}}, $record;
+}
+
+=head2 _RecordCount
+
+This private internal method returns the number of Record objects saved
+as a result of the last query.
+
+=cut
+
+sub _RecordCount {
+ my $self = shift;
+ return 0 unless defined $self->{'items'};
+ return scalar @{ $self->{'items'} };
+}
+
+
+
+=head2 _DoCount
+
+This internal private method actually executes a counting operation on the database;
+it is used by C<Count> and C<CountAll>.
+
+=cut
+
+
+sub _DoCount {
+ my $self = shift;
+ my $all = shift || 0;
+
+ my $QueryString = $self->BuildSelectCountQuery();
+ my $records = $self->_Handle->SimpleQuery($QueryString);
+ return 0 unless $records;
+
+ my @row = $records->fetchrow_array();
+ return 0 if $records->err;
+
+ $self->{ $all ? 'count_all' : 'raw_rows' } = $row[0];
+
+ return ( $row[0] );
+}
+
+
+
+=head2 _ApplyLimits STATEMENTREF
+
+This routine takes a reference to a scalar containing an SQL statement.
+It massages the statement to limit the returned rows to only C<< $self->RowsPerPage >>
+rows, skipping C<< $self->FirstRow >> rows. (That is, if rows are numbered
+starting from 0, row number C<< $self->FirstRow >> will be the first row returned.)
+Note that it probably makes no sense to set these variables unless you are also
+enforcing an ordering on the rows (with C<OrderByCols>, say).
+
+=cut
+
+
+sub _ApplyLimits {
+ my $self = shift;
+ my $statementref = shift;
+ $self->_Handle->ApplyLimits($statementref, $self->RowsPerPage, $self->FirstRow);
+ $$statementref =~ s/main\.\*/join(', ', @{$self->{columns}})/eg
+ if $self->{columns} and @{$self->{columns}};
+}
+
+
+=head2 _DistinctQuery STATEMENTREF
+
+This routine takes a reference to a scalar containing an SQL statement.
+It massages the statement to ensure a distinct result set is returned.
+
+
+=cut
+
+sub _DistinctQuery {
+ my $self = shift;
+ my $statementref = shift;
+ my $table = shift;
+
+ # XXX - Postgres gets unhappy with distinct and OrderBy aliases
+ if (exists $self->{'order_clause'} && $self->{'order_clause'} =~ /(?<!main)\./) {
+ $$statementref = "SELECT main.* FROM $$statementref";
+ }
+ else {
+ $self->_Handle->DistinctQuery($statementref, $table)
+ }
+}
+
+
+
+=head2 _BuildJoins
+
+Build up all of the joins we need to perform this query.
+
+=cut
+
+
+sub _BuildJoins {
+ my $self = shift;
+
+ return ( $self->_Handle->_BuildJoins($self) );
+
+}
+
+
+=head2 _isJoined
+
+Returns true if this SearchBuilder will be joining multiple tables together.
+
+=cut
+
+sub _isJoined {
+ my $self = shift;
+ if (keys(%{$self->{'left_joins'}})) {
+ return(1);
+ } else {
+ return(@{$self->{'aliases'}});
+ }
+
+}
+
+
+
+
+# LIMIT clauses are used for restricting ourselves to subsets of the search.
+
+
+
+sub _LimitClause {
+ my $self = shift;
+ my $limit_clause;
+
+ if ( $self->RowsPerPage ) {
+ $limit_clause = " LIMIT ";
+ if ( $self->FirstRow != 0 ) {
+ $limit_clause .= $self->FirstRow . ", ";
+ }
+ $limit_clause .= $self->RowsPerPage;
+ }
+ else {
+ $limit_clause = "";
+ }
+ return $limit_clause;
+}
+
+
+
+=head2 _isLimited
+
+If we've limited down this search, return true. Otherwise, return false.
+
+=cut
+
+sub _isLimited {
+ my $self = shift;
+ if (@_) {
+ $self->{'is_limited'} = shift;
+ }
+ else {
+ return ( $self->{'is_limited'} );
+ }
+}
+
+
+
+
+=head2 BuildSelectQuery
+
+Builds a query string for a "SELECT rows from Tables" statement for this SearchBuilder object
+
+=cut
+
+sub BuildSelectQuery {
+ my $self = shift;
+
+ # The initial SELECT or SELECT DISTINCT is decided later
+
+ my $QueryString = $self->_BuildJoins . " ";
+ $QueryString .= $self->_WhereClause . " "
+ if ( $self->_isLimited > 0 );
+
+ # DISTINCT query only required for multi-table selects
+ if ($self->_isJoined) {
+ $self->_DistinctQuery(\$QueryString, $self->Table);
+ } else {
+ $QueryString = "SELECT main.* FROM $QueryString";
+ }
+
+ $QueryString .= ' ' . $self->_GroupClause . ' ';
+
+ $QueryString .= ' ' . $self->_OrderClause . ' ';
+
+ $self->_ApplyLimits(\$QueryString);
+
+ return($QueryString)
+
+}
+
+
+
+=head2 BuildSelectCountQuery
+
+Builds a SELECT statement to find the number of rows this SearchBuilder object would find.
+
+=cut
+
+sub BuildSelectCountQuery {
+ my $self = shift;
+
+ #TODO refactor DoSearch and DoCount such that we only have
+ # one place where we build most of the querystring
+ my $QueryString = $self->_BuildJoins . " ";
+
+ $QueryString .= $self->_WhereClause . " "
+ if ( $self->_isLimited > 0 );
+
+
+
+ # DISTINCT query only required for multi-table selects
+ if ($self->_isJoined) {
+ $QueryString = $self->_Handle->DistinctCount(\$QueryString);
+ } else {
+ $QueryString = "SELECT count(main.id) FROM " . $QueryString;
+ }
+
+ return ($QueryString);
+}
+
+
+
+
+=head2 Next
+
+Returns the next row from the set as an object of the type defined by sub NewItem.
+When the complete set has been iterated through, returns undef and resets the search
+such that the following call to Next will start over with the first item retrieved from the database.
+
+=cut
+
+
+
+sub Next {
+ my $self = shift;
+ my @row;
+
+ return (undef) unless ( $self->_isLimited );
+
+ $self->_DoSearch() if $self->{'must_redo_search'};
+
+ if ( $self->{'itemscount'} < $self->_RecordCount ) { #return the next item
+ my $item = ( $self->{'items'}[ $self->{'itemscount'} ] );
+ $self->{'itemscount'}++;
+ return ($item);
+ }
+ else { #we've gone through the whole list. reset the count.
+ $self->GotoFirstItem();
+ return (undef);
+ }
+}
+
+
+
+=head2 GotoFirstItem
+
+Starts the recordset counter over from the first item. The next time you call Next,
+you'll get the first item returned by the database, as if you'd just started iterating
+through the result set.
+
+=cut
+
+
+sub GotoFirstItem {
+ my $self = shift;
+ $self->GotoItem(0);
+}
+
+
+
+
+=head2 GotoItem
+
+Takes an integer, n.
+Sets the record counter to n. the next time you call Next,
+you'll get the nth item.
+
+=cut
+
+sub GotoItem {
+ my $self = shift;
+ my $item = shift;
+ $self->{'itemscount'} = $item;
+}
+
+
+
+=head2 First
+
+Returns the first item
+
+=cut
+
+sub First {
+ my $self = shift;
+ $self->GotoFirstItem();
+ return ( $self->Next );
+}
+
+
+
+=head2 Last
+
+Returns the last item
+
+=cut
+
+sub Last {
+ my $self = shift;
+ $self->GotoItem( ( $self->Count ) - 1 );
+ return ( $self->Next );
+}
+
+
+
+=head2 ItemsArrayRef
+
+Return a refernece to an array containing all objects found by this search.
+
+=cut
+
+sub ItemsArrayRef {
+ my $self = shift;
+
+ #If we're not limited, return an empty array
+ return [] unless $self->_isLimited;
+
+ #Do a search if we need to.
+ $self->_DoSearch() if $self->{'must_redo_search'};
+
+ #If we've got any items in the array, return them.
+ # Otherwise, return an empty array
+ return ( $self->{'items'} || [] );
+}
+
+
+
+
+=head2 NewItem
+
+NewItem must be subclassed. It is used by Jifty::DBI to create record
+objects for each row returned from the database.
+
+=cut
+
+sub NewItem {
+ my $self = shift;
+
+ die
+"Jifty::DBI needs to be subclassed. you can't use it directly.\n";
+}
+
+
+
+=head2 RedoSearch
+
+Takes no arguments. Tells Jifty::DBI that the next time it's asked
+for a record, it should requery the database
+
+=cut
+
+sub RedoSearch {
+ my $self = shift;
+ $self->{'must_redo_search'} = 1;
+}
+
+
+
+
+=head2 UnLimit
+
+UnLimit clears all restrictions and causes this object to return all
+rows in the primary table.
+
+=cut
+
+sub UnLimit {
+ my $self = shift;
+ $self->_isLimited(-1);
+}
+
+
+
+=head2 Limit
+
+Limit takes a hash of parameters with the following keys:
+
+=over 4
+
+=item TABLE
+
+Can be set to something different than this table if a join is
+wanted (that means we can't do recursive joins as for now).
+
+=item ALIAS
+
+Unless ALIAS is set, the join criterias will be taken from EXT_LINKFIELD
+and INT_LINKFIELD and added to the criterias. If ALIAS is set, new
+criterias about the foreign table will be added.
+
+=item FIELD
+
+Column to be checked against.
+
+=item VALUE
+
+Should always be set and will always be quoted.
+
+=item OPERATOR
+
+OPERATOR is the SQL operator to use for this phrase. Possible choices include:
+
+=over 4
+
+=item "="
+
+=item "!="
+
+=item "LIKE"
+
+In the case of LIKE, the string is surrounded in % signs. Yes. this is a bug.
+
+=item "NOT LIKE"
+
+=item "STARTSWITH"
+
+STARTSWITH is like LIKE, except it only appends a % at the end of the string
+
+=item "ENDSWITH"
+
+ENDSWITH is like LIKE, except it prepends a % to the beginning of the string
+
+=back
+
+=item ENTRYAGGREGATOR
+
+Can be AND or OR (or anything else valid to aggregate two clauses in SQL)
+
+=item CASESENSITIVE
+
+on some databases, such as postgres, setting CASESENSITIVE to 1 will make
+this search case sensitive
+
+=back
+
+=cut
+
+sub Limit {
+ my $self = shift;
+ my %args = (
+ TABLE => $self->Table,
+ FIELD => undef,
+ VALUE => undef,
+ ALIAS => undef,
+ QUOTEVALUE => 1,
+ ENTRYAGGREGATOR => 'or',
+ CASESENSITIVE => undef,
+ OPERATOR => '=',
+ SUBCLAUSE => undef,
+ LEFTJOIN => undef,
+ @_ # get the real argumentlist
+ );
+
+ my ($Alias);
+
+ #since we're changing the search criteria, we need to redo the search
+ $self->RedoSearch();
+
+ if ( $args{'FIELD'} ) {
+
+ #If it's a like, we supply the %s around the search term
+ if ( $args{'OPERATOR'} =~ /LIKE/i ) {
+ $args{'VALUE'} = "%" . $args{'VALUE'} . "%";
+ }
+ elsif ( $args{'OPERATOR'} =~ /STARTSWITH/i ) {
+ $args{'VALUE'} = $args{'VALUE'} . "%";
+ $args{'OPERATOR'} = "LIKE";
+ }
+ elsif ( $args{'OPERATOR'} =~ /ENDSWITH/i ) {
+ $args{'VALUE'} = "%" . $args{'VALUE'};
+ $args{'OPERATOR'} = "LIKE";
+ }
+
+ #if we're explicitly told not to to quote the value or
+ # we're doing an IS or IS NOT (null), don't quote the operator.
+
+ if ( $args{'QUOTEVALUE'} && $args{'OPERATOR'} !~ /IS/i ) {
+ my $tmp = $self->_Handle->dbh->quote( $args{'VALUE'} );
+
+ # Accomodate DBI drivers that don't understand UTF8
+ if ($] >= 5.007) {
+ require Encode;
+ if( Encode::is_utf8( $args{'VALUE'} ) ) {
+ Encode::_utf8_on( $tmp );
+ }
+ }
+ $args{'VALUE'} = $tmp;
+ }
+ }
+
+ $Alias = $self->_GenericRestriction(%args);
+
+ warn "No table alias set!"
+ unless $Alias;
+
+ # We're now limited. people can do searches.
+
+ $self->_isLimited(1);
+
+ if ( defined($Alias) ) {
+ return ($Alias);
+ }
+ else {
+ return (1);
+ }
+}
+
+
+
+=head2 ShowRestrictions
+
+Returns the current object's proposed WHERE clause.
+
+Deprecated.
+
+=cut
+
+sub ShowRestrictions {
+ my $self = shift;
+ $self->_CompileGenericRestrictions();
+ $self->_CompileSubClauses();
+ return ( $self->{'where_clause'} );
+
+}
+
+
+
+=head2 ImportRestrictions
+
+Replaces the current object's WHERE clause with the string passed as its argument.
+
+Deprecated
+
+=cut
+
+#import a restrictions clause
+sub ImportRestrictions {
+ my $self = shift;
+ $self->{'where_clause'} = shift;
+}
+
+
+
+sub _GenericRestriction {
+ my $self = shift;
+ my %args = ( TABLE => $self->Table,
+ FIELD => undef,
+ VALUE => undef,
+ ALIAS => undef,
+ LEFTJOIN => undef,
+ ENTRYAGGREGATOR => undef,
+ OPERATOR => '=',
+ SUBCLAUSE => undef,
+ CASESENSITIVE => undef,
+ QUOTEVALUE => undef,
+ @_ );
+
+ my ( $Clause, $QualifiedField );
+
+ #TODO: $args{'VALUE'} should take an array of values and generate
+ # the proper where clause.
+
+ #If we're performing a left join, we really want the alias to be the
+ #left join criterion.
+
+ if ( ( defined $args{'LEFTJOIN'} )
+ && ( !defined $args{'ALIAS'} ) ) {
+ $args{'ALIAS'} = $args{'LEFTJOIN'};
+ }
+
+ # {{{ if there's no alias set, we need to set it
+
+ unless ( $args{'ALIAS'} ) {
+
+ #if the table we're looking at is the same as the main table
+ if ( $args{'TABLE'} eq $self->Table ) {
+
+ # TODO this code assumes no self joins on that table.
+ # if someone can name a case where we'd want to do that,
+ # I'll change it.
+
+ $args{'ALIAS'} = 'main';
+ }
+
+ # {{{ if we're joining, we need to work out the table alias
+
+ else {
+ $args{'ALIAS'} = $self->NewAlias( $args{'TABLE'} );
+ }
+
+ # }}}
+ }
+
+ # }}}
+
+ # Set this to the name of the field and the alias, unless we've been
+ # handed a subclause name
+
+ $QualifiedField = $args{'ALIAS'} . "." . $args{'FIELD'};
+
+ if ( $args{'SUBCLAUSE'} ) {
+ $Clause = $args{'SUBCLAUSE'};
+ }
+ else {
+ $Clause = $QualifiedField;
+ }
+
+ print STDERR "$self->_GenericRestriction QualifiedField=$QualifiedField\n"
+ if ( $self->DEBUG );
+
+ my ($restriction);
+
+ # If we're trying to get a leftjoin restriction, lets set
+ # $restriction to point htere. otherwise, lets construct normally
+
+ if ( $args{'LEFTJOIN'} ) {
+ $restriction =
+ \$self->{'left_joins'}{ $args{'LEFTJOIN'} }{'criteria'}{"$Clause"};
+ }
+ else {
+ $restriction = \$self->{'restrictions'}{"$Clause"};
+ }
+
+ # If it's a new value or we're overwriting this sort of restriction,
+
+ if ( $self->_Handle->CaseSensitive && defined $args{'VALUE'} && $args{'VALUE'} ne '' && $args{'VALUE'} ne "''" && ($args{'OPERATOR'} !~/IS/ && $args{'VALUE'} !~ /^null$/i)) {
+
+ unless ( $args{'CASESENSITIVE'} || !$args{'QUOTEVALUE'} ) {
+ ( $QualifiedField, $args{'OPERATOR'}, $args{'VALUE'} ) =
+ $self->_Handle->_MakeClauseCaseInsensitive( $QualifiedField,
+ $args{'OPERATOR'}, $args{'VALUE'} );
+ }
+
+ }
+
+ my $clause = "($QualifiedField $args{'OPERATOR'} $args{'VALUE'})";
+
+ # Juju because this should come _AFTER_ the EA
+ my $prefix = "";
+ if ( $self->{_open_parens}{$Clause} ) {
+ $prefix = " ( " x $self->{_open_parens}{$Clause};
+ delete $self->{_open_parens}{$Clause};
+ }
+
+ if ( ( ( exists $args{'ENTRYAGGREGATOR'} )
+ and ( $args{'ENTRYAGGREGATOR'} || "" ) eq 'none' )
+ or ( !$$restriction )
+ ) {
+
+ $$restriction = $prefix . $clause;
+
+ }
+ else {
+ $$restriction .= $args{'ENTRYAGGREGATOR'} . $prefix . $clause;
+ }
+
+ return ( $args{'ALIAS'} );
+
+}
+
+
+sub _OpenParen {
+ my ( $self, $clause ) = @_;
+ $self->{_open_parens}{$clause}++;
+}
+
+# Immediate Action
+sub _CloseParen {
+ my ( $self, $clause ) = @_;
+ my $restriction = \$self->{'restrictions'}{"$clause"};
+ if ( !$$restriction ) {
+ $$restriction = " ) ";
+ }
+ else {
+ $$restriction .= " ) ";
+ }
+}
+
+
+sub _AddSubClause {
+ my $self = shift;
+ my $clauseid = shift;
+ my $subclause = shift;
+
+ $self->{'subclauses'}{"$clauseid"} = $subclause;
+
+}
+
+
+
+sub _WhereClause {
+ my $self = shift;
+ my ( $subclause, $where_clause );
+
+ #Go through all the generic restrictions and build up the "generic_restrictions" subclause
+ # That's the only one that SearchBuilder builds itself.
+ # Arguably, the abstraction should be better, but I don't really see where to put it.
+ $self->_CompileGenericRestrictions();
+
+ #Go through all restriction types. Build the where clause from the
+ #Various subclauses.
+ foreach $subclause ( keys %{ $self->{'subclauses'} } ) {
+ # Now, build up the where clause
+ if ( defined($where_clause) ) {
+ $where_clause .= " AND ";
+ }
+
+ warn "$self $subclause doesn't exist"
+ if ( !defined $self->{'subclauses'}{"$subclause"} );
+ $where_clause .= $self->{'subclauses'}{"$subclause"};
+ }
+
+ $where_clause = " WHERE " . $where_clause if ( $where_clause ne '' );
+
+ return ($where_clause);
+
+}
+
+
+
+#Compile the restrictions to a WHERE Clause
+
+sub _CompileGenericRestrictions {
+ my $self = shift;
+ my ($restriction);
+
+ delete $self->{'subclauses'}{'generic_restrictions'};
+
+ #Go through all the restrictions of this type. Buld up the generic subclause
+ foreach $restriction ( sort keys %{ $self->{'restrictions'} } ) {
+ if ( defined $self->{'subclauses'}{'generic_restrictions'} ) {
+ $self->{'subclauses'}{'generic_restrictions'} .= " AND ";
+ }
+ $self->{'subclauses'}{'generic_restrictions'} .=
+ "(" . $self->{'restrictions'}{"$restriction"} . ")";
+ }
+}
+
+
+
+
+
+=head2 Orderby PARAMHASH
+
+Orders the returned results by ALIAS.FIELD ORDER. (by default 'main.id ASC')
+
+Takes a paramhash of ALIAS, FIELD and ORDER.
+ALIAS defaults to main
+FIELD defaults to the primary key of the main table. Also accepts C<FUNCTION(FIELD)> format
+ORDER defaults to ASC(ending). DESC(ending) is also a valid value for OrderBy
+
+
+=cut
+
+sub OrderBy {
+ my $self = shift;
+ my %args = ( @_ );
+
+ $self->OrderByCols( \%args );
+}
+
+=head2 OrderByCols ARRAY
+
+OrderByCols takes an array of paramhashes of the form passed to OrderBy.
+The result set is ordered by the items in the array.
+
+=cut
+
+sub OrderByCols {
+ my $self = shift;
+ my @args = @_;
+ my $row;
+ my $clause;
+
+ foreach $row ( @args ) {
+
+ my %rowhash = ( ALIAS => 'main',
+ FIELD => undef,
+ ORDER => 'ASC',
+ %$row
+ );
+ if ($rowhash{'ORDER'} =~ /^des/i) {
+ $rowhash{'ORDER'} = "DESC";
+ }
+ else {
+ $rowhash{'ORDER'} = "ASC";
+ }
+
+ if ( ($rowhash{'ALIAS'}) and
+ ($rowhash{'FIELD'}) and
+ ($rowhash{'ORDER'}) ) {
+
+ if ($rowhash{'FIELD'} =~ /^(\w+\()(.*\))$/) {
+ # handle 'FUNCTION(FIELD)' formatted fields
+ $rowhash{'ALIAS'} = $1 . $rowhash{'ALIAS'};
+ $rowhash{'FIELD'} = $2;
+ }
+
+ $clause .= ($clause ? ", " : " ");
+ $clause .= $rowhash{'ALIAS'} . ".";
+ $clause .= $rowhash{'FIELD'} . " ";
+ $clause .= $rowhash{'ORDER'};
+ }
+ }
+
+ if ($clause) {
+ $self->{'order_clause'} = "ORDER BY" . $clause;
+ }
+ else {
+ $self->{'order_clause'} = "";
+ }
+ $self->RedoSearch();
+}
+
+
+
+=head2 _OrderClause
+
+returns the ORDER BY clause for the search.
+
+=cut
+
+sub _OrderClause {
+ my $self = shift;
+
+ return '' unless $self->{'order_clause'};
+ return ($self->{'order_clause'});
+}
+
+
+
+
+
+=head2 GroupBy (DEPRECATED)
+
+Alias for the GroupByCols method.
+
+=cut
+
+sub GroupBy { (shift)->GroupByCols( @_ ) }
+
+
+
+=head2 GroupByCols ARRAY_OF_HASHES
+
+Each hash contains the keys ALIAS and FIELD. ALIAS defaults to 'main' if ignored.
+
+=cut
+
+sub GroupByCols {
+ my $self = shift;
+ my @args = @_;
+ my $row;
+ my $clause;
+
+ foreach $row ( @args ) {
+ my %rowhash = ( ALIAS => 'main',
+ FIELD => undef,
+ %$row
+ );
+ if ($rowhash{'FUNCTION'} ) {
+ $clause .= ($clause ? ", " : " ");
+ $clause .= $rowhash{'FUNCTION'};
+
+ }
+ elsif ( ($rowhash{'ALIAS'}) and
+ ($rowhash{'FIELD'}) ) {
+
+ $clause .= ($clause ? ", " : " ");
+ $clause .= $rowhash{'ALIAS'} . ".";
+ $clause .= $rowhash{'FIELD'};
+ }
+ }
+
+ if ($clause) {
+ $self->{'group_clause'} = "GROUP BY" . $clause;
+ }
+ else {
+ $self->{'group_clause'} = "";
+ }
+ $self->RedoSearch();
+}
+
+
+=head2 _GroupClause
+
+Private function to return the "GROUP BY" clause for this query.
+
+=cut
+
+sub _GroupClause {
+ my $self = shift;
+
+ return '' unless $self->{'group_clause'};
+ return ($self->{'group_clause'});
+}
+
+
+
+
+
+=head2 NewAlias
+
+Takes the name of a table.
+Returns the string of a new Alias for that table, which can be used to Join tables
+or to Limit what gets found by a search.
+
+=cut
+
+sub NewAlias {
+ my $self = shift;
+ my $table = shift || die "Missing parameter";
+
+ my $alias = $self->_GetAlias($table);
+
+ my $subclause = "$table $alias";
+
+ push ( @{ $self->{'aliases'} }, $subclause );
+
+ return $alias;
+}
+
+
+
+# _GetAlias is a private function which takes an tablename and
+# returns a new alias for that table without adding something
+# to self->{'aliases'}. This function is used by NewAlias
+# and the as-yet-unnamed left join code
+
+sub _GetAlias {
+ my $self = shift;
+ my $table = shift;
+
+ $self->{'alias_count'}++;
+ my $alias = $table . "_" . $self->{'alias_count'};
+
+ return ($alias);
+
+}
+
+
+
+=head2 Join
+
+Join instructs Jifty::DBI to join two tables.
+
+The standard form takes a param hash with keys ALIAS1, FIELD1, ALIAS2 and
+FIELD2. ALIAS1 and ALIAS2 are column aliases obtained from $self->NewAlias or
+a $self->Limit. FIELD1 and FIELD2 are the fields in ALIAS1 and ALIAS2 that
+should be linked, respectively. For this type of join, this method
+has no return value.
+
+Supplying the parameter TYPE => 'left' causes Join to preform a left join.
+in this case, it takes ALIAS1, FIELD1, TABLE2 and FIELD2. Because of the way
+that left joins work, this method needs a TABLE for the second field
+rather than merely an alias. For this type of join, it will return
+the alias generated by the join.
+
+Instead of ALIAS1/FIELD1, it's possible to specify EXPRESSION, to join ALIAS2/TABLE2 on an arbitrary expression.
+
+=cut
+
+sub Join {
+ my $self = shift;
+ my %args = (
+ TYPE => 'normal',
+ FIELD1 => undef,
+ ALIAS1 => 'main',
+ TABLE2 => undef,
+ FIELD2 => undef,
+ ALIAS2 => undef,
+ @_
+ );
+
+ $self->_Handle->Join( SearchBuilder => $self, %args );
+
+}
+
+
+
+
+
+sub NextPage {
+ my $self = shift;
+ $self->FirstRow( $self->FirstRow + $self->RowsPerPage );
+}
+
+
+sub FirstPage {
+ my $self = shift;
+ $self->FirstRow(1);
+}
+
+
+
+
+
+sub PrevPage {
+ my $self = shift;
+ if ( ( $self->FirstRow - $self->RowsPerPage ) > 1 ) {
+ $self->FirstRow( $self->FirstRow - $self->RowsPerPage );
+ }
+ else {
+ $self->FirstRow(1);
+ }
+}
+
+
+
+sub GotoPage {
+ my $self = shift;
+ my $page = shift;
+
+ if ( $self->RowsPerPage ) {
+ $self->FirstRow( 1 + ( $self->RowsPerPage * $page ) );
+ } else {
+ $self->FirstRow(1);
+ }
+}
+
+
+
+=head2 RowsPerPage
+
+Limits the number of rows returned by the database.
+Optionally, takes an integer which restricts the # of rows returned in a result
+Returns the number of rows the database should display.
+
+=cut
+
+sub RowsPerPage {
+ my $self = shift;
+ $self->{'show_rows'} = shift if (@_);
+
+ return ( $self->{'show_rows'} );
+}
+
+
+
+=head2 FirstRow
+
+Get or set the first row of the result set the database should return.
+Takes an optional single integer argrument. Returns the currently set integer
+first row that the database should return.
+
+
+=cut
+
+# returns the first row
+sub FirstRow {
+ my $self = shift;
+ if (@_) {
+ $self->{'first_row'} = shift;
+
+ #SQL starts counting at 0
+ $self->{'first_row'}--;
+
+ #gotta redo the search if changing pages
+ $self->RedoSearch();
+ }
+ return ( $self->{'first_row'} );
+}
+
+
+
+
+
+=head2 _ItemsCounter
+
+Returns the current position in the record set.
+
+=cut
+
+sub _ItemsCounter {
+ my $self = shift;
+ return $self->{'itemscount'};
+}
+
+
+
+=head2 Count
+
+Returns the number of records in the set.
+
+=cut
+
+
+
+sub Count {
+ my $self = shift;
+
+ # An unlimited search returns no tickets
+ return 0 unless ($self->_isLimited);
+
+
+ # If we haven't actually got all objects loaded in memory, we
+ # really just want to do a quick count from the database.
+ if ( $self->{'must_redo_search'} ) {
+
+ # If we haven't already asked the database for the row count, do that
+ $self->_DoCount unless ( $self->{'raw_rows'} );
+
+ #Report back the raw # of rows in the database
+ return ( $self->{'raw_rows'} );
+ }
+
+ # If we have loaded everything from the DB we have an
+ # accurate count already.
+ else {
+ return $self->_RecordCount;
+ }
+}
+
+
+
+=head2 CountAll
+
+Returns the total number of potential records in the set, ignoring any
+LimitClause.
+
+=cut
+
+# 22:24 [Robrt(500 at outer.space)] It has to do with Caching.
+# 22:25 [Robrt(500 at outer.space)] The documentation says it ignores the limit.
+# 22:25 [Robrt(500 at outer.space)] But I don't believe thats true.
+# 22:26 [msg(Robrt)] yeah. I
+# 22:26 [msg(Robrt)] yeah. I'm not convinced it does anything useful right now
+# 22:26 [msg(Robrt)] especially since until a week ago, it was setting one variable and returning another
+# 22:27 [Robrt(500 at outer.space)] I remember.
+# 22:27 [Robrt(500 at outer.space)] It had to do with which Cached value was returned.
+# 22:27 [msg(Robrt)] (given that every time we try to explain it, we get it Wrong)
+# 22:27 [Robrt(500 at outer.space)] Because Count can return a different number than actual NumberOfResults
+# 22:28 [msg(Robrt)] in what case?
+# 22:28 [Robrt(500 at outer.space)] CountAll _always_ used the return value of _DoCount(), as opposed to Count which would return the cached number of
+# results returned.
+# 22:28 [Robrt(500 at outer.space)] IIRC, if you do a search with a Limit, then raw_rows will == Limit.
+# 22:31 [msg(Robrt)] ah.
+# 22:31 [msg(Robrt)] that actually makes sense
+# 22:31 [Robrt(500 at outer.space)] You should paste this conversation into the CountAll docs.
+# 22:31 [msg(Robrt)] perhaps I'll create a new method that _actually_ do that.
+# 22:32 [msg(Robrt)] since I'm not convinced it's been doing that correctly
+
+
+sub CountAll {
+ my $self = shift;
+
+ # An unlimited search returns no tickets
+ return 0 unless ($self->_isLimited);
+
+ # If we haven't actually got all objects loaded in memory, we
+ # really just want to do a quick count from the database.
+ if ( $self->{'must_redo_search'} || !$self->{'count_all'}) {
+ # If we haven't already asked the database for the row count, do that
+ $self->_DoCount(1) unless ( $self->{'count_all'} );
+
+ #Report back the raw # of rows in the database
+ return ( $self->{'count_all'} );
+ }
+
+ # If we have loaded everything from the DB we have an
+ # accurate count already.
+ else {
+ return $self->_RecordCount;
+ }
+}
+
+
+
+
+=head2 IsLast
+
+Returns true if the current row is the last record in the set.
+
+=cut
+
+sub IsLast {
+ my $self = shift;
+
+ return undef unless $self->Count;
+
+ if ( $self->_ItemsCounter == $self->Count ) {
+ return (1);
+ }
+ else {
+ return (0);
+ }
+}
+
+
+
+sub DEBUG {
+ my $self = shift;
+ if (@_) {
+ $self->{'DEBUG'} = shift;
+ }
+ return ( $self->{'DEBUG'} );
+}
+
+
+
+
+
+
+
+=head2 Column { FIELD => undef }
+
+Specify that we want to load the column FIELD.
+
+Other parameters are TABLE ALIAS AND FUNCTION.
+
+Autrijus and Ruslan owe docs.
+
+=cut
+
+sub Column {
+ my $self = shift;
+ my %args = ( TABLE => undef,
+ ALIAS => undef,
+ FIELD => undef,
+ FUNCTION => undef,
+ @_);
+
+ my $table = $args{TABLE} || do {
+ if ( my $alias = $args{ALIAS} ) {
+ $alias =~ s/_\d+$//;
+ $alias;
+ }
+ else {
+ $self->Table;
+ }
+ };
+
+ my $name = ( $args{ALIAS} || 'main' ) . '.' . $args{FIELD};
+ if ( my $func = $args{FUNCTION} ) {
+ if ( $func =~ /^DISTINCT\s*COUNT$/i ) {
+ $name = "COUNT(DISTINCT $name)";
+ }
+ # If we want to substitute
+ elsif ($func =~ /\?/) {
+ $name = join($name,split(/\?/,$func));
+ }
+ # If we want to call a simple function on the column
+ elsif ($func !~ /\(/) {
+ $name = "\U$func\E($name)";
+ } else {
+ $name = $func;
+ }
+
+ }
+
+ my $column = "col" . @{ $self->{columns} ||= [] };
+ $column = $args{FIELD} if $table eq $self->Table and !$args{ALIAS};
+ push @{ $self->{columns} }, "$name AS \L$column";
+ return $column;
+}
+
+
+
+
+=head2 Columns LIST
+
+Specify that we want to load only the columns in LIST
+
+=cut
+
+sub Columns {
+ my $self = shift;
+ $self->Column( FIELD => $_ ) for @_;
+}
+
+
+
+=head2 Fields TABLE
+
+Return a list of fields in TABLE, lowercased.
+
+TODO: Why are they lowercased?
+
+=cut
+
+sub Fields {
+ my $self = shift;
+ my $table = shift;
+
+ my $dbh = $self->_Handle->dbh;
+
+ # TODO: memoize this
+
+ return map lc( $_->[0] ), @{
+ eval {
+ $dbh->column_info( '', '', $table, '' )->fetchall_arrayref( [3] );
+ }
+ || $dbh->selectall_arrayref("DESCRIBE $table;")
+ || $dbh->selectall_arrayref("DESCRIBE \u$table;")
+ || []
+ };
+}
+
+
+
+
+=head2 HasField { TABLE => undef, FIELD => undef }
+
+Returns true if TABLE has field FIELD.
+Return false otherwise
+
+=cut
+
+sub HasField {
+ my $self = shift;
+ my %args = ( FIELD => undef,
+ TABLE => undef,
+ @_);
+
+ my $table = $args{TABLE} or die;
+ my $field = $args{FIELD} or die;
+ return grep { $_ eq $field } $self->Fields($table);
+}
+
+
+
+=head2 Table [TABLE]
+
+If called with an argument, sets this collection's table.
+
+Always returns this collection's table.
+
+=cut
+
+sub SetTable {
+ my $self = shift;
+ return $self->Table(@_);
+}
+
+sub Table {
+ my $self = shift;
+ $self->{table} = shift if (@_);
+ return $self->{table};
+}
+
+
+if( eval { require capitalization } ) {
+ capitalization->unimport( __PACKAGE__ );
+}
+
+1;
+__END__
+
+
+
+=head1 TESTING
+
+In order to test most of the features of C<Jifty::DBI>, you need
+to provide C<make test> with a test database. For each DBI driver that you
+would like to test, set the environment variables C<SB_TEST_FOO>, C<SB_TEST_FOO_USER>,
+and C<SB_TEST_FOO_PASS> to a database name, database username, and database password,
+where "FOO" is the driver name in all uppercase. You can test as many drivers
+as you like. (The appropriate C<DBD::> module needs to be installed in order for
+the test to work.) Note that the C<SQLite> driver will automatically be tested if C<DBD::Sqlite>
+is installed, using a temporary file as the database. For example:
+
+ SB_TEST_MYSQL=test SB_TEST_MYSQL_USER=root SB_TEST_MYSQL_PASS=foo \
+ SB_TEST_PG=test SB_TEST_PG_USER=postgres make test
+
+
+=head1 AUTHOR
+
+Copyright (c) 2001-2005 Jesse Vincent, jesse at fsck.com.
+
+All rights reserved.
+
+This library is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+
+=head1 SEE ALSO
+
+Jifty::DBI::Handle, Jifty::DBI::Record.
+
+=cut
+
+
+
+
Added: Jifty-DBI/trunk/lib/Jifty/DBI/Handle.pm
==============================================================================
--- (empty file)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Handle.pm Sun Jul 24 21:04:49 2005
@@ -0,0 +1,1062 @@
+# $Header: /home/jesse/DBIx-SearchBuilder/history/SearchBuilder/Handle.pm,v 1.21 2002/01/28 06:11:37 jesse Exp $
+package Jifty::DBI::Handle;
+use strict;
+use Carp;
+use DBI;
+use Class::ReturnValue;
+use Encode;
+
+use vars qw($VERSION @ISA %DBIHandle $PrevHandle $DEBUG $TRANSDEPTH);
+
+$TRANSDEPTH = 0;
+
+$VERSION = '$Version$';
+
+
+
+=head1 NAME
+
+Jifty::DBI::Handle - Perl extension which is a generic DBI handle
+
+=head1 SYNOPSIS
+
+ use Jifty::DBI::Handle;
+
+ my $handle = Jifty::DBI::Handle->new();
+ $handle->Connect( Driver => 'mysql',
+ Database => 'dbname',
+ Host => 'hostname',
+ User => 'dbuser',
+ Password => 'dbpassword');
+ # now $handle isa Jifty::DBI::Handle::mysql
+
+=head1 DESCRIPTION
+
+This class provides a wrapper for DBI handles that can also perform a number of additional functions.
+
+=cut
+
+
+
+=head2 new
+
+Generic constructor
+
+=cut
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $self = {};
+ bless ($self, $class);
+
+ @{$self->{'StatementLog'}} = ();
+ return $self;
+}
+
+
+
+=head2 Connect PARAMHASH: Driver, Database, Host, User, Password
+
+Takes a paramhash and connects to your DBI datasource.
+
+You should _always_ set
+
+ DisconnectHandleOnDestroy => 1
+
+unless you have a legacy app like RT2 or RT 3.0.{0,1,2} that depends on the broken behaviour.
+
+If you created the handle with
+ Jifty::DBI::Handle->new
+and there is a Jifty::DBI::Handle::(Driver) subclass for the driver you have chosen,
+the handle will be automatically "upgraded" into that subclass.
+
+=cut
+
+sub Connect {
+ my $self = shift;
+
+ my %args = ( Driver => undef,
+ Database => undef,
+ Host => undef,
+ SID => undef,
+ Port => undef,
+ User => undef,
+ Password => undef,
+ RequireSSL => undef,
+ DisconnectHandleOnDestroy => undef,
+ @_);
+
+ if( $args{'Driver'} && !$self->isa( 'Jifty::DBI::Handle::'. $args{'Driver'} ) ) {
+ if ( $self->_UpgradeHandle($args{Driver}) ) {
+ return ($self->Connect( %args ));
+ }
+ }
+
+
+ my $dsn = $self->DSN || '';
+
+ # Setting this actually breaks old RT versions in subtle ways. So we need to explicitly call it
+
+ $self->{'DisconnectHandleOnDestroy'} = $args{'DisconnectHandleOnDestroy'};
+
+
+ $self->BuildDSN(%args);
+
+ # Only connect if we're not connected to this source already
+ if ((! $self->dbh ) || (!$self->dbh->ping) || ($self->DSN ne $dsn) ) {
+ my $handle = DBI->connect($self->DSN, $args{'User'}, $args{'Password'}) || croak "Connect Failed $DBI::errstr\n" ;
+
+ #databases do case conversion on the name of columns returned.
+ #actually, some databases just ignore case. this smashes it to something consistent
+ $handle->{FetchHashKeyName} ='NAME_lc';
+
+ #Set the handle
+ $self->dbh($handle);
+
+ return (1);
+ }
+
+ return(undef);
+
+}
+
+
+=head2 _UpgradeHandle DRIVER
+
+This private internal method turns a plain Jifty::DBI::Handle into one
+of the standard driver-specific subclasses.
+
+=cut
+
+sub _UpgradeHandle {
+ my $self = shift;
+
+ my $driver = shift;
+ my $class = 'Jifty::DBI::Handle::' . $driver;
+ eval "require $class";
+ return if $@;
+
+ bless $self, $class;
+ return 1;
+}
+
+
+
+
+=head2 BuildDSN PARAMHASH
+
+Takes a bunch of parameters:
+
+Required: Driver, Database,
+Optional: Host, Port and RequireSSL
+
+Builds a DSN suitable for a DBI connection
+
+=cut
+
+sub BuildDSN {
+ my $self = shift;
+ my %args = ( Driver => undef,
+ Database => undef,
+ Host => undef,
+ Port => undef,
+ SID => undef,
+ RequireSSL => undef,
+ @_);
+
+
+ my $dsn = "dbi:$args{'Driver'}:dbname=$args{'Database'}";
+ $dsn .= ";sid=$args{'SID'}" if ( defined $args{'SID'} && $args{'SID'});
+ $dsn .= ";host=$args{'Host'}" if (defined$args{'Host'} && $args{'Host'});
+ $dsn .= ";port=$args{'Port'}" if (defined $args{'Port'} && $args{'Port'});
+ $dsn .= ";requiressl=1" if (defined $args{'RequireSSL'} && $args{'RequireSSL'});
+
+ $self->{'dsn'}= $dsn;
+}
+
+
+
+=head2 DSN
+
+ Returns the DSN for this database connection.
+
+=cut
+sub DSN {
+ my $self = shift;
+ return($self->{'dsn'});
+}
+
+
+
+=head2 RaiseError [MODE]
+
+Turns on the Database Handle's RaiseError attribute.
+
+=cut
+
+sub RaiseError {
+ my $self = shift;
+
+ my $mode = 1;
+ $mode = shift if (@_);
+
+ $self->dbh->{RaiseError}=$mode;
+}
+
+
+
+
+=head2 PrintError [MODE]
+
+Turns on the Database Handle's PrintError attribute.
+
+=cut
+
+sub PrintError {
+ my $self = shift;
+
+ my $mode = 1;
+ $mode = shift if (@_);
+
+ $self->dbh->{PrintError}=$mode;
+}
+
+
+
+=head2 LogSQLStatements BOOL
+
+Takes a boolean argument. If the boolean is true, SearchBuilder will log all SQL
+statements, as well as their invocation times and execution times.
+
+Returns whether we're currently logging or not as a boolean
+
+=cut
+
+sub LogSQLStatements {
+ my $self = shift;
+ if (@_) {
+
+ require Time::HiRes;
+ $self->{'_DoLogSQL'} = shift;
+ return ($self->{'_DoLogSQL'});
+ }
+}
+
+=head2 _LogSQLStatement STATEMENT DURATION
+
+add an SQL statement to our query log
+
+=cut
+
+sub _LogSQLStatement {
+ my $self = shift;
+ my $statement = shift;
+ my $duration = shift;
+ push @{$self->{'StatementLog'}} , ([Time::Hires::time(), $statement, $duration]);
+
+}
+
+=head2 ClearSQLStatementLog
+
+Clears out the SQL statement log.
+
+
+=cut
+
+sub ClearSQLStatementLog {
+ my $self = shift;
+ @{$self->{'StatementLog'}} = ();
+}
+
+
+=head2 SQLStatementLog
+
+Returns the current SQL statement log as an array of arrays. Each entry is a triple of
+
+(Time, Statement, Duration)
+
+=cut
+
+sub SQLStatementLog {
+ my $self = shift;
+ return (@{$self->{'StatementLog'}});
+
+}
+
+
+
+=head2 AutoCommit [MODE]
+
+Turns on the Database Handle's AutoCommit attribute.
+
+=cut
+
+sub AutoCommit {
+ my $self = shift;
+
+ my $mode = 1;
+ $mode = shift if (@_);
+
+ $self->dbh->{AutoCommit}=$mode;
+}
+
+
+
+
+=head2 Disconnect
+
+Disconnect from your DBI datasource
+
+=cut
+
+sub Disconnect {
+ my $self = shift;
+ if ($self->dbh) {
+ return ($self->dbh->disconnect());
+ } else {
+ return;
+ }
+}
+
+
+
+=head2 dbh [HANDLE]
+
+Return the current DBI handle. If we're handed a parameter, make the database handle that.
+
+=cut
+
+# allow use of Handle as a synonym for DBH
+*Handle=\&dbh;
+
+sub dbh {
+ my $self=shift;
+
+ #If we are setting the database handle, set it.
+ $DBIHandle{$self} = $PrevHandle = shift if (@_);
+
+ return($DBIHandle{$self} ||= $PrevHandle);
+}
+
+
+=head2 Insert $TABLE_NAME @KEY_VALUE_PAIRS
+
+Takes a table name and a set of key-value pairs in an array. splits the key value pairs, constructs an INSERT statement and performs the insert. Returns the row_id of this row.
+
+=cut
+
+sub Insert {
+ my($self, $table, @pairs) = @_;
+ my(@cols, @vals, @bind);
+
+ #my %seen; #only the *first* value is used - allows drivers to specify default
+ while ( my $key = shift @pairs ) {
+ my $value = shift @pairs;
+ # next if $seen{$key}++;
+ push @cols, $key;
+ push @vals, '?';
+ push @bind, $value;
+ }
+
+ my $QueryString =
+ "INSERT INTO $table (". join(", ", @cols). ") VALUES ".
+ "(". join(", ", @vals). ")";
+
+ my $sth = $self->SimpleQuery($QueryString, @bind);
+ return ($sth);
+ }
+
+
+=head2 UpdateRecordValue
+
+Takes a hash with fields: Table, Column, Value PrimaryKeys, and
+IsSQLFunction. Table, and Column should be obvious, Value is where you
+set the new value you want the column to have. The primary_keys field should
+be the lvalue of Jifty::DBI::Record::PrimaryKeys(). Finally
+IsSQLFunction is set when the Value is a SQL function. For example, you
+might have ('Value'=>'PASSWORD(string)'), by setting IsSQLFunction that
+string will be inserted into the query directly rather then as a binding.
+
+=cut
+
+sub UpdateRecordValue {
+ my $self = shift;
+ my %args = ( Table => undef,
+ Column => undef,
+ IsSQLFunction => undef,
+ PrimaryKeys => undef,
+ @_ );
+
+ my @bind = ();
+ my $query = 'UPDATE ' . $args{'Table'} . ' ';
+ $query .= 'SET ' . $args{'Column'} . '=';
+
+ ## Look and see if the field is being updated via a SQL function.
+ if ($args{'IsSQLFunction'}) {
+ $query .= $args{'Value'} . ' ';
+ }
+ else {
+ $query .= '? ';
+ push (@bind, $args{'Value'});
+ }
+
+ ## Constructs the where clause.
+ my $where = 'WHERE ';
+ foreach my $key (keys %{$args{'PrimaryKeys'}}) {
+ $where .= $key . "=?" . " AND ";
+ push (@bind, $args{'PrimaryKeys'}{$key});
+ }
+ $where =~ s/AND\s$//;
+
+ my $query_str = $query . $where;
+ return ($self->SimpleQuery($query_str, @bind));
+}
+
+
+
+
+=head2 UpdateTableValue TABLE COLUMN NEW_VALUE RECORD_ID IS_SQL
+
+Update column COLUMN of table TABLE where the record id = RECORD_ID. if IS_SQL is set,
+don\'t quote the NEW_VALUE
+
+=cut
+
+sub UpdateTableValue {
+ my $self = shift;
+
+ ## This is just a wrapper to UpdateRecordValue().
+ my %args = ();
+ $args{'Table'} = shift;
+ $args{'Column'} = shift;
+ $args{'Value'} = shift;
+ $args{'PrimaryKeys'} = shift;
+ $args{'IsSQLFunction'} = shift;
+
+ return $self->UpdateRecordValue(%args)
+}
+
+
+=head2 SimpleQuery QUERY_STRING, [ BIND_VALUE, ... ]
+
+Execute the SQL string specified in QUERY_STRING
+
+=cut
+
+sub SimpleQuery {
+ my $self = shift;
+ my $QueryString = shift;
+ my @bind_values;
+ @bind_values = (@_) if (@_);
+
+ my $sth = $self->dbh->prepare($QueryString);
+ unless ($sth) {
+ if ($DEBUG) {
+ die "$self couldn't prepare the query '$QueryString'"
+ . $self->dbh->errstr . "\n";
+ }
+ else {
+ warn "$self couldn't prepare the query '$QueryString'"
+ . $self->dbh->errstr . "\n";
+ my $ret = Class::ReturnValue->new();
+ $ret->as_error(
+ errno => '-1',
+ message => "Couldn't prepare the query '$QueryString'."
+ . $self->dbh->errstr,
+ do_backtrace => undef
+ );
+ return ( $ret->return_value );
+ }
+ }
+
+ # Check @bind_values for HASH refs
+ for ( my $bind_idx = 0 ; $bind_idx < scalar @bind_values ; $bind_idx++ ) {
+ if ( ref( $bind_values[$bind_idx] ) eq "HASH" ) {
+ my $bhash = $bind_values[$bind_idx];
+ $bind_values[$bind_idx] = $bhash->{'value'};
+ delete $bhash->{'value'};
+ $sth->bind_param( $bind_idx + 1, undef, $bhash );
+ }
+ # Some databases, such as Oracle fail to cope if it's a perl utf8
+ # string. they desperately want bytes.
+ Encode::_utf8_off($bind_values[$bind_idx]);
+ }
+
+ my $basetime;
+ if ( $self->LogSQLStatements ) {
+ $basetime = Time::HiRes::time();
+ }
+ my $executed;
+ {
+ no warnings 'uninitialized' ; # undef in bind_values makes DBI sad
+ eval { $executed = $sth->execute(@bind_values) };
+ }
+ if ( $self->LogSQLStatements ) {
+ $self->_LogSQLStatement( $QueryString, tv_interval($basetime) );
+
+ }
+
+ if ( $@ or !$executed ) {
+ if ($DEBUG) {
+ die "$self couldn't execute the query '$QueryString'"
+ . $self->dbh->errstr . "\n";
+
+ }
+ else {
+ warn "$self couldn't execute the query '$QueryString'";
+
+ my $ret = Class::ReturnValue->new();
+ $ret->as_error(
+ errno => '-1',
+ message => "Couldn't execute the query '$QueryString'"
+ . $self->dbh->errstr,
+ do_backtrace => undef
+ );
+ return ( $ret->return_value );
+ }
+
+ }
+ return ($sth);
+
+}
+
+
+
+=head2 FetchResult QUERY, [ BIND_VALUE, ... ]
+
+Takes a SELECT query as a string, along with an array of BIND_VALUEs
+If the select succeeds, returns the first row as an array.
+Otherwise, returns a Class::ResturnValue object with the failure loaded
+up.
+
+=cut
+
+sub FetchResult {
+ my $self = shift;
+ my $query = shift;
+ my @bind_values = @_;
+ my $sth = $self->SimpleQuery($query, @bind_values);
+ if ($sth) {
+ return ($sth->fetchrow);
+ }
+ else {
+ return($sth);
+ }
+}
+
+
+=head2 BinarySafeBLOBs
+
+Returns 1 if the current database supports BLOBs with embedded nulls.
+Returns undef if the current database doesn't support BLOBs with embedded nulls
+
+=cut
+
+sub BinarySafeBLOBs {
+ my $self = shift;
+ return(1);
+}
+
+
+
+=head2 KnowsBLOBs
+
+Returns 1 if the current database supports inserts of BLOBs automatically.
+Returns undef if the current database must be informed of BLOBs for inserts.
+
+=cut
+
+sub KnowsBLOBs {
+ my $self = shift;
+ return(1);
+}
+
+
+
+=head2 BLOBParams FIELD_NAME FIELD_TYPE
+
+Returns a hash ref for the bind_param call to identify BLOB types used by
+the current database for a particular column type.
+
+=cut
+
+sub BLOBParams {
+ my $self = shift;
+ # Don't assign to key 'value' as it is defined later.
+ return ( {} );
+}
+
+
+
+=head2 DatabaseVersion
+
+Returns the database's version. The base implementation uses a "SELECT VERSION"
+
+=cut
+
+sub DatabaseVersion {
+ my $self = shift;
+
+ unless ($self->{'database_version'}) {
+ my $statement = "SELECT VERSION()";
+ my $sth = $self->SimpleQuery($statement);
+ my @vals = $sth->fetchrow();
+ $self->{'database_version'}= $vals[0];
+ }
+}
+
+
+=head2 CaseSensitive
+
+Returns 1 if the current database's searches are case sensitive by default
+Returns undef otherwise
+
+=cut
+
+sub CaseSensitive {
+ my $self = shift;
+ return(1);
+}
+
+
+
+
+
+=head2 _MakeClauseCaseInsensitive FIELD OPERATOR VALUE
+
+Takes a field, operator and value. performs the magic necessary to make
+your database treat this clause as case insensitive.
+
+Returns a FIELD OPERATOR VALUE triple.
+
+=cut
+
+sub _MakeClauseCaseInsensitive {
+ my $self = shift;
+ my $field = shift;
+ my $operator = shift;
+ my $value = shift;
+
+ if ($value !~ /^\d+$/) { # don't downcase integer values
+ $field = "lower($field)";
+ $value = lc($value);
+ }
+ return ($field, $operator, $value,undef);
+}
+
+
+
+
+=head2 BeginTransaction
+
+Tells Jifty::DBI to begin a new SQL transaction. This will
+temporarily suspend Autocommit mode.
+
+Emulates nested transactions, by keeping a transaction stack depth.
+
+=cut
+
+sub BeginTransaction {
+ my $self = shift;
+ $TRANSDEPTH++;
+ if ($TRANSDEPTH > 1 ) {
+ return ($TRANSDEPTH);
+ } else {
+ return($self->dbh->begin_work);
+ }
+}
+
+
+
+=head2 Commit
+
+Tells Jifty::DBI to commit the current SQL transaction.
+This will turn Autocommit mode back on.
+
+=cut
+
+sub Commit {
+ my $self = shift;
+ unless ($TRANSDEPTH) {Carp::confess("Attempted to commit a transaction with none in progress")};
+ $TRANSDEPTH--;
+
+ if ($TRANSDEPTH == 0 ) {
+ return($self->dbh->commit);
+ } else { #we're inside a transaction
+ return($TRANSDEPTH);
+ }
+}
+
+
+
+=head2 Rollback [FORCE]
+
+Tells Jifty::DBI to abort the current SQL transaction.
+This will turn Autocommit mode back on.
+
+If this method is passed a true argument, stack depth is blown away and the outermost transaction is rolled back
+
+=cut
+
+sub Rollback {
+ my $self = shift;
+ my $force = shift || undef;
+ #unless ($TRANSDEPTH) {Carp::confess("Attempted to rollback a transaction with none in progress")};
+ $TRANSDEPTH--;
+
+ if ($force) {
+ $TRANSDEPTH = 0;
+ return($self->dbh->rollback);
+ }
+
+ if ($TRANSDEPTH == 0 ) {
+ return($self->dbh->rollback);
+ } else { #we're inside a transaction
+ return($TRANSDEPTH);
+ }
+}
+
+
+=head2 ForceRollback
+
+Force the handle to rollback. Whether or not we're deep in nested transactions
+
+=cut
+
+sub ForceRollback {
+ my $self = shift;
+ $self->Rollback(1);
+}
+
+
+=head2 TransactionDepth
+
+Return the current depth of the faked nested transaction stack.
+
+=cut
+
+sub TransactionDepth {
+ my $self = shift;
+ return ($TRANSDEPTH);
+}
+
+
+
+=head2 ApplyLimits STATEMENTREF ROWS_PER_PAGE FIRST_ROW
+
+takes an SQL SELECT statement and massages it to return ROWS_PER_PAGE starting with FIRST_ROW;
+
+
+=cut
+
+sub ApplyLimits {
+ my $self = shift;
+ my $statementref = shift;
+ my $per_page = shift;
+ my $first = shift;
+
+ my $limit_clause = '';
+
+ if ( $per_page) {
+ $limit_clause = " LIMIT ";
+ if ( $first ) {
+ $limit_clause .= $first . ", ";
+ }
+ $limit_clause .= $per_page;
+ }
+
+ $$statementref .= $limit_clause;
+
+}
+
+
+
+
+
+=head2 Join { Paramhash }
+
+Takes a paramhash of everything Searchbuildler::Record does
+plus a parameter called 'SearchBuilder' that contains a ref
+to a SearchBuilder object'.
+
+This performs the join.
+
+
+=cut
+
+
+sub Join {
+
+ my $self = shift;
+ my %args = (
+ SearchBuilder => undef,
+ TYPE => 'normal',
+ FIELD1 => 'main',
+ ALIAS1 => undef,
+ TABLE2 => undef,
+ FIELD2 => undef,
+ ALIAS2 => undef,
+ EXPRESSION => undef,
+ @_
+ );
+
+ my $string;
+
+ my $alias;
+
+#If we're handed in an ALIAS2, we need to go remove it from the Aliases array.
+# Basically, if anyone generates an alias and then tries to use it in a join later, we want to be smart about
+# creating joins, so we need to go rip it out of the old aliases table and drop it in as an explicit join
+ if ( $args{'ALIAS2'} ) {
+
+ # this code is slow and wasteful, but it's clear.
+ my @aliases = @{ $args{'SearchBuilder'}->{'aliases'} };
+ my @new_aliases;
+ foreach my $old_alias (@aliases) {
+ if ( $old_alias =~ /^(.*?) ($args{'ALIAS2'})$/ ) {
+ $args{'TABLE2'} = $1;
+ $alias = $2;
+
+ }
+ else {
+ push @new_aliases, $old_alias;
+ }
+ }
+
+# If we found an alias, great. let's just pull out the table and alias for the other item
+ unless ($alias) {
+
+ # if we can't do that, can we reverse the join and have it work?
+ my $a1 = $args{'ALIAS1'};
+ my $f1 = $args{'FIELD1'};
+ $args{'ALIAS1'} = $args{'ALIAS2'};
+ $args{'FIELD1'} = $args{'FIELD2'};
+ $args{'ALIAS2'} = $a1;
+ $args{'FIELD2'} = $f1;
+
+ @aliases = @{ $args{'SearchBuilder'}->{'aliases'} };
+ @new_aliases = ();
+ foreach my $old_alias (@aliases) {
+ if ( $old_alias =~ /^(.*?) ($args{'ALIAS2'})$/ ) {
+ $args{'TABLE2'} = $1;
+ $alias = $2;
+
+ }
+ else {
+ push @new_aliases, $old_alias;
+ }
+ }
+
+ }
+
+ if ( !$alias || $args{'ALIAS1'} ) {
+ return ( $self->_NormalJoin(%args) );
+ }
+
+ $args{'SearchBuilder'}->{'aliases'} = \@new_aliases;
+ }
+
+ else {
+ $alias = $args{'SearchBuilder'}->_GetAlias( $args{'TABLE2'} );
+
+ }
+
+ if ( $args{'TYPE'} =~ /LEFT/i ) {
+
+ $string = " LEFT JOIN " . $args{'TABLE2'} . " $alias ";
+
+ }
+ else {
+
+ $string = " JOIN " . $args{'TABLE2'} . " $alias ";
+
+ }
+
+
+ my $criterion;
+ if ($args{'EXPRESSION'}) {
+ $criterion = $args{'EXPRESSION'};
+ } else {
+ $criterion = $args{'ALIAS1'}.".".$args{'FIELD1'};
+ }
+
+ $args{'SearchBuilder'}->{'left_joins'}{"$alias"}{'alias_string'} = $string;
+ $args{'SearchBuilder'}->{'left_joins'}{"$alias"}{'depends_on'} =
+ $args{'ALIAS1'};
+ $args{'SearchBuilder'}->{'left_joins'}{"$alias"}{'criteria'}
+ { 'criterion' . $args{'SearchBuilder'}->{'criteria_count'}++ } =
+ " $alias.$args{'FIELD2'} = $criterion";
+
+ return ($alias);
+}
+
+sub _NormalJoin {
+
+ my $self = shift;
+ my %args = (
+ SearchBuilder => undef,
+ TYPE => 'normal',
+ FIELD1 => undef,
+ ALIAS1 => undef,
+ TABLE2 => undef,
+ FIELD2 => undef,
+ ALIAS2 => undef,
+ @_
+ );
+
+ my $sb = $args{'SearchBuilder'};
+
+ if ( $args{'TYPE'} =~ /LEFT/i ) {
+ my $alias = $sb->_GetAlias( $args{'TABLE2'} );
+
+ $sb->{'left_joins'}{"$alias"}{'alias_string'} =
+ " LEFT JOIN $args{'TABLE2'} $alias ";
+
+ $sb->{'left_joins'}{"$alias"}{'criteria'}{'base_criterion'} =
+ " $args{'ALIAS1'}.$args{'FIELD1'} = $alias.$args{'FIELD2'}";
+
+ return ($alias);
+ }
+ else {
+ $sb->Jifty::DBI::Limit(
+ ENTRYAGGREGATOR => 'AND',
+ QUOTEVALUE => 0,
+ ALIAS => $args{'ALIAS1'},
+ FIELD => $args{'FIELD1'},
+ VALUE => $args{'ALIAS2'} . "." . $args{'FIELD2'},
+ @_
+ );
+ }
+}
+
+# this code is all hacky and evil. but people desperately want _something_ and I'm
+# super tired. refactoring gratefully appreciated.
+
+sub _BuildJoins {
+ my $self = shift;
+ my $sb = shift;
+ my %seen_aliases;
+
+ $seen_aliases{'main'} = 1;
+
+ # We don't want to get tripped up on a dependency on a simple alias.
+ foreach my $alias ( @{ $sb->{'aliases'}} ) {
+ if ( $alias =~ /^(.*?)\s+(.*?)$/ ) {
+ $seen_aliases{$2} = 1;
+ }
+ }
+
+ my $join_clause = $sb->Table . " main ";
+
+
+ my @keys = ( keys %{ $sb->{'left_joins'} } );
+ my %seen;
+
+ while ( my $join = shift @keys ) {
+ if ( ! $sb->{'left_joins'}{$join}{'depends_on'} || $seen_aliases{ $sb->{'left_joins'}{$join}{'depends_on'} } ) {
+ $join_clause = "(" . $join_clause;
+ $join_clause .=
+ $sb->{'left_joins'}{$join}{'alias_string'} . " ON (";
+ $join_clause .=
+ join ( ') AND( ',
+ values %{ $sb->{'left_joins'}{$join}{'criteria'} } );
+ $join_clause .= ")) ";
+
+ $seen_aliases{$join} = 1;
+ }
+ else {
+ push ( @keys, $join );
+ die "Unsatisfied dependency chain in Joins @keys"
+ if $seen{"@keys"}++;
+ }
+
+ }
+ return ( join ( ", ", ( $join_clause, @{ $sb->{'aliases'} } ) ) );
+
+}
+
+
+
+=head2 DistinctQuery STATEMENTREF
+
+takes an incomplete SQL SELECT statement and massages it to return a DISTINCT result set.
+
+
+=cut
+
+sub DistinctQuery {
+ my $self = shift;
+ my $statementref = shift;
+ #my $table = shift;
+
+ # Prepend select query for DBs which allow DISTINCT on all column types.
+ $$statementref = "SELECT DISTINCT main.* FROM $$statementref";
+
+}
+
+
+
+
+=head2 DistinctCount STATEMENTREF
+
+takes an incomplete SQL SELECT statement and massages it to return a DISTINCT result set.
+
+
+=cut
+
+sub DistinctCount {
+ my $self = shift;
+ my $statementref = shift;
+
+ # Prepend select query for DBs which allow DISTINCT on all column types.
+ $$statementref = "SELECT COUNT(DISTINCT main.id) FROM $$statementref";
+
+}
+
+
+=head2 Log MESSAGE
+
+Takes a single argument, a message to log.
+
+Currently prints that message to STDERR
+
+=cut
+
+sub Log {
+ my $self = shift;
+ my $msg = shift;
+ warn $msg."\n";
+
+}
+
+
+
+=head2 DESTROY
+
+When we get rid of the Searchbuilder::Handle, we need to disconnect from the database
+
+=cut
+
+
+sub DESTROY {
+ my $self = shift;
+ $self->Disconnect if $self->{'DisconnectHandleOnDestroy'};
+ delete $DBIHandle{$self};
+}
+
+
+1;
+__END__
+
+
+=head1 AUTHOR
+
+Jesse Vincent, jesse at fsck.com
+
+=head1 SEE ALSO
+
+perl(1), L<Jifty::DBI>
+
+=cut
+
Added: Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Informix.pm
==============================================================================
--- (empty file)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Informix.pm Sun Jul 24 21:04:49 2005
@@ -0,0 +1,151 @@
+# $Header: $
+
+package Jifty::DBI::Handle::Informix;
+use Jifty::DBI::Handle;
+ at ISA = qw(Jifty::DBI::Handle);
+
+use vars qw($VERSION @ISA $DBIHandle $DEBUG);
+use strict;
+
+=head1 NAME
+
+ Jifty::DBI::Handle::Informix - An Informix specific Handle object
+
+=head1 SYNOPSIS
+
+
+=head1 DESCRIPTION
+
+This module provides a subclass of Jifty::DBI::Handle that
+compensates for some of the idiosyncrasies of Informix.
+
+=head1 METHODS
+
+=cut
+
+
+=head2 Insert
+
+Takes a table name as the first argument and assumes that the rest of the arguments are an array of key-value pairs to be inserted.
+
+If the insert succeeds, returns the id of the insert, otherwise, returns
+a Class::ReturnValue object with the error reported.
+
+=cut
+
+sub Insert {
+ my $self = shift;
+
+ my $sth = $self->SUPER::Insert(@_);
+ if (!$sth) {
+ print "no sth! (".$self->dbh->{ix_sqlerrd}[1].")\n";
+ return ($sth);
+ }
+
+
+ $self->{id}=$self->dbh->{ix_sqlerrd}[1];
+ warn "$self no row id returned on row creation" unless ($self->{'id'});
+ return( $self->{'id'}); #Add Succeded. return the id
+ }
+
+
+=head2 CaseSensitive
+
+Returns 1, since Informix's searches are case sensitive by default
+
+=cut
+
+sub CaseSensitive {
+ my $self = shift;
+ return(1);
+}
+
+
+=head2 BuildDSN
+
+Builder for Informix DSNs.
+
+=cut
+
+sub BuildDSN {
+ my $self = shift;
+ my %args = ( Driver => undef,
+ Database => undef,
+ Host => undef,
+ Port => undef,
+ SID => undef,
+ RequireSSL => undef,
+ @_);
+
+ my $dsn = "dbi:$args{'Driver'}:";
+
+ $dsn .= "$args{'Database'}" if (defined $args{'Database'} && $args{'Database'});
+
+ $self->{'dsn'}= $dsn;
+}
+
+
+=head2 ApplyLimits STATEMENTREF ROWS_PER_PAGE FIRST_ROW
+
+takes an SQL SELECT statement and massages it to return ROWS_PER_PAGE starting with FIRST_ROW;
+
+
+=cut
+
+sub ApplyLimits {
+ my $self = shift;
+ my $statementref = shift;
+ my $per_page = shift;
+ my $first = shift;
+
+ # XXX TODO THIS only works on the FIRST page of results. that's a bug
+ if ($per_page) {
+ $$statementref =~ s[^\s*SELECT][SELECT FIRST $per_page]i;
+ }
+}
+
+
+sub Disconnect {
+ my $self = shift;
+ if ($self->dbh) {
+ my $status = $self->dbh->disconnect();
+ $self->dbh( undef);
+ return $status;
+ } else {
+ return;
+ }
+}
+
+
+=head2 DistinctQuery STATEMENTREF
+
+takes an incomplete SQL SELECT statement and massages it to return a DISTINCT result set.
+
+
+=cut
+
+sub DistinctQuery {
+ my $self = shift;
+ my $statementref = shift;
+ my $table = shift;
+
+ # Wrapper select query in a subselect as Informix doesn't allow
+ # DISTINCT against CLOB/BLOB column types.
+ $$statementref = "SELECT * FROM $table main WHERE id IN ( SELECT DISTINCT main.id FROM $$statementref )";
+
+}
+
+
+1;
+
+__END__
+
+=head1 AUTHOR
+
+Oliver Tappe, oliver at akso.de
+
+=head1 SEE ALSO
+
+perl(1), Jifty::DBI
+
+=cut
Added: Jifty-DBI/trunk/lib/Jifty/DBI/Handle/ODBC.pm
==============================================================================
--- (empty file)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Handle/ODBC.pm Sun Jul 24 21:04:49 2005
@@ -0,0 +1,99 @@
+# $Header: /home/jesse/DBIx-SearchBuilder/history/SearchBuilder/Handle/ODBC.pm,v 1.8 2001/10/12 05:27:05 jesse Exp $
+
+package Jifty::DBI::Handle::ODBC;
+use Jifty::DBI::Handle;
+ at ISA = qw(Jifty::DBI::Handle);
+
+use vars qw($VERSION @ISA $DBIHandle $DEBUG);
+use strict;
+
+=head1 NAME
+
+ Jifty::DBI::Handle::ODBC - An ODBC specific Handle object
+
+=head1 SYNOPSIS
+
+
+=head1 DESCRIPTION
+
+This module provides a subclass of Jifty::DBI::Handle that
+compensates for some of the idiosyncrasies of ODBC.
+
+=head1 METHODS
+
+=cut
+
+=head2 CaseSensitive
+
+Returns a false value.
+
+=cut
+
+sub CaseSensitive {
+ my $self = shift;
+ return (undef);
+}
+
+=head2 BuildDSN
+
+=cut
+
+sub BuildDSN {
+ my $self = shift;
+ my %args = (
+ Driver => undef,
+ Database => undef,
+ Host => undef,
+ Port => undef,
+ @_
+ );
+
+ my $dsn = "dbi:$args{'Driver'}:$args{'Database'}";
+ $dsn .= ";host=$args{'Host'}" if (defined $args{'Host'} && $args{'Host'});
+ $dsn .= ";port=$args{'Port'}" if (defined $args{'Port'} && $args{'Port'});
+
+ $self->{'dsn'} = $dsn;
+}
+
+=head2 ApplyLimits
+
+=cut
+
+sub ApplyLimits {
+ my $self = shift;
+ my $statementref = shift;
+ my $per_page = shift or return;
+ my $first = shift;
+
+ my $limit_clause = " TOP $per_page";
+ $limit_clause .= " OFFSET $first" if $first;
+ $$statementref =~ s/SELECT\b/SELECT $limit_clause/;
+}
+
+=head2 DistinctQuery
+
+=cut
+
+sub DistinctQuery {
+ my $self = shift;
+ my $statementref = shift;
+
+ $$statementref = "SELECT main.* FROM $$statementref";
+}
+
+sub Encoding {
+}
+
+1;
+
+__END__
+
+=head1 AUTHOR
+
+Autrijus Tang
+
+=head1 SEE ALSO
+
+Jifty::DBI, Jifty::DBI::Handle
+
+=cut
Added: Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Oracle.pm
==============================================================================
--- (empty file)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Oracle.pm Sun Jul 24 21:04:49 2005
@@ -0,0 +1,283 @@
+# $Header: /home/jesse/DBIx-SearchBuilder/history/SearchBuilder/Handle/Oracle.pm,v 1.14 2002/01/28 06:11:37 jesse Exp $
+
+use strict;
+package Jifty::DBI::Handle::Oracle;
+use base qw/Jifty::DBI::Handle/;
+use DBD::Oracle qw(:ora_types);
+
+use vars qw($VERSION $DBIHandle $DEBUG);
+
+
+=head1 NAME
+
+ Jifty::DBI::Handle::Oracle - An oracle specific Handle object
+
+=head1 SYNOPSIS
+
+
+=head1 DESCRIPTION
+
+This module provides a subclass of Jifty::DBI::Handle that
+compensates for some of the idiosyncrasies of Oracle.
+
+=head1 METHODS
+
+=cut
+
+
+=head2 Connect PARAMHASH: Driver, Database, Host, User, Password
+
+Takes a paramhash and connects to your DBI datasource.
+
+=cut
+
+sub Connect {
+ my $self = shift;
+
+ my %args = ( Driver => undef,
+ Database => undef,
+ User => undef,
+ Password => undef,
+ SID => undef,
+ Host => undef,
+ @_);
+
+ $self->SUPER::Connect(%args);
+
+ $self->dbh->{LongTruncOk}=1;
+ $self->dbh->{LongReadLen}=8000;
+
+ $self->SimpleQuery("ALTER SESSION set NLS_DATE_FORMAT = 'YYYY-MM-DD HH24:MI:SS'");
+
+ return ($DBIHandle);
+}
+
+
+=head2 Insert
+
+Takes a table name as the first argument and assumes that the rest of the arguments
+are an array of key-value pairs to be inserted.
+
+=cut
+
+sub Insert {
+ my $self = shift;
+ my $table = shift;
+ my ($sth);
+
+
+
+ # Oracle Hack to replace non-supported mysql_rowid call
+
+ my %attribs = @_;
+ my ($unique_id, $QueryString);
+
+ if ($attribs{'Id'} || $attribs{'id'}) {
+ $unique_id = ($attribs{'Id'} ? $attribs{'Id'} : $attribs{'id'} );
+ }
+ else {
+
+ $QueryString = "SELECT ".$table."_seq.nextval FROM DUAL";
+
+ $sth = $self->SimpleQuery($QueryString);
+ if (!$sth) {
+ if ($main::debug) {
+ die "Error with $QueryString";
+ }
+ else {
+ return (undef);
+ }
+ }
+
+ #needs error checking
+ my @row = $sth->fetchrow_array;
+
+ $unique_id = $row[0];
+
+ }
+
+ #TODO: don't hardcode this to id pull it from somewhere else
+ #call super::Insert with the new column id.
+
+ $attribs{'id'} = $unique_id;
+ delete $attribs{'Id'};
+ $sth = $self->SUPER::Insert( $table, %attribs);
+
+ unless ($sth) {
+ if ($main::debug) {
+ die "Error with $QueryString: ". $self->dbh->errstr;
+ }
+ else {
+ return (undef);
+ }
+ }
+
+ $self->{'id'} = $unique_id;
+ return( $self->{'id'}); #Add Succeded. return the id
+ }
+
+
+
+=head2 BuildDSN PARAMHASH
+
+Takes a bunch of parameters:
+
+Required: Driver, Database or Host/SID,
+Optional: Port and RequireSSL
+
+Builds a DSN suitable for an Oracle DBI connection
+
+=cut
+
+sub BuildDSN {
+ my $self = shift;
+ my %args = ( Driver => undef,
+ Database => undef,
+ Host => undef,
+ Port => undef,
+ SID => undef,
+ RequireSSL => undef,
+ @_);
+
+ my $dsn = "dbi:$args{'Driver'}:";
+
+ if (defined $args{'Host'} && $args{'Host'}
+ && defined $args{'SID'} && $args{'SID'} ) {
+ $dsn .= "host=$args{'Host'};sid=$args{'SID'}";
+ } else {
+ $dsn .= "$args{'Database'}" if (defined $args{'Database'} && $args{'Database'});
+ }
+ $dsn .= ";port=$args{'Port'}" if (defined $args{'Port'} && $args{'Port'});
+ $dsn .= ";requiressl=1" if (defined $args{'RequireSSL'} && $args{'RequireSSL'});
+
+ $self->{'dsn'}= $dsn;
+}
+
+
+
+=head2 KnowsBLOBs
+
+Returns 1 if the current database supports inserts of BLOBs automatically.
+Returns undef if the current database must be informed of BLOBs for inserts.
+
+=cut
+
+sub KnowsBLOBs {
+ my $self = shift;
+ return(undef);
+}
+
+
+
+=head2 BLOBParams FIELD_NAME FIELD_TYPE
+
+Returns a hash ref for the bind_param call to identify BLOB types used by
+the current database for a particular column type.
+The current Oracle implementation only supports ORA_CLOB types (112).
+
+=cut
+
+sub BLOBParams {
+ my $self = shift;
+ my $field = shift;
+ #my $type = shift;
+ # Don't assign to key 'value' as it is defined later.
+ return ( { ora_field => $field, ora_type => ORA_CLOB,
+});
+}
+
+
+
+=head2 ApplyLimits STATEMENTREF ROWS_PER_PAGE FIRST_ROW
+
+takes an SQL SELECT statement and massages it to return ROWS_PER_PAGE starting with FIRST_ROW;
+
+
+=cut
+
+sub ApplyLimits {
+ my $self = shift;
+ my $statementref = shift;
+ my $per_page = shift;
+ my $first = shift;
+
+ # Transform an SQL query from:
+ #
+ # SELECT main.*
+ # FROM Tickets main
+ # WHERE ((main.EffectiveId = main.id))
+ # AND ((main.Type = 'ticket'))
+ # AND ( ( (main.Status = 'new')OR(main.Status = 'open') )
+ # AND ( (main.Queue = '1') ) )
+ #
+ # to:
+ #
+ # SELECT * FROM (
+ # SELECT limitquery.*,rownum limitrownum FROM (
+ # SELECT main.*
+ # FROM Tickets main
+ # WHERE ((main.EffectiveId = main.id))
+ # AND ((main.Type = 'ticket'))
+ # AND ( ( (main.Status = 'new')OR(main.Status = 'open') )
+ # AND ( (main.Queue = '1') ) )
+ # ) limitquery WHERE rownum <= 50
+ # ) WHERE limitrownum >= 1
+ #
+
+ if ($per_page) {
+ # Oracle orders from 1 not zero
+ $first++;
+ # Make current query a sub select
+ $$statementref = "SELECT * FROM ( SELECT limitquery.*,rownum limitrownum FROM ( $$statementref ) limitquery WHERE rownum <= " . ($first + $per_page - 1) . " ) WHERE limitrownum >= " . $first;
+ }
+}
+
+
+
+=head2 DistinctQuery STATEMENTREF
+
+takes an incomplete SQL SELECT statement and massages it to return a DISTINCT result set.
+
+
+=cut
+
+sub DistinctQuery {
+ my $self = shift;
+ my $statementref = shift;
+ my $table = shift;
+
+ # Wrapper select query in a subselect as Oracle doesn't allow
+ # DISTINCT against CLOB/BLOB column types.
+ $$statementref = "SELECT main.* FROM ( SELECT DISTINCT main.id FROM $$statementref ) distinctquery, $table main WHERE (main.id = distinctquery.id) ";
+
+}
+
+
+
+
+=head2 BinarySafeBLOBs
+
+Return undef, as Oracle doesn't support binary-safe CLOBS
+
+
+=cut
+
+sub BinarySafeBLOBs {
+ my $self = shift;
+ return(undef);
+}
+
+
+1;
+
+__END__
+
+=head1 AUTHOR
+
+Jesse Vincent, jesse at fsck.com
+
+=head1 SEE ALSO
+
+perl(1), Jifty::DBI
+
+=cut
Added: Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Pg.pm
==============================================================================
--- (empty file)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Pg.pm Sun Jul 24 21:04:49 2005
@@ -0,0 +1,176 @@
+#$Header: /home/jesse/DBIx-SearchBuilder/history/SearchBuilder/Handle/Pg.pm,v 1.8 2001/07/27 05:23:29 jesse Exp $
+# Copyright 1999-2001 Jesse Vincent <jesse at fsck.com>
+
+package Jifty::DBI::Handle::Pg;
+use strict;
+
+use vars qw($VERSION @ISA $DBIHandle $DEBUG);
+use base qw(Jifty::DBI::Handle);
+use Want qw(want howmany);
+
+use strict;
+
+=head1 NAME
+
+ Jifty::DBI::Handle::Pg - A Postgres specific Handle object
+
+=head1 SYNOPSIS
+
+
+=head1 DESCRIPTION
+
+This module provides a subclass of Jifty::DBI::Handle that
+compensates for some of the idiosyncrasies of Postgres.
+
+=head1 METHODS
+
+=cut
+
+
+=head2 Connect
+
+Connect takes a hashref and passes it off to SUPER::Connect;
+Forces the timezone to GMT
+it returns a database handle.
+
+=cut
+
+sub Connect {
+ my $self = shift;
+
+ $self->SUPER::Connect(@_);
+ $self->SimpleQuery("SET TIME ZONE 'GMT'");
+ $self->SimpleQuery("SET DATESTYLE TO 'ISO'");
+ $self->AutoCommit(1);
+ return ($DBIHandle);
+}
+
+
+=head2 Insert
+
+Takes a table name as the first argument and assumes that the rest of the arguments
+are an array of key-value pairs to be inserted.
+
+In case of isnert failure, returns a Class::ReturnValue object preloaded
+with error info
+
+=cut
+
+
+sub Insert {
+ my $self = shift;
+ my $table = shift;
+
+ my $sth = $self->SUPER::Insert($table, @_ );
+
+ unless ($sth) {
+ return ($sth);
+ }
+
+ #Lets get the id of that row we just inserted
+ my $oid = $sth->{'pg_oid_status'};
+ my $sql = "SELECT id FROM $table WHERE oid = ?";
+ my @row = $self->FetchResult($sql, $oid);
+ # TODO: Propagate Class::ReturnValue up here.
+ unless ($row[0]) {
+ print STDERR "Can't find $table.id for OID $oid";
+ return(undef);
+ }
+ $self->{'id'} = $row[0];
+
+ return ($self->{'id'});
+}
+
+
+
+=head2 BinarySafeBLOBs
+
+Return undef, as no current version of postgres supports binary-safe blobs
+
+=cut
+
+sub BinarySafeBLOBs {
+ my $self = shift;
+ return(undef);
+}
+
+
+=head2 ApplyLimits STATEMENTREF ROWS_PER_PAGE FIRST_ROW
+
+takes an SQL SELECT statement and massages it to return ROWS_PER_PAGE starting with FIRST_ROW;
+
+
+=cut
+
+sub ApplyLimits {
+ my $self = shift;
+ my $statementref = shift;
+ my $per_page = shift;
+ my $first = shift;
+
+ my $limit_clause = '';
+
+ if ( $per_page) {
+ $limit_clause = " LIMIT ";
+ $limit_clause .= $per_page;
+ if ( $first && $first != 0 ) {
+ $limit_clause .= " OFFSET $first";
+ }
+ }
+
+ $$statementref .= $limit_clause;
+
+}
+
+
+=head2 _MakeClauseCaseInsensitive FIELD OPERATOR VALUE
+
+Takes a field, operator and value. performs the magic necessary to make
+your database treat this clause as case insensitive.
+
+Returns a FIELD OPERATOR VALUE triple.
+
+=cut
+
+sub _MakeClauseCaseInsensitive {
+ my $self = shift;
+ my $field = shift;
+ my $operator = shift;
+ my $value = shift;
+
+
+ if ($value =~ /^['"]?\d+['"]?$/) { # we don't need to downcase numeric values
+ return ( $field, $operator, $value);
+ }
+
+ if ( $operator =~ /LIKE/i ) {
+ $operator =~ s/LIKE/ILIKE/ig;
+ return ( $field, $operator, $value );
+ }
+ elsif ( $operator =~ /=/ ) {
+ if (howmany() >= 4) {
+ return ( "LOWER($field)", $operator, $value, "LOWER(?)");
+ }
+ # RT 3.0.x and earlier don't know how to cope with a "LOWER" function
+ # on the value. they only expect field, operator, value.
+ #
+ else {
+ return ( "LOWER($field)", $operator, lc($value));
+
+ }
+ }
+ else {
+ $self->SUPER::_MakeClauseCaseInsensitive( $field, $operator, $value );
+ }
+}
+
+1;
+
+__END__
+
+=head1 SEE ALSO
+
+Jifty::DBI, Jifty::DBI::Handle
+
+=cut
+
Added: Jifty-DBI/trunk/lib/Jifty/DBI/Handle/SQLite.pm
==============================================================================
--- (empty file)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Handle/SQLite.pm Sun Jul 24 21:04:49 2005
@@ -0,0 +1,155 @@
+
+package Jifty::DBI::Handle::SQLite;
+use Jifty::DBI::Handle;
+ at ISA = qw(Jifty::DBI::Handle);
+
+use vars qw($VERSION @ISA $DBIHandle $DEBUG);
+use strict;
+
+=head1 NAME
+
+ Jifty::DBI::Handle::SQLite -- A SQLite specific Handle object
+
+=head1 SYNOPSIS
+
+
+=head1 DESCRIPTION
+
+This module provides a subclass of Jifty::DBI::Handle that
+compensates for some of the idiosyncrasies of SQLite.
+
+=head1 METHODS
+
+=cut
+
+
+=head2 Insert
+
+Takes a table name as the first argument and assumes that the rest of the arguments
+are an array of key-value pairs to be inserted.
+
+If the insert succeeds, returns the id of the insert, otherwise, returns
+a Class::ReturnValue object with the error reported.
+
+=cut
+
+sub Insert {
+ my $self = shift;
+ my $table = shift;
+ my %args = ( id => undef, @_);
+ # We really don't want an empty id
+
+ my $sth = $self->SUPER::Insert($table, %args);
+ return unless $sth;
+
+ # If we have set an id, then we want to use that, otherwise, we want to lookup the last _new_ rowid
+ $self->{'id'}= $args{'id'} || $self->dbh->func('last_insert_rowid');
+
+ warn "$self no row id returned on row creation" unless ($self->{'id'});
+ return( $self->{'id'}); #Add Succeded. return the id
+ }
+
+
+
+=head2 CaseSensitive
+
+Returns undef, since SQLite's searches are not case sensitive by default
+
+=cut
+
+sub CaseSensitive {
+ my $self = shift;
+ return(1);
+}
+
+sub BinarySafeBLOBs {
+ return undef;
+}
+
+
+=head2 DistinctCount STATEMENTREF
+
+takes an incomplete SQL SELECT statement and massages it to return a DISTINCT result count
+
+
+=cut
+
+sub DistinctCount {
+ my $self = shift;
+ my $statementref = shift;
+
+ # Wrapper select query in a subselect as Oracle doesn't allow
+ # DISTINCT against CLOB/BLOB column types.
+ $$statementref = "SELECT count(*) FROM (SELECT DISTINCT main.id FROM $$statementref )";
+
+}
+
+
+
+=head2 _BuildJoins
+
+Adjusts syntax of join queries for SQLite.
+
+=cut
+
+#SQLite can't handle
+# SELECT DISTINCT main.* FROM (Groups main LEFT JOIN Principals Principals_2 ON ( main.id = Principals_2.id)) , GroupMembers GroupMembers_1 WHERE ((GroupMembers_1.MemberId = '70')) AND ((Principals_2.Disabled = '0')) AND ((main.Domain = 'UserDefined')) AND ((main.id = GroupMembers_1.GroupId))
+# ORDER BY main.Name ASC
+# It needs
+# SELECT DISTINCT main.* FROM Groups main LEFT JOIN Principals Principals_2 ON ( main.id = Principals_2.id) , GroupMembers GroupMembers_1 WHERE ((GroupMembers_1.MemberId = '70')) AND ((Principals_2.Disabled = '0')) AND ((main.Domain = 'UserDefined')) AND ((main.id = GroupMembers_1.GroupId)) ORDER BY main.Name ASC
+
+sub _BuildJoins {
+ my $self = shift;
+ my $sb = shift;
+ my %seen_aliases;
+
+ $seen_aliases{'main'} = 1;
+
+ # We don't want to get tripped up on a dependency on a simple alias.
+ foreach my $alias ( @{ $sb->{'aliases'}} ) {
+ if ( $alias =~ /^(.*?)\s+(.*?)$/ ) {
+ $seen_aliases{$2} = 1;
+ }
+ }
+
+ my $join_clause = $sb->Table . " main ";
+
+ my @keys = ( keys %{ $sb->{'left_joins'} } );
+ my %seen;
+
+ while ( my $join = shift @keys ) {
+ if ( ! $sb->{'left_joins'}{$join}{'depends_on'} || $seen_aliases{ $sb->{'left_joins'}{$join}{'depends_on'} } ) {
+ #$join_clause = "(" . $join_clause;
+ $join_clause .=
+ $sb->{'left_joins'}{$join}{'alias_string'} . " ON (";
+ $join_clause .=
+ join ( ') AND( ',
+ values %{ $sb->{'left_joins'}{$join}{'criteria'} } );
+ $join_clause .= ") ";
+
+ $seen_aliases{$join} = 1;
+ }
+ else {
+ push ( @keys, $join );
+ die "Unsatisfied dependency chain in Joins @keys"
+ if $seen{"@keys"}++;
+ }
+
+ }
+ return ( join ( ", ", ( $join_clause, @{ $sb->{'aliases'} } ) ) );
+
+}
+
+1;
+
+__END__
+
+=head1 AUTHOR
+
+Jesse Vincent, jesse at fsck.com
+
+=head1 SEE ALSO
+
+perl(1), Jifty::DBI
+
+=cut
Added: Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Sybase.pm
==============================================================================
--- (empty file)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Sybase.pm Sun Jul 24 21:04:49 2005
@@ -0,0 +1,145 @@
+# $Header: /home/jesse/DBIx-SearchBuilder/history/SearchBuilder/Handle/Sybase.pm,v 1.8 2001/10/12 05:27:05 jesse Exp $
+
+package Jifty::DBI::Handle::Sybase;
+use Jifty::DBI::Handle;
+ at ISA = qw(Jifty::DBI::Handle);
+
+use vars qw($VERSION @ISA $DBIHandle $DEBUG);
+use strict;
+
+=head1 NAME
+
+ Jifty::DBI::Handle::Sybase -- a Sybase specific Handle object
+
+=head1 SYNOPSIS
+
+
+=head1 DESCRIPTION
+
+This module provides a subclass of Jifty::DBI::Handle that
+compensates for some of the idiosyncrasies of Sybase.
+
+=head1 METHODS
+
+=cut
+
+
+=head2 Insert
+
+Takes a table name as the first argument and assumes that the rest of the arguments
+are an array of key-value pairs to be inserted.
+
+If the insert succeeds, returns the id of the insert, otherwise, returns
+a Class::ReturnValue object with the error reported.
+
+=cut
+
+sub Insert {
+ my $self = shift;
+
+ my $table = shift;
+ my %pairs = @_;
+ my $sth = $self->SUPER::Insert( $table, %pairs );
+ if ( !$sth ) {
+ return ($sth);
+ }
+
+ # Can't select identity column if we're inserting the id by hand.
+ unless ($pairs{'id'}) {
+ my @row = $self->FetchResult('SELECT @@identity');
+
+ # TODO: Propagate Class::ReturnValue up here.
+ unless ( $row[0] ) {
+ return (undef);
+ }
+ $self->{'id'} = $row[0];
+ }
+ return ( $self->{'id'} );
+}
+
+
+
+
+
+=head2 DatabaseVersion
+
+return the database version, trimming off any -foo identifier
+
+=cut
+
+sub DatabaseVersion {
+ my $self = shift;
+ my $v = $self->SUPER::DatabaseVersion();
+
+ $v =~ s/\-(.*)$//;
+ return ($v);
+
+}
+
+=head2 CaseSensitive
+
+Returns undef, since Sybase's searches are not case sensitive by default
+
+=cut
+
+sub CaseSensitive {
+ my $self = shift;
+ return(1);
+}
+
+
+
+
+sub ApplyLimits {
+ my $self = shift;
+ my $statementref = shift;
+ my $per_page = shift;
+ my $first = shift;
+
+}
+
+
+=head2 DistinctQuery STATEMENTREFtakes an incomplete SQL SELECT statement and massages it to return a DISTINCT result set.
+
+
+=cut
+
+sub DistinctQuery {
+ my $self = shift;
+ my $statementref = shift;
+ my $table = shift;
+
+ # Wrapper select query in a subselect as Oracle doesn't allow
+ # DISTINCT against CLOB/BLOB column types.
+ $$statementref = "SELECT main.* FROM ( SELECT DISTINCT main.id FROM $$statementref ) distinctquery, $table main WHERE (main.id = distinctquery.id) ";
+
+}
+
+
+=head2 BinarySafeBLOBs
+
+Return undef, as Oracle doesn't support binary-safe CLOBS
+
+
+=cut
+
+sub BinarySafeBLOBs {
+ my $self = shift;
+ return(undef);
+}
+
+
+
+1;
+
+__END__
+
+=head1 AUTHOR
+
+Jesse Vincent, jesse at fsck.com
+
+=head1 SEE ALSO
+
+Jifty::DBI, Jifty::DBI::Handle
+
+=cut
Added: Jifty-DBI/trunk/lib/Jifty/DBI/Handle/mysql.pm
==============================================================================
--- (empty file)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Handle/mysql.pm Sun Jul 24 21:04:49 2005
@@ -0,0 +1,96 @@
+# $Header: /home/jesse/DBIx-SearchBuilder/history/SearchBuilder/Handle/mysql.pm,v 1.8 2001/10/12 05:27:05 jesse Exp $
+
+package Jifty::DBI::Handle::mysql;
+use Jifty::DBI::Handle;
+ at ISA = qw(Jifty::DBI::Handle);
+
+use vars qw($VERSION @ISA $DBIHandle $DEBUG);
+use strict;
+
+=head1 NAME
+
+ Jifty::DBI::Handle::mysql - A mysql specific Handle object
+
+=head1 SYNOPSIS
+
+
+=head1 DESCRIPTION
+
+This module provides a subclass of Jifty::DBI::Handle that
+compensates for some of the idiosyncrasies of MySQL.
+
+=head1 METHODS
+
+=cut
+
+
+=head2 Insert
+
+Takes a table name as the first argument and assumes that the rest of the arguments are an array of key-value pairs to be inserted.
+
+If the insert succeeds, returns the id of the insert, otherwise, returns
+a Class::ReturnValue object with the error reported.
+
+=cut
+
+sub Insert {
+ my $self = shift;
+
+ my $sth = $self->SUPER::Insert(@_);
+ if (!$sth) {
+ return ($sth);
+ }
+
+ $self->{'id'}=$self->dbh->{'mysql_insertid'};
+
+ # Yay. we get to work around mysql_insertid being null some of the time :/
+ unless ($self->{'id'}) {
+ $self->{'id'} = $self->FetchResult('SELECT LAST_INSERT_ID()');
+ }
+ warn "$self no row id returned on row creation" unless ($self->{'id'});
+
+ return( $self->{'id'}); #Add Succeded. return the id
+ }
+
+
+
+=head2 DatabaseVersion
+
+Returns the mysql version, trimming off any -foo identifier
+
+=cut
+
+sub DatabaseVersion {
+ my $self = shift;
+ my $v = $self->SUPER::DatabaseVersion();
+
+ $v =~ s/\-.*$//;
+ return ($v);
+}
+
+=head2 CaseSensitive
+
+Returns undef, since mysql's searches are not case sensitive by default
+
+=cut
+
+sub CaseSensitive {
+ my $self = shift;
+ return(undef);
+}
+
+
+1;
+
+__END__
+
+=head1 AUTHOR
+
+Jesse Vincent, jesse at fsck.com
+
+=head1 SEE ALSO
+
+Jifty::DBI, Jifty::DBI::Handle
+
+=cut
+
Added: Jifty-DBI/trunk/lib/Jifty/DBI/Handle/mysqlPP.pm
==============================================================================
--- (empty file)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Handle/mysqlPP.pm Sun Jul 24 21:04:49 2005
@@ -0,0 +1,31 @@
+package Jifty::DBI::Handle::mysqlPP;
+use Jifty::DBI::Handle::mysql;
+ at ISA = qw(Jifty::DBI::Handle::mysql);
+
+use vars qw($VERSION @ISA $DBIHandle $DEBUG);
+use strict;
+
+1;
+
+__END__
+
+=head1 NAME
+
+Jifty::DBI::Handle::mysqlPP - A mysql specific Handle object
+
+=head1 DESCRIPTION
+
+A Handle subclass for the "pure perl" mysql database driver.
+
+This is currently identical to the Jifty::DBI::Handle::mysql class.
+
+=head1 AUTHOR
+
+
+
+=head1 SEE ALSO
+
+Jifty::DBI::Handle::mysql
+
+=cut
+
Added: Jifty-DBI/trunk/lib/Jifty/DBI/Record.pm
==============================================================================
--- (empty file)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Record.pm Sun Jul 24 21:04:49 2005
@@ -0,0 +1,1386 @@
+#$Header/cvsroot/DBIx/DBIx-SearchBuilder/SearchBuilder/Record.pm,v 1.21 2001/02/28 21:36:27 jesse Exp $
+package Jifty::DBI::Record;
+
+use strict;
+use warnings;
+
+use vars qw($AUTOLOAD);
+use Class::ReturnValue;
+
+
+
+=head1 NAME
+
+Jifty::DBI::Record - Superclass for records loaded by SearchBuilder
+
+=head1 SYNOPSIS
+
+ package MyRecord;
+ use base qw/Jifty::DBI::Record/;
+
+ sub _Init {
+ my $self = shift;
+ my $DBIxHandle =
+ shift; # A Jifty::DBI::Handle::foo object for your database
+
+ $self->_Handle($DBIxHandle);
+ $self->Table("Users");
+ }
+
+ # Tell Record what the primary keys are
+ sub _PrimaryKeys {
+ return ['id'];
+ }
+
+ # Preferred and most efficient way to specify fields attributes in a derived
+ # class, used by the autoloader to construct Attrib and SetAttrib methods.
+
+ # read: calling $Object->Foo will return the value of this record's Foo column
+ # write: calling $Object->SetFoo with a single value will set Foo's value in
+ # both the loaded object and the database
+ sub _ClassAccessible {
+ {
+ Tofu => { 'read' => 1, 'write' => 1 },
+ Maz => { 'auto' => 1, },
+ Roo => { 'read' => 1, 'auto' => 1, 'public' => 1, },
+ };
+ }
+
+ # A subroutine to check a user's password without returning the current value
+ # For security purposes, we didn't expose the Password method above
+ sub IsPassword {
+ my $self = shift;
+ my $try = shift;
+
+ # note two __s in __Value. Subclasses may muck with _Value, but
+ # they should never touch __Value
+
+ if ( $try eq $self->__Value('Password') ) {
+ return (1);
+ }
+ else {
+ return (undef);
+ }
+ }
+
+ # Override Jifty::DBI::Create to do some checking on create
+ sub Create {
+ my $self = shift;
+ my %fields = (
+ UserId => undef,
+ Password => 'default', #Set a default password
+ @_
+ );
+
+ # Make sure a userid is specified
+ unless ( $fields{'UserId'} ) {
+ die "No userid specified.";
+ }
+
+ # Get Jifty::DBI::Record->Create to do the real work
+ return (
+ $self->SUPER::Create(
+ UserId => $fields{'UserId'},
+ Password => $fields{'Password'},
+ Created => time
+ )
+ );
+ }
+
+=head1 DESCRIPTION
+
+Jifty::DBI::Record is designed to work with Jifty::DBI.
+
+
+=head2 What is it trying to do.
+
+Jifty::DBI::Record abstracts the agony of writing the common and generally
+simple SQL statements needed to serialize and De-serialize an object to the
+database. In a traditional system, you would define various methods on
+your object 'create', 'find', 'modify', and 'delete' being the most common.
+In each method you would have a SQL statement like:
+
+ select * from table where value='blah';
+
+If you wanted to control what data a user could modify, you would have to
+do some special magic to make accessors do the right thing. Etc. The
+problem with this approach is that in a majority of the cases, the SQL is
+incredibly simple and the code from one method/object to the next was
+basically the same.
+
+<trumpets>
+
+Enter, Jifty::DBI::Record.
+
+With::Record, you can in the simple case, remove all of that code and
+replace it by defining two methods and inheriting some code. Its pretty
+simple, and incredibly powerful. For more complex cases, you can, gasp,
+do more complicated things by overriding certain methods. Lets stick with
+the simple case for now.
+
+The two methods in question are '_Init' and '_ClassAccessible', all they
+really do are define some values and send you on your way. As you might
+have guessed the '_' suggests that these are private methods, they are.
+They will get called by your record objects constructor.
+
+=over 4
+
+=item '_Init'
+
+Defines what table we are talking about, and set a variable to store
+the database handle.
+
+=item '_ClassAccessible
+
+Defines what operations may be performed on various data selected
+from the database. For example you can define fields to be mutable,
+or immutable, there are a few other options but I don't understand
+what they do at this time.
+
+=back
+
+And really, thats it. So lets have some sample code.
+
+=head2 An Annotated Example
+
+The example code below makes the following assumptions:
+
+=over 4
+
+=item *
+
+The database is 'postgres',
+
+=item *
+
+The host is 'reason',
+
+=item *
+
+The login name is 'mhat',
+
+=item *
+
+The database is called 'example',
+
+=item *
+
+The table is called 'simple',
+
+=item *
+
+The table looks like so:
+
+ id integer not NULL, primary_key(id),
+ foo varchar(10),
+ bar varchar(10)
+
+=back
+
+First, let's define our record class in a new module named "Simple.pm".
+
+ 000: package Simple;
+ 001: use Jifty::DBI::Record;
+ 002: @ISA = (Jifty::DBI::Record);
+
+This should be pretty obvious, name the package, import ::Record and then
+define ourself as a subclass of ::Record.
+
+ 003:
+ 004: sub _Init {
+ 005: my $this = shift;
+ 006: my $handle = shift;
+ 007:
+ 008: $this->_Handle($handle);
+ 009: $this->Table("Simple");
+ 010:
+ 011: return ($this);
+ 012: }
+
+Here we set our handle and table name, while its not obvious so far, we'll
+see later that $handle (line: 006) gets passed via ::Record::new when a
+new instance is created. Thats actually an important concept, the DB handle
+is not bound to a single object but rather, its shared across objects.
+
+ 013:
+ 014: sub _ClassAccessible {
+ 015: {
+ 016: Foo => { 'read' => 1 },
+ 017: Bar => { 'read' => 1, 'write' => 1 },
+ 018: Id => { 'read' => 1 }
+ 019: };
+ 020: }
+
+What's happening might be obvious, but just in case this method is going to
+return a reference to a hash. That hash is where our columns are defined,
+as well as what type of operations are acceptable.
+
+ 021:
+ 022: 1;
+
+Like all perl modules, this needs to end with a true value.
+
+Now, on to the code that will actually *do* something with this object.
+This code would be placed in your Perl script.
+
+ 000: use Jifty::DBI::Handle;
+ 001: use Simple;
+
+Use two packages, the first is where I get the DB handle from, the latter
+is the object I just created.
+
+ 002:
+ 003: my $handle = Jifty::DBI::Handle->new();
+ 004: $handle->Connect( 'Driver' => 'Pg',
+ 005: 'Database' => 'test',
+ 006: 'Host' => 'reason',
+ 007: 'User' => 'mhat',
+ 008: 'Password' => '');
+
+Creates a new Jifty::DBI::Handle, and then connects to the database using
+that handle. Pretty straight forward, the password '' is what I use
+when there is no password. I could probably leave it blank, but I find
+it to be more clear to define it.
+
+ 009:
+ 010: my $s = Simple->new($handle);
+ 011:
+ 012: $s->LoadById(1);
+
+LoadById is one of four 'LoadBy' methods, as the name suggests it searches
+for an row in the database that has id='0'. ::SearchBuilder has, what I
+think is a bug, in that it current requires there to be an id field. More
+reasonably it also assumes that the id field is unique. LoadById($id) will
+do undefined things if there is >1 row with the same id.
+
+In addition to LoadById, we also have:
+
+=over 4
+
+=item LoadByCol
+
+Takes two arguments, a column name and a value. Again, it will do
+undefined things if you use non-unique things.
+
+=item LoadByCols
+
+Takes a hash of columns=>values and returns the *first* to match.
+First is probably lossy across databases vendors.
+
+=item LoadFromHash
+
+Populates this record with data from a Jifty::DBI. I'm
+currently assuming that Jifty::DBI is what we use in
+cases where we expect > 1 record. More on this later.
+
+=back
+
+Now that we have a populated object, we should do something with it! ::Record
+automagically generates accessos and mutators for us, so all we need to do
+is call the methods. Accessors are named <Field>(), and Mutators are named
+Set<Field>($). On to the example, just appending this to the code from
+the last example.
+
+ 013:
+ 014: print "ID : ", $s->Id(), "\n";
+ 015: print "Foo : ", $s->Foo(), "\n";
+ 016: print "Bar : ", $s->Bar(), "\n";
+
+Thats all you have to to get the data, now to change the data!
+
+ 017:
+ 018: $s->SetBar('NewBar');
+
+Pretty simple! Thats really all there is to it. Set<Field>($) returns
+a boolean and a string describing the problem. Lets look at an example of
+what will happen if we try to set a 'Id' which we previously defined as
+read only.
+
+ 019: my ($res, $str) = $s->SetId('2');
+ 020: if (! $res) {
+ 021: ## Print the error!
+ 022: print "$str\n";
+ 023: }
+
+The output will be:
+
+ >> Immutable field
+
+Currently Set<Field> updates the data in the database as soon as you call
+it. In the future I hope to extend ::Record to better support transactional
+operations, such that updates will only happen when "you" say so.
+
+Finally, adding a removing records from the database. ::Record provides a
+Create method which simply takes a hash of key=>value pairs. The keys
+exactly map to database fields.
+
+ 023: ## Get a new record object.
+ 024: $s1 = Simple->new($handle);
+ 025: $s1->Create('Id' => 4,
+ 026: 'Foo' => 'Foooooo',
+ 027: 'Bar' => 'Barrrrr');
+
+Poof! A new row in the database has been created! Now lets delete the
+object!
+
+ 028:
+ 029: $s1 = undef;
+ 030: $s1 = Simple->new($handle);
+ 031: $s1->LoadById(4);
+ 032: $s1->Delete();
+
+And its gone.
+
+For simple use, thats more or less all there is to it. In the future, I hope to exapand
+this HowTo to discuss using container classes, overloading, and what
+ever else I think of.
+
+=head1 METHOD NAMING
+
+Each method has a lower case alias; '_' is used to separate words.
+For example, the method C<_PrimaryKeys> has the alias C<_primary_keys>.
+
+=head1 METHODS
+
+=cut
+
+
+
+=head2 new
+
+Instantiate a new record object.
+
+=cut
+
+
+sub new {
+ my $proto = shift;
+
+ my $class = ref($proto) || $proto;
+ my $self = {};
+ bless ($self, $class);
+ $self->_Init(@_);
+
+ return $self;
+ }
+
+
+# Not yet documented here. Should almost certainly be overloaded.
+sub _Init {
+ my $self = shift;
+ my $handle = shift;
+ $self->_Handle($handle);
+}
+
+
+=head2 id
+
+Returns this row's primary key.
+
+=cut
+
+
+
+*id = \&Id;
+
+sub Id {
+ my $pkey = $_[0]->_PrimaryKey();
+ my $ret = $_[0]->{'values'}->{$pkey};
+ return $ret;
+}
+
+
+=head2 primary_keys
+
+=head2 PrimaryKeys
+
+Return a hash of the values of our primary keys for this function.
+
+=cut
+
+
+
+
+sub PrimaryKeys {
+ my $self = shift;
+ my %hash = map { $_ => $self->{'values'}->{$_} } @{$self->_PrimaryKeys};
+ return (%hash);
+}
+
+
+
+
+sub DESTROY {
+ return 1;
+}
+
+
+sub AUTOLOAD {
+ my $self = $_[0];
+
+ no strict 'refs';
+ my ($Attrib) = ( $AUTOLOAD =~ /::(\w+)$/o );
+
+ if ( $self->_Accessible( $Attrib, 'read' ) ) {
+ *{$AUTOLOAD} = sub { return ( $_[0]->_Value($Attrib) ) };
+ goto &$AUTOLOAD;
+ }
+ elsif ( $self->_Accessible( $Attrib, 'record-read') ) {
+ *{$AUTOLOAD} = sub { $_[0]->_ToRecord( $Attrib, $_[0]->_Value($Attrib) ) };
+ goto &$AUTOLOAD;
+ }
+ elsif ( $self->_Accessible( $Attrib, 'foreign-collection') ) {
+ *{$AUTOLOAD} = sub { $_[0]->_CollectionValue( $Attrib ) };
+ goto &$AUTOLOAD;
+ }
+ elsif ( $AUTOLOAD =~ /.*::[sS]et_?(\w+)/o ) {
+ $Attrib = $1;
+
+ if ( $self->_Accessible( $Attrib, 'write' ) ) {
+ *{$AUTOLOAD} = sub {
+ return ( $_[0]->_Set( Field => $Attrib, Value => $_[1] ) );
+ };
+ goto &$AUTOLOAD;
+ } elsif ( $self->_Accessible( $Attrib, 'record-write') ) {
+ *{$AUTOLOAD} = sub {
+ my $self = shift;
+ my $val = shift;
+
+ $val = $val->id if UNIVERSAL::isa($val, 'Jifty::DBI::Record');
+ return ( $self->_Set( Field => $Attrib, Value => $val ) );
+ };
+ goto &$AUTOLOAD;
+ }
+ elsif ( $self->_Accessible( $Attrib, 'read' ) ) {
+ *{$AUTOLOAD} = sub { return ( 0, 'Immutable field' ) };
+ goto &$AUTOLOAD;
+ }
+ else {
+ return ( 0, 'Nonexistant field?' );
+ }
+ }
+ elsif ( $AUTOLOAD =~ /.*::(\w+?)_?[oO]bj$/o ) {
+ $Attrib = $1;
+ if ( $self->_Accessible( $Attrib, 'object' ) ) {
+ *{$AUTOLOAD} = sub {
+ return (shift)->_Object(
+ Field => $Attrib,
+ Args => [@_],
+ );
+ };
+ goto &$AUTOLOAD;
+ }
+ else {
+ return ( 0, 'No object mapping for field' );
+ }
+ }
+
+ #Previously, I checked for writability here. but I'm not sure that's the
+ #right idea. it breaks the ability to do ValidateQueue for a ticket
+ #on creation.
+
+ elsif ( $AUTOLOAD =~ /.*::[vV]alidate_?(\w+)/o ) {
+ $Attrib = $1;
+
+ *{$AUTOLOAD} = sub { return ( $_[0]->_Validate( $Attrib, $_[1] ) ) };
+ goto &$AUTOLOAD;
+ }
+
+ # TODO: if autoload = 0 or 1 _ then a combination of lowercase and _ chars,
+ # turn them into studlycapped phrases
+
+ else {
+ my ( $package, $filename, $line );
+ ( $package, $filename, $line ) = caller;
+
+ die "$AUTOLOAD Unimplemented in $package. ($filename line $line) \n";
+ }
+
+}
+
+
+
+=head2 _Accessible KEY MODE
+
+Private method.
+
+Returns undef unless C<KEY> is accessible in C<MODE> otherwise returns C<MODE> value
+
+=cut
+
+
+sub _Accessible {
+ my $self = shift;
+ my $attr = shift;
+ my $mode = lc(shift || '');
+
+ my $attribute = $self->_ClassAccessible(@_)->{$attr};
+ return unless defined $attribute;
+ return $attribute->{$mode};
+}
+
+
+
+=head2 _PrimaryKeys
+
+Return our primary keys. (Subclasses should override this, but our default is that we have one primary key, named 'id'.)
+
+=cut
+
+sub _PrimaryKeys {
+ my $self = shift;
+ return ['id'];
+}
+
+
+sub _PrimaryKey {
+ my $self = shift;
+ my $pkeys = $self->_PrimaryKeys();
+ die "No primary key" unless ( ref($pkeys) eq 'ARRAY' and $pkeys->[0] );
+ die "Too many primary keys" unless ( scalar(@$pkeys) == 1 );
+ return $pkeys->[0];
+}
+
+
+=head2 _ClassAccessible
+
+An older way to specify fields attributes in a derived class.
+(The current preferred method is by overriding C<Schema>; if you do
+this and don't override C<_ClassAccessible>, the module will generate
+an appropriate C<_ClassAccessible> based on your C<Schema>.)
+
+Here's an example declaration:
+
+ sub _ClassAccessible {
+ {
+ Tofu => { 'read'=>1, 'write'=>1 },
+ Maz => { 'auto'=>1, },
+ Roo => { 'read'=>1, 'auto'=>1, 'public'=>1, },
+ };
+ }
+
+=cut
+
+
+sub _ClassAccessible {
+ my $self = shift;
+
+ return $self->_ClassAccessibleFromSchema if $self->can('Schema');
+
+ # XXX This is stub code to deal with the old way we used to do _Accessible
+ # It should never be called by modern code
+
+ my %accessible;
+ while ( my $col = shift ) {
+ $accessible{$col}->{lc($_)} = 1
+ foreach split(/[\/,]/, shift);
+ }
+ return(\%accessible);
+}
+
+sub _ClassAccessibleFromSchema {
+ my $self = shift;
+
+ my $accessible = {};
+ foreach my $key ($self->_PrimaryKeys) {
+ $accessible->{$key} = { 'read' => 1 };
+ };
+
+ my $schema = $self->Schema;
+
+ for my $field (keys %$schema) {
+ if ($schema->{$field}{'TYPE'}) {
+ $accessible->{$field} = { 'read' => 1, 'write' => 1 };
+ } elsif (my $refclass = $schema->{$field}{'REFERENCES'}) {
+ if (UNIVERSAL::isa($refclass, 'Jifty::DBI::Record')) {
+ $accessible->{$field} = { 'record-read' => 1, 'record-write' => 1 };
+ } elsif (UNIVERSAL::isa($refclass, 'Jifty::DBI::Collection')) {
+ $accessible->{$field} = { 'foreign-collection' => 1 };
+ } else {
+ warn "Error: $refclass neither Record nor Collection";
+ }
+ }
+ }
+
+ return $accessible;
+}
+
+
+sub _ToRecord {
+ my $self = shift;
+ my $field = shift;
+ my $value = shift;
+
+ return unless defined $value;
+
+ my $schema = $self->Schema;
+ my $description = $schema->{$field};
+
+ return unless $description;
+
+ return $value unless $description->{'REFERENCES'};
+
+ my $classname = $description->{'REFERENCES'};
+
+ return unless UNIVERSAL::isa($classname, 'Jifty::DBI::Record');
+
+ # XXX TODO FIXME perhaps this is not what should be passed to new, but it needs it
+ my $object = $classname->new( $self->_Handle );
+ $object->LoadById( $value );
+ return $object;
+}
+
+sub _CollectionValue {
+ my $self = shift;
+
+ my $method_name = shift;
+ return unless defined $method_name;
+
+ my $schema = $self->Schema;
+ my $description = $schema->{$method_name};
+ return unless $description;
+
+ my $classname = $description->{'REFERENCES'};
+
+ return unless UNIVERSAL::isa($classname, 'Jifty::DBI::Collection');
+
+ my $coll = $classname->new( Handle => $self->_Handle );
+
+ $coll->Limit( FIELD => $description->{'KEY'}, VALUE => $self->id);
+
+ return $coll;
+}
+
+# sub {{{ ReadableAttributes
+
+=head2 ReadableAttributes
+
+Returns an array of the attributes of this class defined as "read" => 1 in this class' _ClassAccessible datastructure
+
+=cut
+
+sub ReadableAttributes {
+ my $self = shift;
+ my $ca = $self->_ClassAccessible();
+ my @readable = grep { $ca->{$_}->{'read'} or $ca->{$_}->{'record-read'} } keys %{$ca};
+ return (@readable);
+}
+
+
+
+=head2 WritableAttributes
+
+Returns an array of the attributes of this class defined as "write" => 1 in this class' _ClassAccessible datastructure
+
+=cut
+
+sub WritableAttributes {
+ my $self = shift;
+ my $ca = $self->_ClassAccessible();
+ my @writable = grep { $ca->{$_}->{'write'} || $ca->{$_}->{'record-write'} } keys %{$ca};
+ return @writable;
+}
+
+
+
+
+=head2 __Value
+
+Takes a field name and returns that field's value. Subclasses should never
+override __Value.
+
+=cut
+
+
+sub __Value {
+ my $self = shift;
+ my $field = lc shift;
+
+ if (!$self->{'fetched'}{$field} and my $id = $self->id() ) {
+ my $pkey = $self->_PrimaryKey();
+ my $QueryString = "SELECT $field FROM " . $self->Table . " WHERE $pkey = ?";
+ my $sth = $self->_Handle->SimpleQuery( $QueryString, $id );
+ my ($value) = eval { $sth->fetchrow_array() };
+ warn $@ if $@;
+
+ $self->{'values'}{$field} = $value;
+ $self->{'fetched'}{$field} = 1;
+ }
+
+ my $value = $self->{'values'}{$field};
+
+ return $value;
+}
+
+=head2 _Value
+
+_Value takes a single column name and returns that column's value for this row.
+Subclasses can override _Value to insert custom access control.
+
+=cut
+
+
+sub _Value {
+ my $self = shift;
+ return ($self->__Value(@_));
+}
+
+
+
+=head2 _Set
+
+_Set takes a single column name and a single unquoted value.
+It updates both the in-memory value of this column and the in-database copy.
+Subclasses can override _Set to insert custom access control.
+
+=cut
+
+
+sub _Set {
+ my $self = shift;
+ return ($self->__Set(@_));
+}
+
+
+
+
+sub __Set {
+ my $self = shift;
+
+ my %args = (
+ 'Field' => undef,
+ 'Value' => undef,
+ 'IsSQL' => undef,
+ @_
+ );
+
+ $args{'Column'} = delete $args{'Field'};
+ $args{'IsSQLFunction'} = delete $args{'IsSQL'};
+
+ my $ret = Class::ReturnValue->new();
+
+ unless ( $args{'Column'} ) {
+ $ret->as_array( 0, 'No column specified' );
+ $ret->as_error(
+ errno => 5,
+ do_backtrace => 0,
+ message => "No column specified"
+ );
+ return ( $ret->return_value );
+ }
+ my $column = lc $args{'Column'};
+ if ( !defined( $args{'Value'} ) ) {
+ $ret->as_array( 0, "No value passed to _Set" );
+ $ret->as_error(
+ errno => 2,
+ do_backtrace => 0,
+ message => "No value passed to _Set"
+ );
+ return ( $ret->return_value );
+ }
+ elsif ( ( defined $self->__Value($column) )
+ and ( $args{'Value'} eq $self->__Value($column) ) )
+ {
+ $ret->as_array( 0, "That is already the current value" );
+ $ret->as_error(
+ errno => 1,
+ do_backtrace => 0,
+ message => "That is already the current value"
+ );
+ return ( $ret->return_value );
+ }
+
+
+
+ # First, we truncate the value, if we need to.
+ #
+
+
+ $args{'Value'} = $self->TruncateValue ( $args{'Column'}, $args{'Value'});
+
+
+ my $method = "Validate" . $args{'Column'};
+ unless ( $self->$method( $args{'Value'} ) ) {
+ $ret->as_array( 0, 'Illegal value for ' . $args{'Column'} );
+ $ret->as_error(
+ errno => 3,
+ do_backtrace => 0,
+ message => "Illegal value for " . $args{'Column'}
+ );
+ return ( $ret->return_value );
+ }
+
+ $args{'Table'} = $self->Table();
+ $args{'PrimaryKeys'} = { $self->PrimaryKeys() };
+
+ # The blob handling will destroy $args{'Value'}. But we assign
+ # that back to the object at the end. this works around that
+ my $unmunged_value = $args{'Value'};
+
+ unless ( $self->_Handle->KnowsBLOBs ) {
+ # Support for databases which don't deal with LOBs automatically
+ my $ca = $self->_ClassAccessible();
+ my $key = $args{'Column'};
+ if ( $ca->{$key}->{'type'} =~ /^(text|longtext|clob|blob|lob)$/i ) {
+ my $bhash = $self->_Handle->BLOBParams( $key, $ca->{$key}->{'type'} );
+ $bhash->{'value'} = $args{'Value'};
+ $args{'Value'} = $bhash;
+ }
+ }
+
+
+ my $val = $self->_Handle->UpdateRecordValue(%args);
+ unless ($val) {
+ my $message =
+ $args{'Column'} . " could not be set to " . $args{'Value'} . "." ;
+ $ret->as_array( 0, $message);
+ $ret->as_error(
+ errno => 4,
+ do_backtrace => 0,
+ message => $message
+ );
+ return ( $ret->return_value );
+ }
+ # If we've performed some sort of "functional update"
+ # then we need to reload the object from the DB to know what's
+ # really going on. (ex SET Cost = Cost+5)
+ if ( $args{'IsSQLFunction'} ) {
+ $self->Load( $self->Id );
+ }
+ else {
+ $self->{'values'}->{"$column"} = $unmunged_value;
+ }
+ $ret->as_array( 1, "The new value has been set." );
+ return ( $ret->return_value );
+}
+
+=head2 _Canonicalize PARAMHASH
+
+This routine massages an input value (VALUE) for FIELD into something that's
+going to be acceptable.
+
+Takes
+
+=over
+
+=item FIELD
+
+=item VALUE
+
+=item FUNCTION
+
+=back
+
+
+Takes:
+
+=over
+
+=item FIELD
+
+=item VALUE
+
+=item FUNCTION
+
+=back
+
+Returns a replacement VALUE.
+
+=cut
+
+sub _Canonicalize {
+ my $self = shift;
+ my $field = shift;
+
+
+
+}
+
+
+=head2 _Validate FIELD VALUE
+
+Validate that VALUE will be an acceptable value for FIELD.
+
+Currently, this routine does nothing whatsoever.
+
+If it succeeds (which is always the case right now), returns true. Otherwise returns false.
+
+=cut
+
+
+
+
+sub _Validate {
+ my $self = shift;
+ my $field = shift;
+ my $value = shift;
+
+ #Check type of input
+ #If it's null, are nulls permitted?
+ #If it's an int, check the # of bits
+ #If it's a string,
+ #check length
+ #check for nonprintables
+ #If it's a blob, check for length
+ #In an ideal world, if this is a link to another table, check the dependency.
+ return(1);
+ }
+
+
+
+=head2 TruncateValue KEY VALUE
+
+Truncate a value that's about to be set so that it will fit inside the database'
+s idea of how big the column is.
+
+(Actually, it looks at SearchBuilder's concept of the database, not directly into the db).
+
+=cut
+
+sub TruncateValue {
+ my $self = shift;
+ my $key = shift;
+ my $value = shift;
+
+ # We don't need to truncate empty things.
+ return undef unless (defined ($value));
+
+ my $metadata = $self->_ClassAccessible->{$key};
+
+ my $truncate_to;
+ if ( $metadata->{'length'} && !$metadata->{'is_numeric'} ) {
+ $truncate_to = $metadata->{'length'};
+ }
+ elsif ($metadata->{'type'} && $metadata->{'type'} =~ /char\((\d+)\)/ ) {
+ $truncate_to = $1;
+ }
+
+ return ($value) unless ($truncate_to); # don't need to truncate
+
+ # Perl 5.6 didn't speak unicode
+ return substr( $value, 0, $truncate_to ) unless ( $] >= 5.007 );
+
+ require Encode;
+
+ if ( Encode::is_utf8($value) ) {
+ return Encode::decode(
+ utf8 => substr( Encode::encode( utf8 => $value ), 0, $truncate_to ),
+ Encode::FB_QUIET(),
+ );
+ }
+ else {
+ return Encode::encode(
+ utf8 => Encode::decode(
+ utf8 => substr( $value, 0, $truncate_to ),
+ Encode::FB_QUIET(),
+ )
+ );
+
+ }
+
+}
+
+
+=head2 _Object
+
+_Object takes a single column name and an array reference.
+It creates new object instance of class specified in _ClassAccessable
+structure and calls LoadById on recently created object with the
+current column value as argument. It uses the array reference as
+the object constructor's arguments.
+Subclasses can override _Object to insert custom access control or
+define default contructor arguments.
+
+Note that if you are using a C<Schema> with a C<REFERENCES> field,
+this is unnecessary: the method to access the column's value will
+automatically turn it into the appropriate object.
+
+=cut
+
+sub _Object {
+ my $self = shift;
+ return $self->__Object(@_);
+}
+
+sub __Object {
+ my $self = shift;
+ my %args = ( Field => '', Args => [], @_ );
+
+ my $field = $args{'Field'};
+ my $class = $self->_Accessible( $field, 'object' );
+
+ # Globs magic to be sure that we call 'eval "require $class"' only once
+ # because eval is quite slow -- cubic at acronis.ru
+ no strict qw( refs );
+ my $vglob = ${ $class . '::' }{'VERSION'};
+ unless ( $vglob && *$vglob{'SCALAR'} ) {
+ eval "require $class";
+ die "Couldn't use $class: $@" if ($@);
+ unless ( $vglob && *$vglob{'SCALAR'} ) {
+ *{ $class . "::VERSION" } = '-1, By DBIx::SerchBuilder';
+ }
+ }
+
+ my $object = $class->new( @{ $args{'Args'} } );
+ $object->LoadById( $self->__Value($field) );
+ return $object;
+}
+
+
+
+
+# load should do a bit of overloading
+# if we call it with only one argument, we're trying to load by reference.
+# if we call it with a passel of arguments, we're trying to load by value
+# The latter is primarily important when we've got a whole set of record that we're
+# reading in with a recordset class and want to instantiate objefcts for each record.
+
+=head2 Load
+
+Takes a single argument, $id. Calls LoadById to retrieve the row whose primary key
+is $id
+
+=cut
+
+
+
+sub Load {
+ my $self = shift;
+ # my ($package, $filename, $line) = caller;
+ return $self->LoadById(@_);
+}
+
+
+=head2 LoadByCol
+
+Takes two arguments, a column and a value. The column can be any table column
+which contains unique values. Behavior when using a non-unique value is
+undefined
+
+=cut
+
+
+
+sub LoadByCol {
+ my $self = shift;
+ my $col = shift;
+ my $val = shift;
+
+ return($self->LoadByCols($col => $val));
+}
+
+
+
+=head2 LoadByCols
+
+Takes a hash of columns and values. Loads the first record that matches all
+keys.
+
+The hash's keys are the columns to look at.
+
+The hash's values are either: scalar values to look for
+OR has references which contain 'operator' and 'value'
+
+=cut
+
+
+sub LoadByCols {
+ my $self = shift;
+ my %hash = (@_);
+ my (@bind, @phrases);
+ foreach my $key (keys %hash) {
+ if (defined $hash{$key} && $hash{$key} ne '') {
+ my $op;
+ my $value;
+ my $function = "?";
+ if (ref $hash{$key} eq 'HASH') {
+ $op = $hash{$key}->{operator};
+ $value = $hash{$key}->{value};
+ $function = $hash{$key}->{function} || "?";
+ } else {
+ $op = '=';
+ $value = $hash{$key};
+ }
+
+ push @phrases, "$key $op $function";
+ push @bind, $value;
+ }
+ else {
+ push @phrases, "($key IS NULL OR $key = ?)";
+ my $meta = $self->_ClassAccessible->{$key};
+ $meta->{'type'} ||= '';
+ # TODO: type checking should be done in generic way
+ if ( $meta->{'is_numeric'} || $meta->{'type'} =~ /INT|NUMERIC|DECIMAL|REAL|DOUBLE|FLOAT/i ) {
+ push @bind, 0;
+ } else {
+ push @bind, '';
+ }
+
+ }
+ }
+
+ my $QueryString = "SELECT * FROM ".$self->Table." WHERE ".
+ join(' AND ', @phrases) ;
+ return ($self->_LoadFromSQL($QueryString, @bind));
+}
+
+
+
+
+=head2 LoadById
+
+Loads a record by its primary key. Your record class must define a single primary key column.
+
+=cut
+
+
+sub LoadById {
+ my $self = shift;
+ my $id = shift;
+
+ $id = 0 if (!defined($id));
+ my $pkey = $self->_PrimaryKey();
+ return ($self->LoadByCols($pkey => $id));
+}
+
+
+
+
+=head2 LoadByPrimaryKeys
+
+Like LoadById with basic support for compound primary keys.
+
+=cut
+
+
+
+sub LoadByPrimaryKeys {
+ my $self = shift;
+ my $data = (ref $_[0] eq 'HASH')? $_[0]: {@_};
+
+ my %cols=();
+ foreach (@{$self->_PrimaryKeys}) {
+ return (0, "Missing PK field: '$_'") unless defined $data->{$_};
+ $cols{$_}=$data->{$_};
+ }
+ return ($self->LoadByCols(%cols));
+}
+
+
+
+
+=head2 LoadFromHash
+
+Takes a hashref, such as created by Jifty::DBI and populates this record's
+loaded values hash.
+
+=cut
+
+
+
+sub LoadFromHash {
+ my $self = shift;
+ my $hashref = shift;
+
+ foreach my $f ( keys %$hashref ) {
+ $self->{'fetched'}{lc $f} = 1;
+ }
+
+ $self->{'values'} = $hashref;
+ return $self->id();
+}
+
+
+
+=head2 _LoadFromSQL QUERYSTRING @BIND_VALUES
+
+Load a record as the result of an SQL statement
+
+=cut
+
+
+
+
+sub _LoadFromSQL {
+ my $self = shift;
+ my $QueryString = shift;
+ my @bind_values = (@_);
+
+ my $sth = $self->_Handle->SimpleQuery( $QueryString, @bind_values );
+
+ #TODO this only gets the first row. we should check if there are more.
+
+ return ( 0, "Couldn't execute query" ) unless $sth;
+
+ $self->{'values'} = $sth->fetchrow_hashref;
+ $self->{'fetched'} = {};
+ if ( !$self->{'values'} && $sth->err ) {
+ return ( 0, "Couldn't fetch row: ". $sth->err );
+ }
+
+ unless ( $self->{'values'} ) {
+ return ( 0, "Couldn't find row" );
+ }
+
+ ## I guess to be consistant with the old code, make sure the primary
+ ## keys exist.
+
+ if( grep { not defined } $self->PrimaryKeys ) {
+ return ( 0, "Missing a primary key?" );
+ }
+
+ foreach my $f ( keys %{$self->{'values'}} ) {
+ $self->{'fetched'}{lc $f} = 1;
+ }
+ return ( 1, "Found Object" );
+
+}
+
+
+
+
+
+=head2 Create
+
+Takes an array of key-value pairs and drops any keys that aren't known
+as columns for this recordtype
+
+=cut
+
+
+
+sub Create {
+ my $self = shift;
+ my %attribs = @_;
+
+ my ($key);
+ foreach $key ( keys %attribs ) {
+
+ if ( $self->_Accessible( $key, 'record-write' ) ) {
+ $attribs{$key} = $attribs{$key}->id
+ if UNIVERSAL::isa( $attribs{$key},
+ 'Jifty::DBI::Record' );
+ }
+
+ #Truncate things that are too long for their datatypes
+ $attribs{$key} = $self->TruncateValue( $key => $attribs{$key} );
+
+ }
+ unless ( $self->_Handle->KnowsBLOBs ) {
+
+ # Support for databases which don't deal with LOBs automatically
+ my $ca = $self->_ClassAccessible();
+ foreach $key ( keys %attribs ) {
+ if ( $ca->{$key}->{'type'} =~ /^(text|longtext|clob|blob|lob)$/i ) {
+ my $bhash =
+ $self->_Handle->BLOBParams( $key, $ca->{$key}->{'type'} );
+ $bhash->{'value'} = $attribs{$key};
+ $attribs{$key} = $bhash;
+ }
+ }
+ }
+ return ( $self->_Handle->Insert( $self->Table, %attribs ) );
+}
+
+
+=head2 Delete
+
+Delete this record from the database. On failure return a Class::ReturnValue with the error. On success, return 1;
+
+=cut
+
+*delete = \&Delete;
+
+sub Delete {
+ $_[0]->__Delete;
+}
+
+sub __Delete {
+ my $self = shift;
+
+ #TODO Check to make sure the key's not already listed.
+ #TODO Update internal data structure
+
+ ## Constructs the where clause.
+ my @bind=();
+ my %pkeys=$self->PrimaryKeys();
+ my $where = 'WHERE ';
+ foreach my $key (keys %pkeys) {
+ $where .= $key . "=?" . " AND ";
+ push (@bind, $pkeys{$key});
+ }
+
+ $where =~ s/AND\s$//;
+ my $QueryString = "DELETE FROM ". $self->Table . ' ' . $where;
+ my $return = $self->_Handle->SimpleQuery($QueryString, @bind);
+
+ if (UNIVERSAL::isa('Class::ReturnValue', $return)) {
+ return ($return);
+ } else {
+ return(1);
+ }
+}
+
+
+
+
+
+=head2 Table
+
+Returns or sets the name of the current Table
+
+=cut
+
+
+
+sub Table {
+ my $self = shift;
+ if (@_) {
+ $self->{'table'} = shift;
+ }
+ return ($self->{'table'});
+}
+
+
+
+=head2 _Handle
+
+Returns or sets the current Jifty::DBI::Handle object
+
+=cut
+
+
+sub _Handle {
+ my $self = shift;
+ if (@_) {
+ $self->{'DBIxHandle'} = shift;
+ }
+ return ($self->{'DBIxHandle'});
+ }
+
+
+if( eval { require capitalization } ) {
+ capitalization->unimport( __PACKAGE__ );
+}
+
+1;
+
+__END__
+
+
+
+=head1 AUTHOR
+
+Jesse Vincent, <jesse at fsck.com>
+
+Enhancements by Ivan Kohler, <ivan-rt at 420.am>
+
+Docs by Matt Knopp <mhat at netlag.com>
+
+=head1 SEE ALSO
+
+L<Jifty::DBI>
+
+=cut
+
+
Added: Jifty-DBI/trunk/lib/Jifty/DBI/Record/Cachable.pm
==============================================================================
--- (empty file)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Record/Cachable.pm Sun Jul 24 21:04:49 2005
@@ -0,0 +1,358 @@
+# $Header: /home/jesse/DBIx-SearchBuilder/history/SearchBuilder/Record/Cachable.pm,v 1.6 2001/06/19 04:22:32 jesse Exp $
+# by Matt Knopp <mhat at netlag.com>
+
+package Jifty::DBI::Record::Cachable;
+
+use Jifty::DBI::Record;
+use Jifty::DBI::Handle;
+ at ISA = qw (Jifty::DBI::Record);
+
+use Cache::Simple::TimedExpiry;
+
+use strict;
+
+
+=head1 NAME
+
+Jifty::DBI::Record::Cachable - Records with caching behavior
+
+=head1 SYNOPSIS
+
+ package MyRecord;
+ use base qw/Jifty::DBI::Record::Cachable/;
+
+=head1 DESCRIPTION
+
+This module subclasses the main Jifty::DBI::Record package to add a caching layer.
+
+The public interface remains the same, except that records which have been loaded in the last few seconds may be reused by subsequent fetch or load methods without retrieving them from the database.
+
+=head1 METHODS
+
+=cut
+
+
+my %_CACHES = ();
+
+# Function: new
+# Type : class ctor
+# Args : see Jifty::DBI::Record::new
+# Lvalue : Jifty::DBI::Record::Cachable
+
+sub new () {
+ my ( $class, @args ) = @_;
+ my $self = $class->SUPER::new(@args);
+
+ return ($self);
+}
+
+sub _SetupCache {
+ my $self = shift;
+ my $cache = shift;
+ $_CACHES{$cache} = Cache::Simple::TimedExpiry->new();
+ $_CACHES{$cache}->expire_after( $self->_CacheConfig->{'cache_for_sec'} );
+}
+
+=head2 FlushCache
+
+This class method flushes the _global_ Jifty::DBI::Record::Cachable
+cache. All caches are immediately expired.
+
+=cut
+
+sub FlushCache {
+ %_CACHES = ();
+}
+
+
+sub _KeyCache {
+ my $self = shift;
+ my $cache = $self->_Handle->DSN . "-KEYS--" . ($self->{'_Class'} ||= ref($self));
+ $self->_SetupCache($cache) unless exists ($_CACHES{$cache});
+ return ($_CACHES{$cache});
+
+}
+
+=head2 _FlushKeyCache
+
+Blow away this record type's key cache
+
+=cut
+
+
+sub _FlushKeyCache {
+ my $self = shift;
+ my $cache = $self->_Handle->DSN . "-KEYS--" . ($self->{'_Class'} ||= ref($self));
+ $self->_SetupCache($cache);
+}
+
+sub _RecordCache {
+ my $self = shift;
+ my $cache = $self->_Handle->DSN . "--" . ($self->{'_Class'} ||= ref($self));
+ $self->_SetupCache($cache) unless exists ($_CACHES{$cache});
+ return ($_CACHES{$cache});
+
+}
+
+# Function: LoadFromHash
+# Type : (overloaded) public instance
+# Args : See Jifty::DBI::Record::LoadFromHash
+# Lvalue : array(boolean, message)
+
+sub LoadFromHash {
+ my $self = shift;
+
+ # Blow away the primary cache key since we're loading.
+ $self->{'_SB_Record_Primary_RecordCache_key'} = undef;
+ my ( $rvalue, $msg ) = $self->SUPER::LoadFromHash(@_);
+
+ my $cache_key = $self->_primary_RecordCache_key();
+
+ ## Check the return value, if its good, cache it!
+ if ($rvalue) {
+ $self->_store();
+ }
+
+ return ( $rvalue, $msg );
+}
+
+# Function: LoadByCols
+# Type : (overloaded) public instance
+# Args : see Jifty::DBI::Record::LoadByCols
+# Lvalue : array(boolean, message)
+
+sub LoadByCols {
+ my ( $self, %attr ) = @_;
+
+ ## Generate the cache key
+ my $alt_key = $self->_gen_alternate_RecordCache_key(%attr);
+ if ( $self->_fetch( $self->_lookup_primary_RecordCache_key($alt_key) ) ) {
+ return ( 1, "Fetched from cache" );
+ }
+
+ # Blow away the primary cache key since we're loading.
+ $self->{'_SB_Record_Primary_RecordCache_key'} = undef;
+
+ ## Fetch from the DB!
+ my ( $rvalue, $msg ) = $self->SUPER::LoadByCols(%attr);
+ ## Check the return value, if its good, cache it!
+ if ($rvalue) {
+ ## Only cache the object if its okay to do so.
+ $self->_store();
+ $self->_KeyCache->set( $alt_key, $self->_primary_RecordCache_key);
+
+ }
+ return ( $rvalue, $msg );
+
+}
+
+# Function: __Set
+# Type : (overloaded) public instance
+# Args : see Jifty::DBI::Record::_Set
+# Lvalue : ?
+
+sub __Set () {
+ my ( $self, %attr ) = @_;
+
+ $self->_expire();
+ return $self->SUPER::__Set(%attr);
+
+}
+
+# Function: Delete
+# Type : (overloaded) public instance
+# Args : nil
+# Lvalue : ?
+
+sub __Delete () {
+ my ($self) = @_;
+
+ $self->_expire();
+
+ return $self->SUPER::__Delete();
+
+}
+
+# Function: _expire
+# Type : private instance
+# Args : string(cache_key)
+# Lvalue : 1
+# Desc : Removes this object from the cache.
+
+sub _expire (\$) {
+ my $self = shift;
+ $self->_RecordCache->set( $self->_primary_RecordCache_key , undef, time-1);
+ # We should be doing something more surgical to clean out the key cache. but we do need to expire it
+ $self->_FlushKeyCache;
+
+}
+
+# Function: _fetch
+# Type : private instance
+# Args : string(cache_key)
+# Lvalue : 1
+# Desc : Get an object from the cache, and make this object that.
+
+sub _fetch () {
+ my ( $self, $cache_key ) = @_;
+ my $data = $self->_RecordCache->fetch($cache_key) or return;
+
+ @{$self}{keys %$data} = values %$data; # deserialize
+ return 1;
+
+}
+
+
+sub __Value {
+ my $self = shift;
+ my $field = shift;
+ return ( $self->SUPER::__Value($field) );
+}
+
+# Function: _store
+# Type : private instance
+# Args : string(cache_key)
+# Lvalue : 1
+# Desc : Stores this object in the cache.
+
+sub _store (\$) {
+ my $self = shift;
+ $self->_RecordCache->set( $self->_primary_RecordCache_key, $self->_serialize);
+ return (1);
+}
+
+sub _serialize {
+ my $self = shift;
+ return (
+ {
+ values => $self->{'values'},
+ table => $self->Table,
+ fetched => $self->{'fetched'}
+ }
+ );
+}
+
+# Function: _gen_alternate_RecordCache_key
+# Type : private instance
+# Args : hash (attr)
+# Lvalue : 1
+# Desc : Takes a perl hash and generates a key from it.
+
+sub _gen_alternate_RecordCache_key {
+ my ( $self, %attr ) = @_;
+ #return( Storable::nfreeze( %attr));
+ my $cache_key;
+ while ( my ( $key, $value ) = each %attr ) {
+ $key ||= '__undef';
+ $value ||= '__undef';
+
+ if ( ref($value) eq "HASH" ) {
+ $value = ( $value->{operator} || '=' ) . $value->{value};
+ }
+ else {
+ $value = "=" . $value;
+ }
+ $cache_key .= $key . $value . ',';
+ }
+ chop($cache_key);
+ return ($cache_key);
+}
+
+# Function: _fetch_RecordCache_key
+# Type : private instance
+# Args : nil
+# Lvalue : 1
+
+sub _fetch_RecordCache_key {
+ my ($self) = @_;
+ my $cache_key = $self->_CacheConfig->{'cache_key'};
+ return ($cache_key);
+}
+
+# Function: _primary_RecordCache_key
+# Type : private instance
+# Args : none
+# Lvalue: : 1
+# Desc : generate a primary-key based variant of this object's cache key
+# primary keys is in the cache
+
+sub _primary_RecordCache_key {
+ my ($self) = @_;
+
+ return undef unless ( $self->Id );
+
+ unless ( $self->{'_SB_Record_Primary_RecordCache_key'} ) {
+
+ my $primary_RecordCache_key = $self->Table() . ':';
+ my @attributes;
+ foreach my $key ( @{ $self->_PrimaryKeys } ) {
+ push @attributes, $key . '=' . $self->SUPER::__Value($key);
+ }
+
+ $primary_RecordCache_key .= join( ',', @attributes );
+
+ $self->{'_SB_Record_Primary_RecordCache_key'} = $primary_RecordCache_key;
+ }
+ return ( $self->{'_SB_Record_Primary_RecordCache_key'} );
+
+}
+
+# Function: lookup_primary_RecordCache_key
+# Type : private class
+# Args : string(alternate cache id)
+# Lvalue : string(cache id)
+sub _lookup_primary_RecordCache_key {
+ my $self = shift;
+ my $alternate_key = shift;
+ return undef unless ($alternate_key);
+
+ my $primary_key = $self->_KeyCache->fetch($alternate_key);
+ if ($primary_key) {
+ return ($primary_key);
+ }
+
+ # If the alternate key is really the primary one
+ elsif ( $self->_RecordCache->fetch($alternate_key) ) {
+ return ($alternate_key);
+ }
+ else { # empty!
+ return (undef);
+ }
+
+}
+
+=head2 _CacheConfig
+
+You can override this method to change the duration of the caching from the default of 5 seconds.
+
+For example, to cache records for up to 30 seconds, add the following method to your class:
+
+ sub _CacheConfig {
+ { 'cache_for_sec' => 30 }
+ }
+
+=cut
+
+sub _CacheConfig {
+ {
+ 'cache_p' => 1,
+ 'cache_for_sec' => 5,
+ };
+}
+
+1;
+
+__END__
+
+
+=head1 AUTHOR
+
+Matt Knopp <mhat at netlag.com>
+
+=head1 SEE ALSO
+
+L<Jifty::DBI>, L<Jifty::DBI::Record>
+
+=cut
+
+
Added: Jifty-DBI/trunk/lib/Jifty/DBI/SchemaGenerator.pm
==============================================================================
--- (empty file)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/SchemaGenerator.pm Sun Jul 24 21:04:49 2005
@@ -0,0 +1,306 @@
+use strict;
+use warnings;
+
+package Jifty::DBI::SchemaGenerator;
+
+use base qw(Class::Accessor);
+use DBIx::DBSchema;
+use Class::ReturnValue;
+
+# Public accessors
+__PACKAGE__->mk_accessors(qw(handle));
+# Internal accessors: do not use from outside class
+__PACKAGE__->mk_accessors(qw(_db_schema));
+
+=head2 new HANDLE
+
+Creates a new C<Jifty::DBI::SchemaGenerator> object. The single
+required argument is a C<Jifty::DBI::Handle>.
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $handle = shift;
+ my $self = $class->SUPER::new();
+
+ $self->handle($handle);
+
+ my $schema = DBIx::DBSchema->new;
+ $self->_db_schema($schema);
+
+ return $self;
+}
+
+=for public_doc AddModel MODEL
+
+Adds a new model class to the SchemaGenerator. Model should either be an object
+of a subclass of C<Jifty::DBI::Record>, or the name of such a subclass; in the
+latter case, C<AddModel> will instantiate an object of the subclass.
+
+The model must define the instance methods C<Schema> and C<Table>.
+
+Returns true if the model was added successfully; returns a false C<Class::ReturnValue> error
+otherwise.
+
+=cut
+
+sub AddModel {
+ my $self = shift;
+ my $model = shift;
+
+ # $model could either be a (presumably unfilled) object of a subclass of
+ # Jifty::DBI::Record, or it could be the name of such a subclass.
+
+ unless (ref $model and UNIVERSAL::isa($model, 'Jifty::DBI::Record')) {
+ my $new_model;
+ eval { $new_model = $model->new; };
+
+ if ($@) {
+ return $self->_error("Error making new object from $model: $@");
+ }
+
+ return $self->_error("Didn't get a Jifty::DBI::Record from $model, got $new_model")
+ unless UNIVERSAL::isa($new_model, 'Jifty::DBI::Record');
+
+ $model = $new_model;
+ }
+
+ my $table_obj = $self->_DBSchemaTableFromModel($model);
+
+ $self->_db_schema->addtable($table_obj);
+
+ 1;
+}
+
+=for public_doc CreateTableSQLStatements
+
+Returns a list of SQL statements (as strings) to create tables for all of
+the models added to the SchemaGenerator.
+
+=cut
+
+sub CreateTableSQLStatements {
+ my $self = shift;
+ # The sort here is to make it predictable, so that we can write tests.
+ return sort $self->_db_schema->sql($self->handle->dbh);
+}
+
+=for public_doc CreateTableSQLText
+
+Returns a string containg a sequence of SQL statements to create tables for all of
+the models added to the SchemaGenerator.
+
+=cut
+
+sub CreateTableSQLText {
+ my $self = shift;
+
+ return join "\n", map { "$_ ;\n" } $self->CreateTableSQLStatements;
+}
+
+=for private_doc _DBSchemaTableFromModel MODEL
+
+Takes an object of a subclass of Jifty::DBI::Record; returns a new
+C<DBIx::DBSchema::Table> object corresponding to the model.
+
+=cut
+
+sub _DBSchemaTableFromModel {
+ my $self = shift;
+ my $model = shift;
+
+ my $table_name = $model->Table;
+ my $schema = $model->Schema;
+
+ my $primary = "id"; # TODO allow override
+ my $primary_col = DBIx::DBSchema::Column->new({
+ name => $primary,
+ type => 'serial',
+ null => 'NOT NULL',
+ });
+
+ my @cols = ($primary_col);
+
+ # The sort here is to make it predictable, so that we can write tests.
+ for my $field (sort keys %$schema) {
+ # Skip foreign keys
+
+ next if defined $schema->{$field}->{'REFERENCES'} and defined $schema->{$field}->{'KEY'};
+
+ # TODO XXX FIXME
+ # In lieu of real reference support, make references just integers
+ $schema->{$field}{'TYPE'} = 'integer' if $schema->{$field}{'REFERENCES'};
+
+ push @cols, DBIx::DBSchema::Column->new({
+ name => $field,
+ type => $schema->{$field}{'TYPE'},
+ null => 'NULL',
+ default => $schema->{$field}{'DEFAULT'},
+ });
+ }
+
+ my $table = DBIx::DBSchema::Table->new({
+ name => $table_name,
+ primary_key => $primary,
+ columns => \@cols,
+ });
+
+ return $table;
+}
+
+=for private_doc _error STRING
+
+Takes in a string and returns it as a Class::ReturnValue error object.
+
+=cut
+
+sub _error {
+ my $self = shift;
+ my $message = shift;
+
+ my $ret = Class::ReturnValue->new;
+ $ret->as_error(errno => 1, message => $message);
+ return $ret->return_value;
+}
+
+
+1; # Magic true value required at end of module
+__END__
+
+=head1 NAME
+
+Jifty::DBI::SchemaGenerator - Generate table schemas from Jifty::DBI records
+
+=head1 SYNOPSIS
+
+ use Jifty::DBI::SchemaGenerator;
+
+
+=head1 DESCRIPTION
+
+=for author to fill in:
+ Write a full description of the module and its features here.
+ Use subsections (=head2, =head3) as appropriate.
+
+
+=head1 INTERFACE
+
+=for author to fill in:
+ Write a separate section listing the public components of the modules
+ interface. These normally consist of either subroutines that may be
+ exported, or methods that may be called on objects belonging to the
+ classes provided by the module.
+
+
+=head1 DIAGNOSTICS
+
+=for author to fill in:
+ List every single error and warning message that the module can
+ generate (even the ones that will "never happen"), with a full
+ explanation of each problem, one or more likely causes, and any
+ suggested remedies.
+
+=over
+
+=item C<< Error message here, perhaps with %s placeholders >>
+
+[Description of error here]
+
+=item C<< Another error message here >>
+
+[Description of error here]
+
+[Et cetera, et cetera]
+
+=back
+
+
+=head1 CONFIGURATION AND ENVIRONMENT
+
+=for author to fill in:
+ A full explanation of any configuration system(s) used by the
+ module, including the names and locations of any configuration
+ files, and the meaning of any environment variables or properties
+ that can be set. These descriptions must also include details of any
+ configuration language used.
+
+<MODULE NAME> requires no configuration files or environment variables.
+
+
+=head1 DEPENDENCIES
+
+=for author to fill in:
+ A list of all the other modules that this module relies upon,
+ including any restrictions on versions, and an indication whether
+ the module is part of the standard Perl distribution, part of the
+ module's distribution, or must be installed separately. ]
+
+None.
+
+
+=head1 INCOMPATIBILITIES
+
+=for author to fill in:
+ A list of any modules that this module cannot be used in conjunction
+ with. This may be due to name conflicts in the interface, or
+ competition for system or program resources, or due to internal
+ limitations of Perl (for example, many modules that use source code
+ filters are mutually incompatible).
+
+None reported.
+
+
+=head1 BUGS AND LIMITATIONS
+
+=for author to fill in:
+ A list of known problems with the module, together with some
+ indication Whether they are likely to be fixed in an upcoming
+ release. Also a list of restrictions on the features the module
+ does provide: data types that cannot be handled, performance issues
+ and the circumstances in which they may arise, practical
+ limitations on the size of data sets, special cases that are not
+ (yet) handled, etc.
+
+No bugs have been reported.
+
+Please report any bugs or feature requests to
+C<bug-<RT NAME>@rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org>.
+
+
+=head1 AUTHOR
+
+David Glasser C<< glasser at bestpractical.com >>
+
+
+=head1 LICENCE AND COPYRIGHT
+
+Copyright (c) <YEAR>, <AUTHOR> C<< <<EMAIL>> >>. All rights reserved.
+
+This module is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself. See L<perlartistic>.
+
+
+=head1 DISCLAIMER OF WARRANTY
+
+BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
+EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
+ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
+YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
+NECESSARY SERVICING, REPAIR, OR CORRECTION.
+
+IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
+LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
+OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
+THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
+FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
Added: Jifty-DBI/trunk/lib/Jifty/DBI/Union.pm
==============================================================================
--- (empty file)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Union.pm Sun Jul 24 21:04:49 2005
@@ -0,0 +1,235 @@
+package Jifty::DBI::Union;
+use strict;
+use warnings;
+
+# WARNING --- This is still development code. It is experimental.
+
+our $VERSION = '0';
+
+# This could inherit from Jifty::DBI, but there are _a lot_
+# of things in Jifty::DBI that we don't want, like Limit and
+# stuff. It probably makes sense to (eventually) split out
+# Jifty::DBI::Collection to contain all the iterator logic.
+# This could inherit from that.
+
+=head1 NAME
+
+Jifty::DBI::Union - Deal with multiple SearchBuilder result sets as one
+
+=head1 SYNOPSIS
+
+ use Jifty::DBI::Union;
+ my $U = new Jifty::DBI::Union;
+ $U->add( $tickets1 );
+ $U->add( $tickets2 );
+
+ $U->GotoFirstItem;
+ while (my $z = $U->Next) {
+ printf "%5d %30.30s\n", $z->Id, $z->Subject;
+ }
+
+=head1 WARNING
+
+This module is still experimental.
+
+=head1 DESCRIPTION
+
+Implements a subset of the Jifty::DBI collection methods, but
+enough to do iteration over a bunch of results. Useful for displaying
+the results of two unrelated searches (for the same kind of objects)
+in a single list.
+
+=head1 METHODS
+
+=head2 new
+
+Create a new Jifty::DBI::Union object. No arguments.
+
+=cut
+
+sub new {
+ bless {
+ data => [],
+ curp => 0, # current offset in data
+ item => 0, # number of indiv items from First
+ count => undef,
+ }, shift;
+}
+
+=head2 add $sb
+
+Add a searchbuilder result (collection) to the Union object.
+
+It must be the same type as the first object added.
+
+=cut
+
+sub add {
+ my $self = shift;
+ my $newobj = shift;
+
+ unless ( @{$self->{data}} == 0
+ || ref($newobj) eq ref($self->{data}[0]) ) {
+ die "All elements of a Jifty::DBI::Union must be of the same type. Looking for a " . ref($self->{data}[0]) .".";
+ }
+
+ $self->{count} = undef;
+ push @{$self->{data}}, $newobj;
+}
+
+=head2 First
+
+Return the very first element of the Union (which is the first element
+of the first Collection). Also reset the current pointer to that
+element.
+
+=cut
+
+sub First {
+ my $self = shift;
+
+ die "No elements in Jifty::DBI::Union"
+ unless @{$self->{data}};
+
+ $self->{curp} = 0;
+ $self->{item} = 0;
+ $self->{data}[0]->First;
+}
+
+=head2 Next
+
+Return the next element in the Union.
+
+=cut
+
+sub Next {
+ my $self=shift;
+
+ return undef unless defined $self->{data}[ $self->{curp} ];
+
+ my $cur = $self->{data}[ $self->{curp} ];
+ if ( $cur->_ItemsCounter == $cur->Count ) {
+ # move to the next element
+ $self->{curp}++;
+ return undef unless defined $self->{data}[ $self->{curp} ];
+ $cur = $self->{data}[ $self->{curp} ];
+ $self->{data}[ $self->{curp} ]->GotoFirstItem;
+ }
+ $self->{item}++;
+ $cur->Next;
+}
+
+=head2 Last
+
+Returns the last item
+
+=cut
+
+sub Last {
+ die "Last doesn't work right now";
+ my $self = shift;
+ $self->GotoItem( ( $self->Count ) - 1 );
+ return ( $self->Next );
+}
+
+=head2 Count
+
+Returns the total number of elements in the Union'ed Collection
+
+=cut
+
+sub Count {
+ my $self = shift;
+ my $sum = 0;
+
+ # cache the results
+ return $self->{count} if defined $self->{count};
+
+ $sum += $_->Count for (@{$self->{data}});
+
+ $self->{count} = $sum;
+
+ return $sum;
+}
+
+
+=head2 GotoFirstItem
+
+Starts the recordset counter over from the first item. the next time
+you call Next, you'll get the first item returned by the database, as
+if you'd just started iterating through the result set.
+
+=cut
+
+sub GotoFirstItem {
+ my $self = shift;
+ $self->GotoItem(0);
+}
+
+sub GotoItem {
+ my $self = shift;
+ my $item = shift;
+
+ die "We currently only support going to the First item"
+ unless $item == 0;
+
+ $self->{curp} = 0;
+ $self->{item} = 0;
+ $self->{data}[0]->GotoItem(0);
+
+ return $item;
+}
+
+=head2 IsLast
+
+Returns true if the current row is the last record in the set.
+
+=cut
+
+sub IsLast {
+ my $self = shift;
+
+ $self->{item} == $self->Count ? 1 : undef;
+}
+
+=head2 ItemsArrayRef
+
+Return a refernece to an array containing all objects found by this search.
+
+Will destroy any positional state.
+
+=cut
+
+sub ItemsArrayRef {
+ my $self = shift;
+
+ return [] unless $self->Count;
+
+ $self->GotoFirstItem();
+ my @ret;
+ while( my $r = $self->Next ) {
+ push @ret, $r;
+ }
+
+ return \@ret;
+}
+
+=head1 AUTHOR
+
+Copyright (c) 2004 Robert Spier
+
+All rights reserved.
+
+This library is free software; you can redistribute it
+and/or modify it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+Jifty::DBI
+
+=cut
+
+1;
+
+__END__
+
Added: Jifty-DBI/trunk/lib/Jifty/DBI/Unique.pm
==============================================================================
--- (empty file)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Unique.pm Sun Jul 24 21:04:49 2005
@@ -0,0 +1,65 @@
+package Jifty::DBI::Unique;
+use base 'Exporter';
+our @EXPORT = qw(AddRecord);
+our $VERSION = "0.01";
+use strict;
+use warnings;
+
+
+
+sub AddRecord {
+ my $self = shift;
+ my $record = shift;
+
+ # We're a mixin, so we can't override _CleanSlate, but if an object
+ # gets reused, we need to clean ourselves out. If there are no items,
+ # we're clearly doing a new search
+ $self->{"dbix_sb_unique_cache"} = {} unless (@{$self->{'items'}}[0]);
+ return if $self->{"dbix_sb_unique_cache"}->{$record->id}++;
+ push @{$self->{'items'}}, $record;
+}
+
+1;
+
+=head1 NAME
+
+Jifty::DBI::Unique - Ensure uniqueness of records in a collection
+
+=head1 SYNOPSIS
+
+ package Foo::Collection;
+ use base 'Jifty::DBI::Collection';
+
+ use Jifty::DBI::Unique; # mixin
+
+ my $collection = Foo::Collection->New();
+ $collection->SetupComplicatedJoins;
+ $collection->OrderByMagic;
+
+ while (my $thing = $collection->Next) {
+ # $thing is going to be distinct
+ }
+
+=head1 DESCRIPTION
+
+Currently, Jifty::DBI makes exceptions for databases which
+cannot handle both C<SELECT DISTINCT> and ordering in the same
+statement; it drops the C<DISTINCT> requirement. This, of course, means
+that you can get the same row twice, which you might not want. If that's
+the case, use this module as a mix-in, and it will provide you with an
+C<AddRecord> method which ensures that a record will not appear twice in
+the same search.
+
+=head1 AUTHOR
+
+Simon Cozens.
+
+=head1 COPYRIGHT
+
+Copyright 2005 Best Practical Solutions, LLC
+
+This library is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
Modified: Jifty-DBI/trunk/t/00.load.t
==============================================================================
--- Jifty-DBI/trunk/t/00.load.t (original)
+++ Jifty-DBI/trunk/t/00.load.t Sun Jul 24 21:04:49 2005
@@ -1,30 +1,30 @@
use Test::More tests => 12;
-BEGIN { use_ok("DBIx::SearchBuilder"); }
-BEGIN { use_ok("DBIx::SearchBuilder::Handle"); }
-BEGIN { use_ok("DBIx::SearchBuilder::Handle::Informix"); }
-BEGIN { use_ok("DBIx::SearchBuilder::Handle::mysql"); }
-BEGIN { use_ok("DBIx::SearchBuilder::Handle::mysqlPP"); }
-BEGIN { use_ok("DBIx::SearchBuilder::Handle::ODBC"); }
+BEGIN { use_ok("Jifty::DBI::Collection"); }
+BEGIN { use_ok("Jifty::DBI::Handle"); }
+BEGIN { use_ok("Jifty::DBI::Handle::Informix"); }
+BEGIN { use_ok("Jifty::DBI::Handle::mysql"); }
+BEGIN { use_ok("Jifty::DBI::Handle::mysqlPP"); }
+BEGIN { use_ok("Jifty::DBI::Handle::ODBC"); }
BEGIN {
SKIP: {
skip "DBD::Oracle is not installed", 1
unless eval { require DBD::Oracle };
- use_ok("DBIx::SearchBuilder::Handle::Oracle");
+ use_ok("Jifty::DBI::Handle::Oracle");
}
}
-BEGIN { use_ok("DBIx::SearchBuilder::Handle::Pg"); }
-BEGIN { use_ok("DBIx::SearchBuilder::Handle::Sybase"); }
-BEGIN { use_ok("DBIx::SearchBuilder::Handle::SQLite"); }
-BEGIN { use_ok("DBIx::SearchBuilder::Record"); }
-BEGIN { use_ok("DBIx::SearchBuilder::Record::Cachable"); }
+BEGIN { use_ok("Jifty::DBI::Handle::Pg"); }
+BEGIN { use_ok("Jifty::DBI::Handle::Sybase"); }
+BEGIN { use_ok("Jifty::DBI::Handle::SQLite"); }
+BEGIN { use_ok("Jifty::DBI::Record"); }
+BEGIN { use_ok("Jifty::DBI::Record::Cachable"); }
# Commented out until ruslan sends code.
#BEGIN {
# SKIP: {
# skip "Cache::Memcached is not installed", 1
# unless eval { require Cache::Memcached };
-# use_ok("DBIx::SearchBuilder::Record::Memcached");
+# use_ok("Jifty::DBI::Record::Memcached");
# }
#}
Modified: Jifty-DBI/trunk/t/01basics.t
==============================================================================
--- Jifty-DBI/trunk/t/01basics.t (original)
+++ Jifty-DBI/trunk/t/01basics.t Sun Jul 24 21:04:49 2005
@@ -13,10 +13,10 @@
foreach my $d ( @AvailableDrivers ) {
SKIP: {
- use_ok('DBIx::SearchBuilder::Handle::'. $d);
+ use_ok('Jifty::DBI::Handle::'. $d);
my $handle = get_handle( $d );
- isa_ok($handle, 'DBIx::SearchBuilder::Handle');
- isa_ok($handle, 'DBIx::SearchBuilder::Handle::'. $d);
+ isa_ok($handle, 'Jifty::DBI::Handle');
+ isa_ok($handle, 'Jifty::DBI::Handle::'. $d);
can_ok($handle, 'dbh');
}
}
Modified: Jifty-DBI/trunk/t/01nocap_api.t
==============================================================================
--- Jifty-DBI/trunk/t/01nocap_api.t (original)
+++ Jifty-DBI/trunk/t/01nocap_api.t Sun Jul 24 21:04:49 2005
@@ -7,7 +7,7 @@
use vars qw(@SPEC_METHODS @MODULES);
my @SPEC_METHODS = qw(AUTOLOAD DESTROY CLONE);
-my @MODULES = qw(DBIx::SearchBuilder DBIx::SearchBuilder::Record);
+my @MODULES = qw(Jifty::DBI Jifty::DBI::Record);
if( not eval { require Devel::Symdump } ) {
plan skip_all => 'Devel::Symdump is not installed';
Modified: Jifty-DBI/trunk/t/01records.t
==============================================================================
--- Jifty-DBI/trunk/t/01records.t (original)
+++ Jifty-DBI/trunk/t/01records.t Sun Jul 24 21:04:49 2005
@@ -30,7 +30,7 @@
isa_ok($ret,'DBI::st', "Inserted the schema. got a statement handle back");
my $rec = TestApp::Address->new($handle);
- isa_ok($rec, 'DBIx::SearchBuilder::Record');
+ isa_ok($rec, 'Jifty::DBI::Record');
# _Accessible testings
is( $rec->_Accessible('id' => 'read'), 1, 'id is accessible for read' );
@@ -206,7 +206,7 @@
package TestApp::Address;
-use base qw/DBIx::SearchBuilder::Record/;
+use base qw/Jifty::DBI::Record/;
sub _Init {
my $self = shift;
Modified: Jifty-DBI/trunk/t/01searches.t
==============================================================================
--- Jifty-DBI/trunk/t/01searches.t (original)
+++ Jifty-DBI/trunk/t/01searches.t Sun Jul 24 21:04:49 2005
@@ -33,7 +33,7 @@
ok( $count_all, "init users data" );
my $users_obj = TestApp::Users->new( $handle );
- isa_ok( $users_obj, 'DBIx::SearchBuilder' );
+ isa_ok( $users_obj, 'Jifty::DBI::Collection' );
is( $users_obj->_Handle, $handle, "same handle as we used in constructor");
# check that new object returns 0 records in any case
@@ -57,10 +57,10 @@
# unlimit new object and check
$users_obj->UnLimit;
is( $users_obj->Count, $count_all, 'Count returns same number of records as was inserted' );
- isa_ok( $users_obj->First, 'DBIx::SearchBuilder::Record', 'First returns record object' );
- isa_ok( $users_obj->Last, 'DBIx::SearchBuilder::Record', 'Last returns record object' );
+ isa_ok( $users_obj->First, 'Jifty::DBI::Record', 'First returns record object' );
+ isa_ok( $users_obj->Last, 'Jifty::DBI::Record', 'Last returns record object' );
$users_obj->GotoFirstItem;
- isa_ok( $users_obj->Next, 'DBIx::SearchBuilder::Record', 'Next returns record object' );
+ isa_ok( $users_obj->Next, 'Jifty::DBI::Record', 'Next returns record object' );
$items_ref = $users_obj->ItemsArrayRef;
isa_ok( $items_ref, 'ARRAY', 'ItemsArrayRef always returns array reference' );
is( scalar @{$items_ref}, $count_all, 'ItemsArrayRef returns same number of records as was inserted' );
@@ -72,7 +72,7 @@
# try to use $users_obj for all tests, after each call to CleanSlate it should look like new obj.
# and test $obj->new syntax
my $clean_obj = $users_obj->new( $handle );
- isa_ok( $clean_obj, 'DBIx::SearchBuilder' );
+ isa_ok( $clean_obj, 'Jifty::DBI::Collection' );
# basic limits
$users_obj->CleanSlate;
@@ -84,7 +84,7 @@
is( $users_obj->IsLast, undef, 'IsLast returns undef before we fetch any record' );
}
my $first_rec = $users_obj->First;
- isa_ok( $first_rec, 'DBIx::SearchBuilder::Record', 'First returns record object' );
+ isa_ok( $first_rec, 'Jifty::DBI::Record', 'First returns record object' );
is( $users_obj->IsLast, 1, '1 record in the collection then first rec is last');
is( $first_rec->Login, 'obra', 'login is correct' );
my $last_rec = $users_obj->Last;
@@ -110,7 +110,7 @@
$users_obj->Limit( FIELD => 'Name', OPERATOR => 'LIKE', VALUE => 'Glass' );
is( $users_obj->Count, 1, "found one user with 'Glass' in the name" );
$first_rec = $users_obj->First;
- isa_ok( $first_rec, 'DBIx::SearchBuilder::Record', 'First returns record object' );
+ isa_ok( $first_rec, 'Jifty::DBI::Record', 'First returns record object' );
is( $first_rec->Login, 'glasser', 'login is correct' );
# STARTSWITH
@@ -119,7 +119,7 @@
$users_obj->Limit( FIELD => 'Name', OPERATOR => 'STARTSWITH', VALUE => 'Ruslan' );
is( $users_obj->Count, 1, "found one user who name starts with 'Ruslan'" );
$first_rec = $users_obj->First;
- isa_ok( $first_rec, 'DBIx::SearchBuilder::Record', 'First returns record object' );
+ isa_ok( $first_rec, 'Jifty::DBI::Record', 'First returns record object' );
is( $first_rec->Login, 'cubic', 'login is correct' );
# ENDSWITH
@@ -128,7 +128,7 @@
$users_obj->Limit( FIELD => 'Name', OPERATOR => 'ENDSWITH', VALUE => 'Tang' );
is( $users_obj->Count, 1, "found one user who name ends with 'Tang'" );
$first_rec = $users_obj->First;
- isa_ok( $first_rec, 'DBIx::SearchBuilder::Record', 'First returns record object' );
+ isa_ok( $first_rec, 'Jifty::DBI::Record', 'First returns record object' );
is( $first_rec->Login, 'autrijus', 'login is correct' );
# IS NULL
@@ -153,7 +153,7 @@
$users_obj->Column(FIELD => 'Login');
is( $users_obj->Count, $count_all, "group by / order by finds right amount");
$first_rec = $users_obj->First;
- isa_ok( $first_rec, 'DBIx::SearchBuilder::Record', 'First returns record object' );
+ isa_ok( $first_rec, 'Jifty::DBI::Record', 'First returns record object' );
is( $first_rec->Login, 'obra', 'login is correct' );
cleanup_schema( 'TestApp', $handle );
@@ -204,7 +204,7 @@
package TestApp::User;
-use base qw/DBIx::SearchBuilder::Record/;
+use base qw/Jifty::DBI::Record/;
sub _Init {
my $self = shift;
@@ -241,7 +241,7 @@
package TestApp::Users;
# use TestApp::User;
-use base qw/DBIx::SearchBuilder/;
+use base qw/Jifty::DBI::Collection/;
sub _Init {
my $self = shift;
Modified: Jifty-DBI/trunk/t/02records_object.t
==============================================================================
--- Jifty-DBI/trunk/t/02records_object.t (original)
+++ Jifty-DBI/trunk/t/02records_object.t Sun Jul 24 21:04:49 2005
@@ -106,7 +106,7 @@
package TestApp::Employee;
-use base qw/DBIx::SearchBuilder::Record/;
+use base qw/Jifty::DBI::Record/;
use vars qw/$VERSION/;
$VERSION=0.01;
@@ -135,7 +135,7 @@
use vars qw/$VERSION/;
$VERSION=0.01;
-use base qw/DBIx::SearchBuilder::Record/;
+use base qw/Jifty::DBI::Record/;
sub _Init {
my $self = shift;
Modified: Jifty-DBI/trunk/t/03rebless.t
==============================================================================
--- Jifty-DBI/trunk/t/03rebless.t (original)
+++ Jifty-DBI/trunk/t/03rebless.t Sun Jul 24 21:04:49 2005
@@ -5,7 +5,7 @@
use warnings;
use File::Spec;
use Test::More;
-use DBIx::SearchBuilder::Handle;
+use Jifty::DBI::Handle;
BEGIN { require "t/utils.pl" }
our (@AvailableDrivers);
@@ -21,15 +21,15 @@
skip "ENV is not defined for driver '$d'", TESTS_PER_DRIVER;
}
- my $handle = DBIx::SearchBuilder::Handle->new;
+ my $handle = Jifty::DBI::Handle->new;
ok($handle, "Made a generic handle");
- is(ref $handle, 'DBIx::SearchBuilder::Handle', "It's really generic");
+ is(ref $handle, 'Jifty::DBI::Handle', "It's really generic");
connect_handle_with_driver( $handle, $d );
isa_ok($handle->dbh, 'DBI::db');
- isa_ok($handle, "DBIx::SearchBuilder::Handle::$d", "Specialized Handle")
+ isa_ok($handle, "Jifty::DBI::Handle::$d", "Specialized Handle")
}} # SKIP, foreach blocks
1;
Modified: Jifty-DBI/trunk/t/10schema.t
==============================================================================
--- Jifty-DBI/trunk/t/10schema.t (original)
+++ Jifty-DBI/trunk/t/10schema.t Sun Jul 24 21:04:49 2005
@@ -18,8 +18,8 @@
}
BEGIN {
- use_ok("DBIx::SearchBuilder::SchemaGenerator");
- use_ok("DBIx::SearchBuilder::Handle");
+ use_ok("Jifty::DBI::SchemaGenerator");
+ use_ok("Jifty::DBI::Handle");
}
require_ok("t/testmodels.pl");
@@ -36,12 +36,12 @@
my $handle = get_handle( $d );
connect_handle( $handle );
- isa_ok($handle, "DBIx::SearchBuilder::Handle::$d");
+ isa_ok($handle, "Jifty::DBI::Handle::$d");
isa_ok($handle->dbh, 'DBI::db');
- my $SG = DBIx::SearchBuilder::SchemaGenerator->new($handle);
+ my $SG = Jifty::DBI::SchemaGenerator->new($handle);
- isa_ok($SG, 'DBIx::SearchBuilder::SchemaGenerator');
+ isa_ok($SG, 'Jifty::DBI::SchemaGenerator');
isa_ok($SG->_db_schema, 'DBIx::DBSchema');
Modified: Jifty-DBI/trunk/t/11schema_records.t
==============================================================================
--- Jifty-DBI/trunk/t/11schema_records.t (original)
+++ Jifty-DBI/trunk/t/11schema_records.t Sun Jul 24 21:04:49 2005
@@ -238,7 +238,7 @@
package TestApp::Employee;
-use base qw/DBIx::SearchBuilder::Record/;
+use base qw/Jifty::DBI::Record/;
sub Table { 'Employees' }
@@ -260,7 +260,7 @@
package TestApp::Phone;
-use base qw/DBIx::SearchBuilder::Record/;
+use base qw/Jifty::DBI::Record/;
sub Table { 'Phones' }
@@ -273,7 +273,7 @@
package TestApp::PhoneCollection;
-use base qw/DBIx::SearchBuilder/;
+use base qw/Jifty::DBI::Collection/;
sub Table {
my $self = shift;
Modified: Jifty-DBI/trunk/t/testmodels.pl
==============================================================================
--- Jifty-DBI/trunk/t/testmodels.pl (original)
+++ Jifty-DBI/trunk/t/testmodels.pl Sun Jul 24 21:04:49 2005
@@ -1,6 +1,6 @@
package Sample::Address;
-use base qw/DBIx::SearchBuilder::Record/;
+use base qw/Jifty::DBI::Record/;
# Class and instance method
@@ -18,7 +18,7 @@
package Sample::Employee;
-use base qw/DBIx::SearchBuilder::Record/;
+use base qw/Jifty::DBI::Record/;
sub Table { "Employees" }
Modified: Jifty-DBI/trunk/t/utils.pl
==============================================================================
--- Jifty-DBI/trunk/t/utils.pl (original)
+++ Jifty-DBI/trunk/t/utils.pl Sun Jul 24 21:04:49 2005
@@ -42,7 +42,7 @@
sub get_handle
{
my $type = shift;
- my $class = 'DBIx::SearchBuilder::Handle::'. $type;
+ my $class = 'Jifty::DBI::Handle::'. $type;
eval "require $class";
die $@ if $@;
my $handle;
@@ -79,7 +79,7 @@
=head2 connect_handle_with_driver($handle, $driver)
Connects C<$handle> using driver C<$driver>; can use this to test the
-magic that turns a C<DBIx::SearchBuilder::Handle> into a C<DBIx::SearchBuilder::Handle::Foo>
+magic that turns a C<Jifty::DBI::Handle> into a C<Jifty::DBI::Handle::Foo>
on C<Connect>.
=cut
More information about the Rt-commit
mailing list