[Rt-commit] r3535 - in Jifty-DBI/trunk: . inc/Module
inc/Module/Install lib/Jifty/DBI lib/Jifty/DBI/Handle
lib/Jifty/DBI/Record
jesse at bestpractical.com
jesse at bestpractical.com
Mon Jul 25 20:40:35 EDT 2005
Author: jesse
Date: Mon Jul 25 20:40:33 2005
New Revision: 3535
Modified:
Jifty-DBI/trunk/ (props changed)
Jifty-DBI/trunk/inc/Module/Install.pm
Jifty-DBI/trunk/inc/Module/Install/AutoInstall.pm
Jifty-DBI/trunk/inc/Module/Install/Base.pm
Jifty-DBI/trunk/inc/Module/Install/Makefile.pm
Jifty-DBI/trunk/inc/Module/Install/Metadata.pm
Jifty-DBI/trunk/lib/Jifty/DBI/Handle.pm
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
Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Pg.pm
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
Jifty-DBI/trunk/lib/Jifty/DBI/Handle/mysqlPP.pm
Jifty-DBI/trunk/lib/Jifty/DBI/Record.pm
Jifty-DBI/trunk/lib/Jifty/DBI/Record/Cachable.pm
Jifty-DBI/trunk/lib/Jifty/DBI/SchemaGenerator.pm
Jifty-DBI/trunk/lib/Jifty/DBI/Union.pm
Jifty-DBI/trunk/lib/Jifty/DBI/Unique.pm
Log:
r7031 at hualien: jesse | 2005-07-25 20:40:04 -0400
* perltidy! With this perltidyrc
-l=78
-i=4
-ci=4
-se
-vt=2
-cti=0
-pt=1
-bt=1
-sbt=1
-bbt=1
-nsfs
-nolq
-wbb="% + - * / x != == >= <= =~ !~ < > | & >= < = **= += *= &= <<= &&= -= /= |= >>= ||= .= %= ^= x="
Modified: Jifty-DBI/trunk/inc/Module/Install.pm
==============================================================================
--- Jifty-DBI/trunk/inc/Module/Install.pm (original)
+++ Jifty-DBI/trunk/inc/Module/Install.pm Mon Jul 25 20:40:33 2005
@@ -1,4 +1,4 @@
-#line 1 "inc/Module/Install.pm - /usr/lib/perl5/site_perl/5.8.7/Module/Install.pm"
+#line 1 "inc/Module/Install.pm - /usr/local/share/perl/5.8.4/Module/Install.pm"
package Module::Install;
$VERSION = '0.36';
Modified: Jifty-DBI/trunk/inc/Module/Install/AutoInstall.pm
==============================================================================
--- Jifty-DBI/trunk/inc/Module/Install/AutoInstall.pm (original)
+++ Jifty-DBI/trunk/inc/Module/Install/AutoInstall.pm Mon Jul 25 20:40:33 2005
@@ -1,4 +1,4 @@
-#line 1 "inc/Module/Install/AutoInstall.pm - /usr/lib/perl5/site_perl/5.8.7/Module/Install/AutoInstall.pm"
+#line 1 "inc/Module/Install/AutoInstall.pm - /usr/local/share/perl/5.8.4/Module/Install/AutoInstall.pm"
package Module::Install::AutoInstall;
use Module::Install::Base; @ISA = qw(Module::Install::Base);
Modified: Jifty-DBI/trunk/inc/Module/Install/Base.pm
==============================================================================
--- Jifty-DBI/trunk/inc/Module/Install/Base.pm (original)
+++ Jifty-DBI/trunk/inc/Module/Install/Base.pm Mon Jul 25 20:40:33 2005
@@ -1,4 +1,4 @@
-#line 1 "inc/Module/Install/Base.pm - /usr/lib/perl5/site_perl/5.8.7/Module/Install/Base.pm"
+#line 1 "inc/Module/Install/Base.pm - /usr/local/share/perl/5.8.4/Module/Install/Base.pm"
package Module::Install::Base;
#line 28
Modified: Jifty-DBI/trunk/inc/Module/Install/Makefile.pm
==============================================================================
--- Jifty-DBI/trunk/inc/Module/Install/Makefile.pm (original)
+++ Jifty-DBI/trunk/inc/Module/Install/Makefile.pm Mon Jul 25 20:40:33 2005
@@ -1,4 +1,4 @@
-#line 1 "inc/Module/Install/Makefile.pm - /usr/lib/perl5/site_perl/5.8.7/Module/Install/Makefile.pm"
+#line 1 "inc/Module/Install/Makefile.pm - /usr/local/share/perl/5.8.4/Module/Install/Makefile.pm"
package Module::Install::Makefile;
use Module::Install::Base; @ISA = qw(Module::Install::Base);
Modified: Jifty-DBI/trunk/inc/Module/Install/Metadata.pm
==============================================================================
--- Jifty-DBI/trunk/inc/Module/Install/Metadata.pm (original)
+++ Jifty-DBI/trunk/inc/Module/Install/Metadata.pm Mon Jul 25 20:40:33 2005
@@ -1,4 +1,4 @@
-#line 1 "inc/Module/Install/Metadata.pm - /usr/lib/perl5/site_perl/5.8.7/Module/Install/Metadata.pm"
+#line 1 "inc/Module/Install/Metadata.pm - /usr/local/share/perl/5.8.4/Module/Install/Metadata.pm"
package Module::Install::Metadata;
use Module::Install::Base; @ISA = qw(Module::Install::Base);
Modified: Jifty-DBI/trunk/lib/Jifty/DBI/Handle.pm
==============================================================================
--- Jifty-DBI/trunk/lib/Jifty/DBI/Handle.pm (original)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Handle.pm Mon Jul 25 20:40:33 2005
@@ -11,8 +11,6 @@
$VERSION = '$Version$';
-
-
=head1 NAME
Jifty::DBI::Handle - Perl extension which is a generic DBI handle
@@ -35,26 +33,22 @@
=cut
-
-
=head2 new
Generic constructor
=cut
-sub new {
+sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = {};
- bless ($self, $class);
+ bless( $self, $class );
- @{$self->{'StatementLog'}} = ();
+ @{ $self->{'StatementLog'} } = ();
return $self;
}
-
-
=head2 connect PARAMHASH: Driver, Database, Host, User, Password
Takes a paramhash and connects to your DBI datasource.
@@ -66,50 +60,56 @@
=cut
-sub connect {
+sub connect {
my $self = shift;
-
- my %args = ( driver => undef,
- database => undef,
- host => undef,
- sid => undef,
- port => undef,
- user => undef,
- password => undef,
- requiressl => undef,
- @_);
-
- if( $args{'driver'} && !$self->isa( 'Jifty::DBI::Handle::'. $args{'driver'} ) ) {
- if ( $self->_upgrade_handle($args{'driver'}) ) {
- return ($self->connect( %args ));
+
+ my %args = (
+ driver => undef,
+ database => undef,
+ host => undef,
+ sid => undef,
+ port => undef,
+ user => undef,
+ password => undef,
+ requiressl => undef,
+ @_
+ );
+
+ if ( $args{'driver'}
+ && !$self->isa( 'Jifty::DBI::Handle::' . $args{'driver'} ) )
+ {
+ if ( $self->_upgrade_handle( $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
+# Setting this actually breaks old RT versions in subtle ways. So we need to explicitly call it
$self->build_dsn(%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';
+ 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
+ #Set the handle
$self->dbh($handle);
-
- return (1);
+
+ return (1);
}
- return(undef);
+ return (undef);
}
-
=head2 _upgrade_handle DRIVER
This private internal method turns a plain Jifty::DBI::Handle into one
@@ -119,19 +119,16 @@
sub _upgrade_handle {
my $self = shift;
-
+
my $driver = shift;
- my $class = 'Jifty::DBI::Handle::' . $driver;
+ my $class = 'Jifty::DBI::Handle::' . $driver;
eval "require $class";
return if $@;
-
+
bless $self, $class;
return 1;
}
-
-
-
=head2 build_dsn PARAMHASH
Takes a bunch of parameters:
@@ -144,26 +141,28 @@
=cut
sub build_dsn {
- 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;
-}
+ 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
@@ -173,11 +172,9 @@
sub DSN {
my $self = shift;
- return($self->{'dsn'});
+ return ( $self->{'dsn'} );
}
-
-
=head2 raise_error [MODE]
Turns on the Database Handle's RaiseError attribute.
@@ -187,15 +184,12 @@
sub raise_error {
my $self = shift;
- my $mode = 1;
+ my $mode = 1;
$mode = shift if (@_);
- $self->dbh->{RaiseError}=$mode;
+ $self->dbh->{RaiseError} = $mode;
}
-
-
-
=head2 print_error [MODE]
Turns on the Database Handle's PrintError attribute.
@@ -205,14 +199,12 @@
sub print_error {
my $self = shift;
- my $mode = 1;
+ my $mode = 1;
$mode = shift if (@_);
- $self->dbh->{PrintError}=$mode;
+ $self->dbh->{PrintError} = $mode;
}
-
-
=head2 log_sql_statements BOOL
Takes a boolean argument. If the boolean is true, SearchBuilder will log all SQL
@@ -227,7 +219,7 @@
if (@_) {
require Time::HiRes;
$self->{'_dologsql'} = shift;
- return ($self->{'_dologsql'});
+ return ( $self->{'_dologsql'} );
}
}
@@ -238,10 +230,11 @@
=cut
sub _log_sql_statement {
- my $self = shift;
+ my $self = shift;
my $statement = shift;
- my $duration = shift;
- push @{$self->{'StatementLog'}} , ([Time::Hires::time(), $statement, $duration]);
+ my $duration = shift;
+ push @{ $self->{'StatementLog'} },
+ ( [ Time::Hires::time(), $statement, $duration ] );
}
@@ -254,9 +247,8 @@
sub clear_sql_statement_log {
my $self = shift;
- @{$self->{'StatementLog'}} = ();
-}
-
+ @{ $self->{'StatementLog'} } = ();
+}
=head2 sql_statement_log
@@ -268,12 +260,10 @@
sub sql_statement_log {
my $self = shift;
- return (@{$self->{'StatementLog'}});
+ return ( @{ $self->{'StatementLog'} } );
}
-
-
=head2 auto_commit [MODE]
Turns on the Database Handle's Autocommit attribute.
@@ -283,32 +273,28 @@
sub auto_commit {
my $self = shift;
- my $mode = 1;
+ my $mode = 1;
$mode = shift if (@_);
- $self->dbh->{Autocommit}=$mode;
+ $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;
- }
+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.
@@ -316,14 +302,13 @@
=cut
sub dbh {
- my $self=shift;
-
- #If we are setting the database handle, set it.
- $DBIHandle{$self} = $PrevHandle = shift if (@_);
+ my $self = shift;
- return($DBIHandle{$self} ||= $PrevHandle);
-}
+ #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
@@ -332,26 +317,27 @@
=cut
sub insert {
- my($self, $table, @pairs) = @_;
- my(@cols, @vals, @bind);
+ 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 (". CORE::join(", ", @cols). ") VALUES ".
- "(". CORE::join(", ", @vals). ")";
+#my %seen; #only the *first* value is used - allows drivers to specify default
+ while ( my $key = shift @pairs ) {
+ my $value = shift @pairs;
- my $sth = $self->simple_query($QueryString, @bind);
- return ($sth);
- }
+ # next if $seen{$key}++;
+ push @cols, $key;
+ push @vals, '?';
+ push @bind, $value;
+ }
+
+ my $QueryString = "INSERT INTO $table ("
+ . CORE::join( ", ", @cols )
+ . ") VALUES " . "("
+ . CORE::join( ", ", @vals ) . ")";
+ my $sth = $self->simple_query( $QueryString, @bind );
+ return ($sth);
+}
=head2 update_record_value
@@ -367,39 +353,38 @@
sub update_record_value {
my $self = shift;
- my %args = ( table => undef,
- column => undef,
- is_sql_function => undef,
- primary_keys => undef,
- @_ );
+ my %args = (
+ table => undef,
+ column => undef,
+ is_sql_function => undef,
+ primary_keys => 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{'is_sql_function'}) {
- $query .= $args{'value'} . ' ';
- }
- else {
- $query .= '? ';
- push (@bind, $args{'value'});
- }
-
- ## Constructs the where clause.
- my $where = 'WHERE ';
- foreach my $key (keys %{$args{'primary_keys'}}) {
- $where .= $key . "=?" . " AND ";
- push (@bind, $args{'primary_keys'}{$key});
- }
- $where =~ s/AND\s$//;
-
- my $query_str = $query . $where;
- return ($self->simple_query($query_str, @bind));
-}
+ $query .= 'SET ' . $args{'column'} . '=';
+ ## Look and see if the field is being updated via a SQL function.
+ if ( $args{'is_sql_function'} ) {
+ $query .= $args{'value'} . ' ';
+ }
+ else {
+ $query .= '? ';
+ push( @bind, $args{'value'} );
+ }
+ ## Constructs the where clause.
+ my $where = 'WHERE ';
+ foreach my $key ( keys %{ $args{'primary_keys'} } ) {
+ $where .= $key . "=?" . " AND ";
+ push( @bind, $args{'primary_keys'}{$key} );
+ }
+ $where =~ s/AND\s$//;
+ my $query_str = $query . $where;
+ return ( $self->simple_query( $query_str, @bind ) );
+}
=head2 update_table_value TABLE COLUMN NEW_VALUE RECORD_ID IS_SQL
@@ -408,21 +393,20 @@
=cut
-sub update_table_value {
+sub update_table_value {
my $self = shift;
- ## This is just a wrapper to update_record_value().
- my %args = ();
- $args{'table'} = shift;
- $args{'column'} = shift;
- $args{'value'} = shift;
- $args{'primary_keys'} = shift;
+ ## This is just a wrapper to update_record_value().
+ my %args = ();
+ $args{'table'} = shift;
+ $args{'column'} = shift;
+ $args{'value'} = shift;
+ $args{'primary_keys'} = shift;
$args{'is_sql_function'} = shift;
- return $self->update_record_value(%args)
+ return $self->update_record_value(%args);
}
-
=head2 simple_query QUERY_STRING, [ BIND_VALUE, ... ]
Execute the SQL string specified in QUERY_STRING
@@ -439,16 +423,16 @@
unless ($sth) {
if ($DEBUG) {
die "$self couldn't prepare the query '$QueryString'"
- . $self->dbh->errstr . "\n";
+ . $self->dbh->errstr . "\n";
}
else {
warn "$self couldn't prepare the query '$QueryString'"
- . $self->dbh->errstr . "\n";
+ . $self->dbh->errstr . "\n";
my $ret = Class::ReturnValue->new();
$ret->as_error(
errno => '-1',
message => "Couldn't prepare the query '$QueryString'."
- . $self->dbh->errstr,
+ . $self->dbh->errstr,
do_backtrace => undef
);
return ( $ret->return_value );
@@ -456,16 +440,17 @@
}
# Check @bind_values for HASH refs
- for ( my $bind_idx = 0 ; $bind_idx < scalar @bind_values ; $bind_idx++ ) {
+ 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]);
+ Encode::_utf8_off( $bind_values[$bind_idx] );
}
my $basetime;
@@ -474,7 +459,7 @@
}
my $executed;
{
- no warnings 'uninitialized' ; # undef in bind_values makes DBI sad
+ no warnings 'uninitialized'; # undef in bind_values makes DBI sad
eval { $executed = $sth->execute(@bind_values) };
}
if ( $self->log_sql_statements ) {
@@ -485,7 +470,7 @@
if ( $@ or !$executed ) {
if ($DEBUG) {
die "$self couldn't execute the query '$QueryString'"
- . $self->dbh->errstr . "\n";
+ . $self->dbh->errstr . "\n";
}
else {
@@ -495,7 +480,7 @@
$ret->as_error(
errno => '-1',
message => "Couldn't execute the query '$QueryString'"
- . $self->dbh->errstr,
+ . $self->dbh->errstr,
do_backtrace => undef
);
return ( $ret->return_value );
@@ -506,8 +491,6 @@
}
-
-
=head2 fetch_result QUERY, [ BIND_VALUE, ... ]
Takes a SELECT query as a string, along with an array of BIND_VALUEs
@@ -518,19 +501,18 @@
=cut
sub fetch_result {
- my $self = shift;
- my $query = shift;
- my @bind_values = @_;
- my $sth = $self->simple_query($query, @bind_values);
- if ($sth) {
- return ($sth->fetchrow);
- }
- else {
- return($sth);
- }
+ my $self = shift;
+ my $query = shift;
+ my @bind_values = @_;
+ my $sth = $self->simple_query( $query, @bind_values );
+ if ($sth) {
+ return ( $sth->fetchrow );
+ }
+ else {
+ return ($sth);
+ }
}
-
=head2 binary_safe_blobs
Returns 1 if the current database supports BLOBs with embedded nulls.
@@ -540,11 +522,9 @@
sub binary_safe_blobs {
my $self = shift;
- return(1);
+ return (1);
}
-
-
=head2 knows_blobs
Returns 1 if the current database supports inserts of BLOBs automatically.
@@ -554,11 +534,9 @@
sub knows_blobs {
my $self = shift;
- return(1);
+ return (1);
}
-
-
=head2 blob_params FIELD_NAME FIELD_TYPE
Returns a hash ref for the bind_param call to identify BLOB types used by
@@ -568,12 +546,11 @@
sub blob_params {
my $self = shift;
- # Don't assign to key 'value' as it is defined later.
+
+ # Don't assign to key 'value' as it is defined later.
return ( {} );
}
-
-
=head2 database_version
Returns the database's version. The base implementation uses a "SELECT VERSION"
@@ -583,15 +560,14 @@
sub database_version {
my $self = shift;
- unless ($self->{'database_version'}) {
- my $statement = "SELECT VERSION()";
- my $sth = $self->simple_query($statement);
- my @vals = $sth->fetchrow();
- $self->{'database_version'}= $vals[0];
+ unless ( $self->{'database_version'} ) {
+ my $statement = "SELECT VERSION()";
+ my $sth = $self->simple_query($statement);
+ my @vals = $sth->fetchrow();
+ $self->{'database_version'} = $vals[0];
}
}
-
=head2 case_sensitive
Returns 1 if the current database's searches are case sensitive by default
@@ -601,13 +577,9 @@
sub case_sensitive {
my $self = shift;
- return(1);
+ return (1);
}
-
-
-
-
=head2 _make_clause_case_insensitive FIELD OPERATOR VALUE
Takes a field, operator and value. performs the magic necessary to make
@@ -618,21 +590,18 @@
=cut
sub _make_clause_case_insensitive {
- my $self = shift;
- my $field = shift;
+ my $self = shift;
+ my $field = shift;
my $operator = shift;
- my $value = shift;
+ my $value = shift;
- if ($value !~ /^\d+$/) { # don't downcase integer values
+ if ( $value !~ /^\d+$/ ) { # don't downcase integer values
$field = "lower($field)";
$value = lc($value);
}
- return ($field, $operator, $value,undef);
+ return ( $field, $operator, $value, undef );
}
-
-
-
=head2 begin_transaction
Tells Jifty::DBI to begin a new SQL transaction. This will
@@ -645,15 +614,14 @@
sub begin_transaction {
my $self = shift;
$TRANSDEPTH++;
- if ($TRANSDEPTH > 1 ) {
+ if ( $TRANSDEPTH > 1 ) {
return ($TRANSDEPTH);
- } else {
- return($self->dbh->begin_work);
+ }
+ else {
+ return ( $self->dbh->begin_work );
}
}
-
-
=head2 commit
Tells Jifty::DBI to commit the current SQL transaction.
@@ -663,18 +631,20 @@
sub commit {
my $self = shift;
- unless ($TRANSDEPTH) {Carp::confess("Attempted to commit a transaction with none in progress")};
+ 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);
+ 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.
@@ -685,24 +655,25 @@
=cut
sub rollback {
- my $self = shift;
+ my $self = shift;
my $force = shift || undef;
- #unless ($TRANSDEPTH) {Carp::confess("Attempted to rollback a transaction with none in progress")};
+
+#unless ($TRANSDEPTH) {Carp::confess("Attempted to rollback a transaction with none in progress")};
$TRANSDEPTH--;
if ($force) {
$TRANSDEPTH = 0;
- return($self->dbh->rollback);
+ return ( $self->dbh->rollback );
}
- if ($TRANSDEPTH == 0 ) {
- return($self->dbh->rollback);
- } else { #we're inside a transaction
- return($TRANSDEPTH);
+ if ( $TRANSDEPTH == 0 ) {
+ return ( $self->dbh->rollback );
+ }
+ else { #we're inside a transaction
+ return ($TRANSDEPTH);
}
}
-
=head2 force_rollback
Force the handle to rollback. Whether or not we're deep in nested transactions
@@ -714,7 +685,6 @@
$self->rollback(1);
}
-
=head2 transaction_depthh
Return the current depth of the faked nested transaction stack.
@@ -723,11 +693,9 @@
sub transaction_depthh {
my $self = shift;
- return ($TRANSDEPTH);
+ return ($TRANSDEPTH);
}
-
-
=head2 apply_limits STATEMENTREF ROWS_PER_PAGE FIRST_ROW
takes an SQL SELECT statement and massages it to return ROWS_PER_PAGE starting with FIRST_ROW;
@@ -736,29 +704,25 @@
=cut
sub apply_limits {
- my $self = shift;
+ my $self = shift;
my $statementref = shift;
- my $per_page = shift;
- my $first = shift;
+ my $per_page = shift;
+ my $first = shift;
my $limit_clause = '';
- if ( $per_page) {
+ if ($per_page) {
$limit_clause = " LIMIT ";
- if ( $first ) {
+ if ($first) {
$limit_clause .= $first . ", ";
}
$limit_clause .= $per_page;
}
- $$statementref .= $limit_clause;
+ $$statementref .= $limit_clause;
}
-
-
-
-
=head2 join { Paramhash }
Takes a paramhash of everything Searchbuildler::Record does
@@ -770,7 +734,6 @@
=cut
-
sub join {
my $self = shift;
@@ -858,20 +821,21 @@
}
-
my $criterion;
- if ($args{'EXPRESSION'}) {
+ if ( $args{'EXPRESSION'} ) {
$criterion = $args{'EXPRESSION'};
- } else {
- $criterion = $args{'ALIAS1'}.".".$args{'FIELD1'};
+ }
+ 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"}{'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";
+ { 'criterion' . $args{'SearchBuilder'}->{'criteria_count'}++ }
+ = " $alias.$args{'FIELD2'} = $criterion";
return ($alias);
}
@@ -895,11 +859,11 @@
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"}{'alias_string'}
+ = " LEFT JOIN $args{'TABLE2'} $alias ";
- $sb->{'left_joins'}{"$alias"}{'criteria'}{'base_criterion'} =
- " $args{'ALIAS1'}.$args{'FIELD1'} = $alias.$args{'FIELD2'}";
+ $sb->{'left_joins'}{"$alias"}{'criteria'}{'base_criterion'}
+ = " $args{'ALIAS1'}.$args{'FIELD1'} = $alias.$args{'FIELD2'}";
return ($alias);
}
@@ -915,7 +879,7 @@
}
}
-# this code is all hacky and evil. but people desperately want _something_ and I'm
+# this code is all hacky and evil. but people desperately want _something_ and I'm
# super tired. refactoring gratefully appreciated.
sub _build_joins {
@@ -925,44 +889,42 @@
$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;
- }
+ # 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'} } ) {
+ 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 .=
- CORE::join ( ') AND( ',
+ $join_clause
+ .= $sb->{'left_joins'}{$join}{'alias_string'} . " ON (";
+ $join_clause .= CORE::join( ') AND( ',
values %{ $sb->{'left_joins'}{$join}{'criteria'} } );
$join_clause .= ")) ";
$seen_aliases{$join} = 1;
}
else {
- push ( @keys, $join );
+ push( @keys, $join );
die "Unsatisfied dependency chain in joins @keys"
- if $seen{"@keys"}++;
+ if $seen{"@keys"}++;
}
}
- return ( CORE::join ( ", ", ( $join_clause, @{ $sb->{'aliases'} } ) ) );
+ return ( CORE::join( ", ", ( $join_clause, @{ $sb->{'aliases'} } ) ) );
}
-
-
=head2 distinct_query STATEMENTREF
takes an incomplete SQL SELECT statement and massages it to return a DISTINCT result set.
@@ -971,8 +933,9 @@
=cut
sub distinct_query {
- my $self = shift;
+ my $self = shift;
my $statementref = shift;
+
#my $table = shift;
# Prepend select query for DBs which allow DISTINCT on all column types.
@@ -980,9 +943,6 @@
}
-
-
-
=head2 distinct_count STATEMENTREF
takes an incomplete SQL SELECT statement and massages it to return a DISTINCT result set.
@@ -991,7 +951,7 @@
=cut
sub distinct_count {
- my $self = shift;
+ my $self = shift;
my $statementref = shift;
# Prepend select query for DBs which allow DISTINCT on all column types.
@@ -999,7 +959,6 @@
}
-
=head2 Log MESSAGE
Takes a single argument, a message to log.
@@ -1009,28 +968,24 @@
=cut
sub Log {
- my $self = shift;
- my $msg = shift;
- warn $msg."\n";
+ 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;
- delete $DBIHandle{$self};
+ my $self = shift;
+ $self->disconnect;
+ delete $DBIHandle{$self};
}
-
1;
__END__
Modified: Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Informix.pm
==============================================================================
--- Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Informix.pm (original)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Informix.pm Mon Jul 25 20:40:33 2005
@@ -23,7 +23,6 @@
=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.
@@ -33,21 +32,19 @@
=cut
-sub insert {
+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
- }
+ 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 case_sensitive
@@ -57,10 +54,9 @@
sub case_sensitive {
my $self = shift;
- return(1);
+ return (1);
}
-
=head2 build_dsn
Builder for Informix DSNs.
@@ -69,22 +65,24 @@
sub build_dsn {
my $self = shift;
- my %args = ( Driver => undef,
- Database => undef,
- Host => undef,
- Port => undef,
- SID => undef,
- RequireSSL => undef,
- @_);
+ my %args = (
+ Driver => undef,
+ Database => undef,
+ Host => undef,
+ Port => undef,
+ SID => undef,
+ RequireSSL => undef,
+ @_
+ );
- my $dsn = "dbi:$args{'Driver'}:";
+ my $dsn = "dbi:$args{'Driver'}:";
- $dsn .= "$args{'Database'}" if (defined $args{'Database'} && $args{'Database'});
+ $dsn .= "$args{'Database'}"
+ if ( defined $args{'Database'} && $args{'Database'} );
- $self->{'dsn'}= $dsn;
+ $self->{'dsn'} = $dsn;
}
-
=head2 apply_limits STATEMENTREF ROWS_PER_PAGE FIRST_ROW
takes an SQL SELECT statement and massages it to return ROWS_PER_PAGE starting with FIRST_ROW;
@@ -93,30 +91,29 @@
=cut
sub apply_limits {
- my $self = shift;
+ my $self = shift;
my $statementref = shift;
- my $per_page = shift;
- my $first = 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;
+ $$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;
- }
+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.
@@ -125,17 +122,17 @@
=cut
sub distinct_query {
- my $self = shift;
+ my $self = shift;
my $statementref = shift;
- my $table = 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 )";
+ $$statementref
+ = "SELECT * FROM $table main WHERE id IN ( SELECT DISTINCT main.id FROM $$statementref )";
}
-
1;
__END__
Modified: Jifty-DBI/trunk/lib/Jifty/DBI/Handle/ODBC.pm
==============================================================================
--- Jifty-DBI/trunk/lib/Jifty/DBI/Handle/ODBC.pm (original)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Handle/ODBC.pm Mon Jul 25 20:40:33 2005
@@ -41,16 +41,18 @@
sub build_dsn {
my $self = shift;
my %args = (
- Driver => undef,
- Database => undef,
- Host => undef,
- Port => undef,
- @_
+ 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'});
+ $dsn .= ";host=$args{'Host'}"
+ if ( defined $args{'Host'} && $args{'Host'} );
+ $dsn .= ";port=$args{'Port'}"
+ if ( defined $args{'Port'} && $args{'Port'} );
$self->{'dsn'} = $dsn;
}
Modified: Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Oracle.pm
==============================================================================
--- Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Oracle.pm (original)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Oracle.pm Mon Jul 25 20:40:33 2005
@@ -1,12 +1,12 @@
# $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);
+use vars qw($VERSION $DBIHandle $DEBUG);
=head1 NAME
@@ -24,34 +24,35 @@
=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,
- @_);
-
+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->simple_query("ALTER SESSION set NLS_DATE_FORMAT = 'YYYY-MM-DD HH24:MI:SS'");
-
- return ($DBIHandle);
-}
+ $self->dbh->{LongTruncOk} = 1;
+ $self->dbh->{LongReadLen} = 8000;
+
+ $self->simple_query(
+ "ALTER SESSION set NLS_DATE_FORMAT = 'YYYY-MM-DD HH24:MI:SS'");
+
+ return ($DBIHandle);
+}
=head2 insert
@@ -60,39 +61,37 @@
=cut
-sub insert {
- my $self = shift;
- my $table = shift;
+sub insert {
+ my $self = shift;
+ my $table = shift;
my ($sth);
-
-
- # Oracle Hack to replace non-supported mysql_rowid call
+ # Oracle Hack to replace non-supported mysql_rowid call
my %attribs = @_;
- my ($unique_id, $QueryString);
+ my ( $unique_id, $QueryString );
- if ($attribs{'Id'} || $attribs{'id'}) {
- $unique_id = ($attribs{'Id'} ? $attribs{'Id'} : $attribs{'id'} );
+ if ( $attribs{'Id'} || $attribs{'id'} ) {
+ $unique_id = ( $attribs{'Id'} ? $attribs{'Id'} : $attribs{'id'} );
}
else {
-
- $QueryString = "SELECT ".$table."_seq.nextval FROM DUAL";
-
- $sth = $self->simple_query($QueryString);
- if (!$sth) {
- if ($main::debug) {
- die "Error with $QueryString";
- }
- else {
- return (undef);
- }
- }
- #needs error checking
- my @row = $sth->fetchrow_array;
+ $QueryString = "SELECT " . $table . "_seq.nextval FROM DUAL";
+
+ $sth = $self->simple_query($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];
+ $unique_id = $row[0];
}
@@ -101,22 +100,20 @@
$attribs{'id'} = $unique_id;
delete $attribs{'Id'};
- $sth = $self->SUPER::insert( $table, %attribs);
+ $sth = $self->SUPER::insert( $table, %attribs );
- unless ($sth) {
- if ($main::debug) {
- die "Error with $QueryString: ". $self->dbh->errstr;
+ unless ($sth) {
+ if ($main::debug) {
+ die "Error with $QueryString: " . $self->dbh->errstr;
+ }
+ else {
+ return (undef);
+ }
}
- else {
- return (undef);
- }
- }
$self->{'id'} = $unique_id;
- return( $self->{'id'}); #Add Succeded. return the id
- }
-
-
+ return ( $self->{'id'} ); #Add Succeded. return the id
+}
=head2 build_dsn PARAMHASH
@@ -131,30 +128,37 @@
sub build_dsn {
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'});
+ 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;
+ $self->{'dsn'} = $dsn;
}
-
-
=head2 knows_blobs
Returns 1 if the current database supports inserts of BLOBs automatically.
@@ -162,13 +166,11 @@
=cut
-sub knows_blobs {
+sub knows_blobs {
my $self = shift;
- return(undef);
+ return (undef);
}
-
-
=head2 blob_params FIELD_NAME FIELD_TYPE
Returns a hash ref for the bind_param call to identify BLOB types used by
@@ -177,17 +179,19 @@
=cut
-sub blob_params {
- my $self = shift;
+sub blob_params {
+ 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,
-});
+ return (
+ { ora_field => $field,
+ ora_type => ORA_CLOB,
+ }
+ );
}
-
-
=head2 apply_limits STATEMENTREF ROWS_PER_PAGE FIRST_ROW
takes an SQL SELECT statement and massages it to return ROWS_PER_PAGE starting with FIRST_ROW;
@@ -196,44 +200,48 @@
=cut
sub apply_limits {
- my $self = shift;
+ my $self = shift;
my $statementref = shift;
- my $per_page = shift;
- my $first = 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') ) )
+ # 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:
+ # 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') ) )
+ # 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++;
+ $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;
+ $$statementref
+ = "SELECT * FROM ( SELECT limitquery.*,rownum limitrownum FROM ( $$statementref ) limitquery WHERE rownum <= "
+ . ( $first + $per_page - 1 )
+ . " ) WHERE limitrownum >= "
+ . $first;
}
}
-
-
=head2 distinct_query STATEMENTREF
takes an incomplete SQL SELECT statement and massages it to return a DISTINCT result set.
@@ -242,19 +250,17 @@
=cut
sub distinct_query {
- my $self = shift;
+ my $self = shift;
my $statementref = shift;
- my $table = 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) ";
+ $$statementref
+ = "SELECT main.* FROM ( SELECT DISTINCT main.id FROM $$statementref ) distinctquery, $table main WHERE (main.id = distinctquery.id) ";
}
-
-
-
=head2 binary_safe_blobs
Return undef, as Oracle doesn't support binary-safe CLOBS
@@ -264,10 +270,9 @@
sub binary_safe_blobs {
my $self = shift;
- return(undef);
+ return (undef);
}
-
1;
__END__
Modified: Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Pg.pm
==============================================================================
--- Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Pg.pm (original)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Pg.pm Mon Jul 25 20:40:33 2005
@@ -26,7 +26,6 @@
=cut
-
=head2 connect
connect takes a hashref and passes it off to SUPER::connect;
@@ -34,18 +33,17 @@
it returns a database handle.
=cut
-
+
sub connect {
my $self = shift;
-
+
$self->SUPER::connect(@_);
$self->simple_query("SET TIME ZONE 'GMT'");
$self->simple_query("SET DATESTYLE TO 'ISO'");
$self->auto_commit(1);
- return ($DBIHandle);
+ return ($DBIHandle);
}
-
=head2 insert
Takes a table name as the first argument and assumes that the rest of the arguments
@@ -56,32 +54,30 @@
=cut
-
sub insert {
- my $self = shift;
+ my $self = shift;
my $table = shift;
-
- my $sth = $self->SUPER::insert($table, @_ );
-
+
+ my $sth = $self->SUPER::insert( $table, @_ );
+
unless ($sth) {
- return ($sth);
+ return ($sth);
}
- #Lets get the id of that row we just inserted
+ #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->fetch_result($sql, $oid);
+ my @row = $self->fetch_result( $sql, $oid );
+
# TODO: Propagate Class::ReturnValue up here.
- unless ($row[0]) {
- print STDERR "Can't find $table.id for OID $oid";
- return(undef);
- }
+ unless ( $row[0] ) {
+ print STDERR "Can't find $table.id for OID $oid";
+ return (undef);
+ }
$self->{'id'} = $row[0];
-
- return ($self->{'id'});
-}
-
+ return ( $self->{'id'} );
+}
=head2 binary_safe_blobs
@@ -91,10 +87,9 @@
sub binary_safe_blobs {
my $self = shift;
- return(undef);
+ return (undef);
}
-
=head2 apply_limits STATEMENTREF ROWS_PER_PAGE FIRST_ROW
takes an SQL SELECT statement and massages it to return ROWS_PER_PAGE starting with FIRST_ROW;
@@ -103,14 +98,14 @@
=cut
sub apply_limits {
- my $self = shift;
+ my $self = shift;
my $statementref = shift;
- my $per_page = shift;
- my $first = shift;
+ my $per_page = shift;
+ my $first = shift;
my $limit_clause = '';
- if ( $per_page) {
+ if ($per_page) {
$limit_clause = " LIMIT ";
$limit_clause .= $per_page;
if ( $first && $first != 0 ) {
@@ -118,11 +113,10 @@
}
}
- $$statementref .= $limit_clause;
+ $$statementref .= $limit_clause;
}
-
=head2 _make_clause_case_insensitive FIELD OPERATOR VALUE
Takes a field, operator and value. performs the magic necessary to make
@@ -138,9 +132,9 @@
my $operator = shift;
my $value = shift;
-
- if ($value =~ /^['"]?\d+['"]?$/) { # we don't need to downcase numeric values
- return ( $field, $operator, $value);
+ if ( $value =~ /^['"]?\d+['"]?$/ )
+ { # we don't need to downcase numeric values
+ return ( $field, $operator, $value );
}
if ( $operator =~ /LIKE/i ) {
@@ -148,19 +142,21 @@
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));
+ 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::_make_clause_case_insensitive( $field, $operator, $value );
+ $self->SUPER::_make_clause_case_insensitive( $field, $operator,
+ $value );
}
}
Modified: Jifty-DBI/trunk/lib/Jifty/DBI/Handle/SQLite.pm
==============================================================================
--- Jifty-DBI/trunk/lib/Jifty/DBI/Handle/SQLite.pm (original)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Handle/SQLite.pm Mon Jul 25 20:40:33 2005
@@ -22,7 +22,6 @@
=cut
-
=head2 insert
Takes a table name as the first argument and assumes that the rest of the arguments
@@ -33,23 +32,22 @@
=cut
-sub insert {
- my $self = shift;
+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;
+ my %args = ( id => undef, @_ );
- # 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');
+ # We really don't want an empty id
- warn "$self no row id returned on row creation" unless ($self->{'id'});
- return( $self->{'id'}); #Add Succeded. return the 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 case_sensitive
@@ -59,14 +57,13 @@
sub case_sensitive {
my $self = shift;
- return(1);
+ return (1);
}
-sub binary_safe_blobs {
+sub binary_safe_blobs {
return undef;
}
-
=head2 distinct_count STATEMENTREF
takes an incomplete SQL SELECT statement and massages it to return a DISTINCT result count
@@ -75,25 +72,24 @@
=cut
sub distinct_count {
- my $self = shift;
+ 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 )";
+ $$statementref
+ = "SELECT count(*) FROM (SELECT DISTINCT main.id FROM $$statementref )";
}
-
-
=head2 _build_joins
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))
+#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
@@ -102,42 +98,44 @@
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;
- }
+ # 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( ',
+ 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 );
+ push( @keys, $join );
die "Unsatisfied dependency chain in Joins @keys"
- if $seen{"@keys"}++;
- }
-
+ if $seen{"@keys"}++;
+ }
+
}
- return ( join ( ", ", ( $join_clause, @{ $sb->{'aliases'} } ) ) );
-
+ return ( join( ", ", ( $join_clause, @{ $sb->{'aliases'} } ) ) );
+
}
1;
Modified: Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Sybase.pm
==============================================================================
--- Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Sybase.pm (original)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Sybase.pm Mon Jul 25 20:40:33 2005
@@ -23,7 +23,6 @@
=cut
-
=head2 insert
Takes a table name as the first argument and assumes that the rest of the arguments
@@ -35,7 +34,7 @@
=cut
sub insert {
- my $self = shift;
+ my $self = shift;
my $table = shift;
my %pairs = @_;
@@ -43,9 +42,9 @@
if ( !$sth ) {
return ($sth);
}
-
+
# Can't select identity column if we're inserting the id by hand.
- unless ($pairs{'id'}) {
+ unless ( $pairs{'id'} ) {
my @row = $self->fetch_result('SELECT @@identity');
# TODO: Propagate Class::ReturnValue up here.
@@ -57,10 +56,6 @@
return ( $self->{'id'} );
}
-
-
-
-
=head2 database_version
return the database version, trimming off any -foo identifier
@@ -69,10 +64,10 @@
sub database_version {
my $self = shift;
- my $v = $self->SUPER::database_version();
+ my $v = $self->SUPER::database_version();
- $v =~ s/\-(.*)$//;
- return ($v);
+ $v =~ s/\-(.*)$//;
+ return ($v);
}
@@ -84,38 +79,34 @@
sub case_sensitive {
my $self = shift;
- return(1);
+ return (1);
}
-
-
-
sub apply_limits {
- my $self = shift;
+ my $self = shift;
my $statementref = shift;
- my $per_page = shift;
- my $first = shift;
+ my $per_page = shift;
+ my $first = shift;
}
-
=head2 distinct_query STATEMENTREFtakes an incomplete SQL SELECT statement and massages it to return a DISTINCT result set.
=cut
sub distinct_query {
- my $self = shift;
+ my $self = shift;
my $statementref = shift;
- my $table = 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) ";
+ $$statementref
+ = "SELECT main.* FROM ( SELECT DISTINCT main.id FROM $$statementref ) distinctquery, $table main WHERE (main.id = distinctquery.id) ";
}
-
=head2 binary_safe_blobs
Return undef, as Oracle doesn't support binary-safe CLOBS
@@ -125,11 +116,9 @@
sub binary_safe_blobs {
my $self = shift;
- return(undef);
+ return (undef);
}
-
-
1;
__END__
Modified: Jifty-DBI/trunk/lib/Jifty/DBI/Handle/mysql.pm
==============================================================================
--- Jifty-DBI/trunk/lib/Jifty/DBI/Handle/mysql.pm (original)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Handle/mysql.pm Mon Jul 25 20:40:33 2005
@@ -23,7 +23,6 @@
=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.
@@ -33,26 +32,24 @@
=cut
-sub insert {
+sub insert {
my $self = shift;
my $sth = $self->SUPER::insert(@_);
- if (!$sth) {
- return ($sth);
- }
+ if ( !$sth ) {
+ return ($sth);
+ }
+
+ $self->{'id'} = $self->dbh->{'mysql_insertid'};
- $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->fetch_result('SELECT LAST_INSERT_ID()');
+ unless ( $self->{'id'} ) {
+ $self->{'id'} = $self->fetch_result('SELECT LAST_INSERT_ID()');
}
- warn "$self no row id returned on row creation" unless ($self->{'id'});
-
- return( $self->{'id'}); #Add Succeded. return the id
- }
-
+ warn "$self no row id returned on row creation" unless ( $self->{'id'} );
+ return ( $self->{'id'} ); #Add Succeded. return the id
+}
=head2 database_version
@@ -62,10 +59,10 @@
sub database_version {
my $self = shift;
- my $v = $self->SUPER::database_version();
+ my $v = $self->SUPER::database_version();
- $v =~ s/\-.*$//;
- return ($v);
+ $v =~ s/\-.*$//;
+ return ($v);
}
=head2 case_sensitive
@@ -76,10 +73,9 @@
sub case_sensitive {
my $self = shift;
- return(undef);
+ return (undef);
}
-
1;
__END__
Modified: Jifty-DBI/trunk/lib/Jifty/DBI/Handle/mysqlPP.pm
==============================================================================
--- Jifty-DBI/trunk/lib/Jifty/DBI/Handle/mysqlPP.pm (original)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Handle/mysqlPP.pm Mon Jul 25 20:40:33 2005
@@ -1,9 +1,9 @@
-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;
+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;
Modified: Jifty-DBI/trunk/lib/Jifty/DBI/Record.pm
==============================================================================
--- Jifty-DBI/trunk/lib/Jifty/DBI/Record.pm (original)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Record.pm Mon Jul 25 20:40:33 2005
@@ -7,8 +7,6 @@
use vars qw($AUTOLOAD);
use Class::ReturnValue;
-
-
=head1 NAME
Jifty::DBI::Record - Superclass for records loaded by SearchBuilder
@@ -344,68 +342,59 @@
=cut
-
-
=head2 new
Instantiate a new record object.
=cut
-
-sub new {
+sub new {
my $proto = shift;
-
+
my $class = ref($proto) || $proto;
- my $self = {};
- bless ($self, $class);
+ my $self = {};
+ bless( $self, $class );
$self->_init(@_);
return $self;
- }
-
+}
# Not yet documented here. Should almost certainly be overloaded.
sub _init {
- my $self = shift;
+ my $self = shift;
my $handle = shift;
$self->_handle($handle);
}
-
=head2 id
Returns this row's primary key.
=cut
-sub id {
+sub id {
my $pkey = $_[0]->_primary_key();
- my $ret = $_[0]->{'values'}->{$pkey};
+ my $ret = $_[0]->{'values'}->{$pkey};
return $ret;
}
-
=head2 primary_keys
Return a hash of the values of our primary keys for this function.
=cut
-sub primary_keys {
- my $self = shift;
- my %hash = map { $_ => $self->{'values'}->{$_} } @{$self->_primary_keys};
+sub primary_keys {
+ my $self = shift;
+ my %hash
+ = map { $_ => $self->{'values'}->{$_} } @{ $self->_primary_keys };
return (%hash);
}
-
-
-
sub DESTROY {
return 1;
}
-
sub AUTOLOAD {
my $self = $_[0];
@@ -416,12 +405,13 @@
*{$AUTOLOAD} = sub { return ( $_[0]->_value($Attrib) ) };
goto &$AUTOLOAD;
}
- elsif ( $self->_accessible( $Attrib, 'record-read') ) {
- *{$AUTOLOAD} = sub { $_[0]->_to_record( $Attrib, $_[0]->_value($Attrib) ) };
- goto &$AUTOLOAD;
+ elsif ( $self->_accessible( $Attrib, 'record-read' ) ) {
+ *{$AUTOLOAD}
+ = sub { $_[0]->_to_record( $Attrib, $_[0]->_value($Attrib) ) };
+ goto &$AUTOLOAD;
}
- elsif ( $self->_accessible( $Attrib, 'foreign-collection') ) {
- *{$AUTOLOAD} = sub { $_[0]->_collection_value( $Attrib ) };
+ elsif ( $self->_accessible( $Attrib, 'foreign-collection' ) ) {
+ *{$AUTOLOAD} = sub { $_[0]->_collection_value($Attrib) };
goto &$AUTOLOAD;
}
elsif ( $AUTOLOAD =~ /.*::set_(\w+)/o ) {
@@ -432,15 +422,17 @@
return ( $_[0]->_set( field => $Attrib, value => $_[1] ) );
};
goto &$AUTOLOAD;
- } elsif ( $self->_accessible( $Attrib, 'record-write') ) {
+ }
+ elsif ( $self->_accessible( $Attrib, 'record-write' ) ) {
*{$AUTOLOAD} = sub {
my $self = shift;
- my $val = shift;
+ my $val = shift;
- $val = $val->id if UNIVERSAL::isa($val, 'Jifty::DBI::Record');
+ $val = $val->id
+ if UNIVERSAL::isa( $val, 'Jifty::DBI::Record' );
return ( $self->_set( field => $Attrib, value => $val ) );
};
- goto &$AUTOLOAD;
+ goto &$AUTOLOAD;
}
elsif ( $self->_accessible( $Attrib, 'read' ) ) {
*{$AUTOLOAD} = sub { return ( 0, 'Immutable field' ) };
@@ -477,8 +469,8 @@
goto &$AUTOLOAD;
}
- # TODO: if autoload = 0 or 1 _ then a combination of lowercase and _ chars,
- # turn them into studlycapped phrases
+ # TODO: if autoload = 0 or 1 _ then a combination of lowercase and _ chars,
+ # turn them into studlycapped phrases
else {
my ( $package, $filename, $line );
@@ -489,8 +481,6 @@
}
-
-
=head2 _accessible KEY MODE
Private method.
@@ -499,19 +489,16 @@
=cut
-
sub _accessible {
my $self = shift;
my $attr = shift;
- my $mode = lc(shift || '');
+ my $mode = lc( shift || '' );
my $attribute = $self->_class_accessible(@_)->{$attr};
return unless defined $attribute;
return $attribute->{$mode};
}
-
-
=head2 _primary_keys
Return our primary keys. (Subclasses should override this, but our default is that we have one primary key, named 'id'.)
@@ -523,16 +510,14 @@
return ['id'];
}
-
sub _primary_key {
- my $self = shift;
+ my $self = shift;
my $pkeys = $self->_primary_keys();
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 _class_accessible
An older way to specify fields attributes in a derived class.
@@ -552,98 +537,97 @@
=cut
-
sub _class_accessible {
my $self = shift;
return $self->_class_accessible_from_schema 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
+ # 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);
+ $accessible{$col}->{ lc($_) } = 1 foreach split( /[\/,]/, shift );
}
- return(\%accessible);
+ return ( \%accessible );
}
sub _class_accessible_from_schema {
my $self = shift;
-
+
my $accessible = {};
- foreach my $key ($self->_primary_keys) {
+ foreach my $key ( $self->_primary_keys ) {
$accessible->{$key} = { 'read' => 1 };
- };
-
+ }
+
my $schema = $self->schema;
-
- for my $field (keys %$schema) {
- if ($schema->{$field}{'TYPE'}) {
+
+ 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')) {
+ }
+ 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 {
+ }
+ else {
warn "Error: $refclass neither Record nor Collection";
}
}
}
-
- return $accessible;
-}
+ return $accessible;
+}
sub _to_record {
- my $self = shift;
+ my $self = shift;
my $field = shift;
my $value = shift;
return unless defined $value;
-
- my $schema = $self->schema;
+
+ 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
+ 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->load_by_id( $value );
+ $object->load_by_id($value);
return $object;
}
-
sub _collection_value {
my $self = shift;
-
- my $method_name = shift;
+
+ my $method_name = shift;
return unless defined $method_name;
-
- my $schema = $self->schema;
+
+ my $schema = $self->schema;
my $description = $schema->{$method_name};
return unless $description;
-
+
my $classname = $description->{'REFERENCES'};
- return unless UNIVERSAL::isa($classname, 'Jifty::DBI::Collection');
-
+ return unless UNIVERSAL::isa( $classname, 'Jifty::DBI::Collection' );
+
my $coll = $classname->new( handle => $self->_handle );
-
- $coll->Limit( FIELD => $description->{'KEY'}, VALUE => $self->id);
-
+
+ $coll->Limit( FIELD => $description->{'KEY'}, VALUE => $self->id );
+
return $coll;
}
-
# sub {{{ readable_attributes
=head2 readable_attributes
@@ -654,14 +638,13 @@
=cut
sub readable_attributes {
- my $self = shift;
- my $ca = $self->_class_accessible();
- my @readable = grep { $ca->{$_}->{'read'} or $ca->{$_}->{'record-read'} } keys %{$ca};
+ my $self = shift;
+ my $ca = $self->_class_accessible();
+ my @readable = grep { $ca->{$_}->{'read'} or $ca->{$_}->{'record-read'} }
+ keys %{$ca};
return (@readable);
}
-
-
=head2 writable_attributes
Returns an array of the attributes of this class defined as "write" =>
@@ -671,14 +654,13 @@
sub writable_attributes {
my $self = shift;
- my $ca = $self->_class_accessible();
- my @writable = grep { $ca->{$_}->{'write'} || $ca->{$_}->{'record-write'} } keys %{$ca};
+ my $ca = $self->_class_accessible();
+ 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
@@ -686,19 +668,19 @@
=cut
-
sub __value {
- my $self = shift;
+ my $self = shift;
my $field = lc shift;
- if (!$self->{'fetched'}{$field} and my $id = $self->id() ) {
+ if ( !$self->{'fetched'}{$field} and my $id = $self->id() ) {
my $pkey = $self->_primary_key();
- my $QueryString = "SELECT $field FROM " . $self->table . " WHERE $pkey = ?";
+ my $QueryString
+ = "SELECT $field FROM " . $self->table . " WHERE $pkey = ?";
my $sth = $self->_handle->simple_query( $QueryString, $id );
my ($value) = eval { $sth->fetchrow_array() };
warn $@ if $@;
- $self->{'values'}{$field} = $value;
+ $self->{'values'}{$field} = $value;
$self->{'fetched'}{$field} = 1;
}
@@ -715,14 +697,11 @@
=cut
-
-sub _value {
- my $self = shift;
- return ($self->__value(@_));
+sub _value {
+ my $self = shift;
+ return ( $self->__value(@_) );
}
-
-
=head2 _set
_set takes a single column name and a single unquoted value.
@@ -731,21 +710,17 @@
=cut
-
sub _set {
my $self = shift;
- return ($self->__set(@_));
+ return ( $self->__set(@_) );
}
-
-
-
sub __set {
my $self = shift;
my %args = (
- 'field' => undef,
- 'value' => undef,
+ 'field' => undef,
+ 'value' => undef,
'is_sql' => undef,
@_
);
@@ -774,7 +749,7 @@
);
return ( $ret->return_value );
}
- elsif ( ( defined $self->__value($column) )
+ elsif ( ( defined $self->__value($column) )
and ( $args{'value'} eq $self->__value($column) ) )
{
$ret->as_array( 0, "That is already the current value" );
@@ -786,14 +761,10 @@
return ( $ret->return_value );
}
-
-
# First, we truncate the value, if we need to.
#
-
-
- $args{'value'} = $self->truncate_value ( $args{'column'}, $args{'value'});
+ $args{'value'} = $self->truncate_value( $args{'column'}, $args{'value'} );
my $method = "validate_" . $args{'column'};
unless ( $self->$method( $args{'value'} ) ) {
@@ -814,22 +785,24 @@
my $unmunged_value = $args{'value'};
unless ( $self->_handle->knows_blobs ) {
+
# Support for databases which don't deal with LOBs automatically
- my $ca = $self->_class_accessible();
+ my $ca = $self->_class_accessible();
my $key = $args{'column'};
- if ( $ca->{$key}->{'type'} =~ /^(text|longtext|clob|blob|lob)$/i ) {
- my $bhash = $self->_handle->blob_params( $key, $ca->{$key}->{'type'} );
- $bhash->{'value'} = $args{'value'};
- $args{'value'} = $bhash;
- }
+ if ( $ca->{$key}->{'type'} =~ /^(text|longtext|clob|blob|lob)$/i ) {
+ my $bhash
+ = $self->_handle->blob_params( $key, $ca->{$key}->{'type'} );
+ $bhash->{'value'} = $args{'value'};
+ $args{'value'} = $bhash;
}
-
+ }
my $val = $self->_handle->update_record_value(%args);
unless ($val) {
- my $message =
- $args{'column'} . " could not be set to " . $args{'value'} . "." ;
- $ret->as_array( 0, $message);
+ my $message = $args{'column'}
+ . " could not be set to "
+ . $args{'value'} . ".";
+ $ret->as_array( 0, $message );
$ret->as_error(
errno => 4,
do_backtrace => 0,
@@ -837,6 +810,7 @@
);
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)
@@ -885,14 +859,11 @@
=cut
sub _canonicalize {
- my $self = shift;
+ my $self = shift;
my $field = shift;
-
-
}
-
=head2 _Validate FIELD VALUE
Validate that VALUE will be an acceptable value for FIELD.
@@ -903,26 +874,21 @@
=cut
-
-
-
-sub _validate {
- my $self = shift;
+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);
- }
-
+ #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 truncate_value KEY VALUE
@@ -939,7 +905,7 @@
my $value = shift;
# We don't need to truncate empty things.
- return undef unless (defined ($value));
+ return undef unless ( defined($value) );
my $metadata = $self->_class_accessible->{$key};
@@ -947,7 +913,7 @@
if ( $metadata->{'length'} && !$metadata->{'is_numeric'} ) {
$truncate_to = $metadata->{'length'};
}
- elsif ($metadata->{'type'} && $metadata->{'type'} =~ /char\((\d+)\)/ ) {
+ elsif ( $metadata->{'type'} && $metadata->{'type'} =~ /char\((\d+)\)/ ) {
$truncate_to = $1;
}
@@ -960,7 +926,8 @@
if ( Encode::is_utf8($value) ) {
return Encode::decode(
- utf8 => substr( Encode::encode( utf8 => $value ), 0, $truncate_to ),
+ utf8 =>
+ substr( Encode::encode( utf8 => $value ), 0, $truncate_to ),
Encode::FB_QUIET(),
);
}
@@ -976,7 +943,6 @@
}
-
=head2 _object
_object takes a single column name and an array reference. It creates
@@ -1021,9 +987,6 @@
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
@@ -1037,13 +1000,13 @@
=cut
-sub load {
+sub load {
my $self = shift;
+
# my ($package, $filename, $line) = caller;
return $self->load_by_id(@_);
}
-
=head2 load_by_col
Takes two arguments, a column and a value. The column can be any table column
@@ -1052,17 +1015,13 @@
=cut
-
-
-sub load_by_col {
+sub load_by_col {
my $self = shift;
- my $col = shift;
- my $val = shift;
-
- return($self->load_by_cols($col => $val));
-}
-
+ my $col = shift;
+ my $val = shift;
+ return ( $self->load_by_cols( $col => $val ) );
+}
=head2 loadbycols
@@ -1076,48 +1035,53 @@
=cut
-sub load_by_cols {
+sub load_by_cols {
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->_class_accessible->{$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->_load_from_sql($QueryString, @bind));
-}
+ 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->_class_accessible->{$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->_load_from_sql( $QueryString, @bind ) );
+}
=head2 loadbyid
@@ -1125,19 +1089,15 @@
=cut
-
-sub load_by_id {
+sub load_by_id {
my $self = shift;
- my $id = shift;
+ my $id = shift;
- $id = 0 if (!defined($id));
+ $id = 0 if ( !defined($id) );
my $pkey = $self->_primary_key();
- return ($self->load_by_cols($pkey => $id));
+ return ( $self->load_by_cols( $pkey => $id ) );
}
-
-
-
=head2 load_by_primary_keys
Like load_by_id with basic support for compound primary keys.
@@ -1146,19 +1106,16 @@
sub load_by_primary_keys {
my $self = shift;
- my $data = (ref $_[0] eq 'HASH')? $_[0]: {@_};
+ my $data = ( ref $_[0] eq 'HASH' ) ? $_[0] : {@_};
- my %cols=();
- foreach (@{$self->_primary_keys}) {
- return (0, "Missing PK field: '$_'") unless defined $data->{$_};
- $cols{$_}=$data->{$_};
+ my %cols = ();
+ foreach ( @{ $self->_primary_keys } ) {
+ return ( 0, "Missing PK field: '$_'" ) unless defined $data->{$_};
+ $cols{$_} = $data->{$_};
}
- return ($self->load_by_cols(%cols));
+ return ( $self->load_by_cols(%cols) );
}
-
-
-
=head2 load_from_hash
Takes a hashref, such as created by Jifty::DBI and populates this record's
@@ -1167,28 +1124,23 @@
=cut
sub load_from_hash {
- my $self = shift;
- my $hashref = shift;
+ my $self = shift;
+ my $hashref = shift;
- foreach my $f ( keys %$hashref ) {
- $self->{'fetched'}{lc $f} = 1;
- }
+ foreach my $f ( keys %$hashref ) {
+ $self->{'fetched'}{ lc $f } = 1;
+ }
- $self->{'values'} = $hashref;
- return $self->id();
+ $self->{'values'} = $hashref;
+ return $self->id();
}
-
-
=head2 _load_from_sql QUERYSTRING @BIND_VALUES
Load a record as the result of an SQL statement
=cut
-
-
-
sub _load_from_sql {
my $self = shift;
my $QueryString = shift;
@@ -1200,34 +1152,30 @@
return ( 0, "Couldn't execute query" ) unless $sth;
- $self->{'values'} = $sth->fetchrow_hashref;
+ $self->{'values'} = $sth->fetchrow_hashref;
$self->{'fetched'} = {};
if ( !$self->{'values'} && $sth->err ) {
- return ( 0, "Couldn't fetch row: ". $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
+ ## I guess to be consistant with the old code, make sure the primary
## keys exist.
- if( grep { not defined } $self->primary_keys ) {
+ if ( grep { not defined } $self->primary_keys ) {
return ( 0, "Missing a primary key?" );
}
-
- foreach my $f ( keys %{$self->{'values'}} ) {
- $self->{'fetched'}{lc $f} = 1;
+
+ 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
@@ -1244,8 +1192,7 @@
if ( $self->_accessible( $key, 'record-write' ) ) {
$attribs{$key} = $attribs{$key}->id
- if UNIVERSAL::isa( $attribs{$key},
- 'Jifty::DBI::Record' );
+ if UNIVERSAL::isa( $attribs{$key}, 'Jifty::DBI::Record' );
}
#Truncate things that are too long for their datatypes
@@ -1257,9 +1204,10 @@
# Support for databases which don't deal with LOBs automatically
my $ca = $self->_class_accessible();
foreach $key ( keys %attribs ) {
- if ( $ca->{$key}->{'type'} =~ /^(text|longtext|clob|blob|lob)$/i ) {
- my $bhash =
- $self->_handle->blob_params( $key, $ca->{$key}->{'type'} );
+ if ( $ca->{$key}->{'type'} =~ /^(text|longtext|clob|blob|lob)$/i )
+ {
+ my $bhash = $self->_handle->blob_params( $key,
+ $ca->{$key}->{'type'} );
$bhash->{'value'} = $attribs{$key};
$attribs{$key} = $bhash;
}
@@ -1268,7 +1216,6 @@
return ( $self->_handle->insert( $self->table, %attribs ) );
}
-
=head2 delete
Delete this record from the database. On failure return a
@@ -1282,34 +1229,31 @@
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->primary_keys();
- my $where = 'WHERE ';
- foreach my $key (keys %pkeys) {
- $where .= $key . "=?" . " AND ";
- push (@bind, $pkeys{$key});
+ my @bind = ();
+ my %pkeys = $self->primary_keys();
+ 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->simple_query($QueryString, @bind);
+ my $QueryString = "DELETE FROM " . $self->table . ' ' . $where;
+ my $return = $self->_handle->simple_query( $QueryString, @bind );
- if (UNIVERSAL::isa('Class::ReturnValue', $return)) {
+ if ( UNIVERSAL::isa( 'Class::ReturnValue', $return ) ) {
return ($return);
- } else {
- return(1);
- }
+ }
+ else {
+ return (1);
+ }
}
-
-
-
-
=head2 table
Returns or sets the name of the current table
@@ -1319,26 +1263,23 @@
sub table {
my $self = shift;
if (@_) {
- $self->{'table'} = shift;
+ $self->{'table'} = shift;
}
- return ($self->{'table'});
+ return ( $self->{'table'} );
}
-
-
=head2 _handle
Returns or sets the current Jifty::DBI::Handle object
=cut
-
-sub _handle {
+sub _handle {
my $self = shift;
if (@_) {
$self->{'DBIxHandle'} = shift;
}
- return ($self->{'DBIxHandle'});
+ return ( $self->{'DBIxHandle'} );
}
1;
Modified: Jifty-DBI/trunk/lib/Jifty/DBI/Record/Cachable.pm
==============================================================================
--- Jifty-DBI/trunk/lib/Jifty/DBI/Record/Cachable.pm (original)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Record/Cachable.pm Mon Jul 25 20:40:33 2005
@@ -11,7 +11,6 @@
use strict;
-
=head1 NAME
Jifty::DBI::Record::Cachable - Records with caching behavior
@@ -31,7 +30,6 @@
=cut
-
my %_CACHES = ();
# Function: new
@@ -64,12 +62,13 @@
%_CACHES = ();
}
-
sub _key_cache {
- my $self = shift;
- my $cache = $self->_handle->DSN . "-KEYS--" . ($self->{'_Class'} ||= ref($self));
- $self->_setup_cache($cache) unless exists ($_CACHES{$cache});
- return ($_CACHES{$cache});
+ my $self = shift;
+ my $cache = $self->_handle->DSN
+ . "-KEYS--"
+ . ( $self->{'_Class'} ||= ref($self) );
+ $self->_setup_cache($cache) unless exists( $_CACHES{$cache} );
+ return ( $_CACHES{$cache} );
}
@@ -80,16 +79,19 @@
=cut
sub _flush_key_cache {
- my $self = shift;
- my $cache = $self->_handle->DSN . "-KEYS--" . ($self->{'_Class'} ||= ref($self));
+ my $self = shift;
+ my $cache = $self->_handle->DSN
+ . "-KEYS--"
+ . ( $self->{'_Class'} ||= ref($self) );
$self->_setup_cache($cache);
}
sub _record_cache {
my $self = shift;
- my $cache = $self->_handle->DSN . "--" . ($self->{'_Class'} ||= ref($self));
- $self->_setup_cache($cache) unless exists ($_CACHES{$cache});
- return ($_CACHES{$cache});
+ my $cache
+ = $self->_handle->DSN . "--" . ( $self->{'_Class'} ||= ref($self) );
+ $self->_setup_cache($cache) unless exists( $_CACHES{$cache} );
+ return ( $_CACHES{$cache} );
}
@@ -138,7 +140,7 @@
if ($rvalue) {
## Only cache the object if its okay to do so.
$self->_store();
- $self->_key_cache->set( $alt_key, $self->_primary_RecordCache_key);
+ $self->_key_cache->set( $alt_key, $self->_primary_RecordCache_key );
}
return ( $rvalue, $msg );
@@ -180,10 +182,12 @@
sub _expire (\$) {
my $self = shift;
- $self->_record_cache->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->_record_cache->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->_flush_key_cache;
-
+
}
# Function: _fetch
@@ -196,12 +200,11 @@
my ( $self, $cache_key ) = @_;
my $data = $self->_record_cache->fetch($cache_key) or return;
- @{$self}{keys %$data} = values %$data; # deserialize
+ @{$self}{ keys %$data } = values %$data; # deserialize
return 1;
}
-
sub __Value {
my $self = shift;
my $field = shift;
@@ -216,15 +219,15 @@
sub _store (\$) {
my $self = shift;
- $self->_record_cache->set( $self->_primary_RecordCache_key, $self->_serialize);
+ $self->_record_cache->set( $self->_primary_RecordCache_key,
+ $self->_serialize );
return (1);
}
sub _serialize {
my $self = shift;
return (
- {
- values => $self->{'values'},
+ { values => $self->{'values'},
table => $self->table,
fetched => $self->{'fetched'}
}
@@ -239,8 +242,9 @@
sub _gen_alternate_RecordCache_key {
my ( $self, %attr ) = @_;
+
#return( Storable::nfreeze( %attr));
- my $cache_key;
+ my $cache_key;
while ( my ( $key, $value ) = each %attr ) {
$key ||= '__undef';
$value ||= '__undef';
@@ -290,7 +294,8 @@
$primary_RecordCache_key .= join( ',', @attributes );
- $self->{'_SB_Record_Primary_RecordCache_key'} = $primary_RecordCache_key;
+ $self->{'_SB_Record_Primary_RecordCache_key'}
+ = $primary_RecordCache_key;
}
return ( $self->{'_SB_Record_Primary_RecordCache_key'} );
@@ -305,7 +310,7 @@
my $alternate_key = shift;
return undef unless ($alternate_key);
- my $primary_key = $self->_key_cache->fetch($alternate_key);
+ my $primary_key = $self->_key_cache->fetch($alternate_key);
if ($primary_key) {
return ($primary_key);
}
@@ -333,8 +338,7 @@
=cut
sub _cache_config {
- {
- 'cache_p' => 1,
+ { 'cache_p' => 1,
'cache_for_sec' => 5,
};
}
Modified: Jifty-DBI/trunk/lib/Jifty/DBI/SchemaGenerator.pm
==============================================================================
--- Jifty-DBI/trunk/lib/Jifty/DBI/SchemaGenerator.pm (original)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/SchemaGenerator.pm Mon Jul 25 20:40:33 2005
@@ -9,6 +9,7 @@
# Public accessors
__PACKAGE__->mk_accessors(qw(handle));
+
# Internal accessors: do not use from outside class
__PACKAGE__->mk_accessors(qw(_db_schema));
@@ -20,16 +21,16 @@
=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;
+ 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
@@ -46,31 +47,32 @@
=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: $@");
+ 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;
}
-
- 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;
+
+ my $table_obj = $self->_DBSchemaTableFromModel($model);
+
+ $self->_db_schema->addtable($table_obj);
+
+ 1;
}
=for public_doc CreateTableSQLStatements
@@ -81,9 +83,10 @@
=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);
+ 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
@@ -94,9 +97,9 @@
=cut
sub CreateTableSQLText {
- my $self = shift;
+ my $self = shift;
- return join "\n", map { "$_ ;\n" } $self->CreateTableSQLStatements;
+ return join "\n", map {"$_ ;\n"} $self->CreateTableSQLStatements;
}
=for private_doc _DBSchemaTableFromModel MODEL
@@ -107,46 +110,54 @@
=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;
+ 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
@@ -156,16 +167,15 @@
=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;
-}
+ 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
+1; # Magic true value required at end of module
__END__
=head1 NAME
Modified: Jifty-DBI/trunk/lib/Jifty/DBI/Union.pm
==============================================================================
--- Jifty-DBI/trunk/lib/Jifty/DBI/Union.pm (original)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Union.pm Mon Jul 25 20:40:33 2005
@@ -48,12 +48,13 @@
=cut
sub new {
- bless {
- data => [],
- curp => 0, # current offset in data
- item => 0, # number of indiv items from First
- count => undef,
- }, shift;
+ bless {
+ data => [],
+ curp => 0, # current offset in data
+ item => 0, # number of indiv items from First
+ count => undef,
+ },
+ shift;
}
=head2 add $sb
@@ -66,15 +67,18 @@
sub add {
my $self = shift;
- my $newobj = 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]) .".";
- }
+ 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;
+ $self->{count} = undef;
+ push @{ $self->{data} }, $newobj;
}
=head2 First
@@ -88,11 +92,11 @@
sub First {
my $self = shift;
- die "No elements in Jifty::DBI::Union"
- unless @{$self->{data}};
+ die "No elements in Jifty::DBI::Union"
+ unless @{ $self->{data} };
$self->{curp} = 0;
- $self->{item} = 0;
+ $self->{item} = 0;
$self->{data}[0]->First;
}
@@ -103,20 +107,21 @@
=cut
sub Next {
- my $self=shift;
+ my $self = shift;
+
+ return undef unless defined $self->{data}[ $self->{curp} ];
- return undef unless defined $self->{data}[ $self->{curp} ];
+ my $cur = $self->{data}[ $self->{curp} ];
+ if ( $cur->_ItemsCounter == $cur->Count ) {
- 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;
+ # 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
@@ -126,10 +131,10 @@
=cut
sub Last {
- die "Last doesn't work right now";
- my $self = shift;
- $self->GotoItem( ( $self->Count ) - 1 );
- return ( $self->Next );
+ die "Last doesn't work right now";
+ my $self = shift;
+ $self->GotoItem( ( $self->Count ) - 1 );
+ return ( $self->Next );
}
=head2 Count
@@ -139,20 +144,19 @@
=cut
sub Count {
- my $self = shift;
- my $sum = 0;
+ my $self = shift;
+ my $sum = 0;
- # cache the results
- return $self->{count} if defined $self->{count};
+ # cache the results
+ return $self->{count} if defined $self->{count};
- $sum += $_->Count for (@{$self->{data}});
+ $sum += $_->Count for ( @{ $self->{data} } );
- $self->{count} = $sum;
+ $self->{count} = $sum;
- return $sum;
+ return $sum;
}
-
=head2 GotoFirstItem
Starts the recordset counter over from the first item. the next time
@@ -162,22 +166,22 @@
=cut
sub GotoFirstItem {
- my $self = shift;
- $self->GotoItem(0);
+ my $self = shift;
+ $self->GotoItem(0);
}
sub GotoItem {
- my $self = shift;
- my $item = shift;
+ my $self = shift;
+ my $item = shift;
- die "We currently only support going to the First item"
- unless $item == 0;
+ die "We currently only support going to the First item"
+ unless $item == 0;
- $self->{curp} = 0;
- $self->{item} = 0;
- $self->{data}[0]->GotoItem(0);
+ $self->{curp} = 0;
+ $self->{item} = 0;
+ $self->{data}[0]->GotoItem(0);
- return $item;
+ return $item;
}
=head2 IsLast
@@ -189,7 +193,7 @@
sub IsLast {
my $self = shift;
- $self->{item} == $self->Count ? 1 : undef;
+ $self->{item} == $self->Count ? 1 : undef;
}
=head2 ItemsArrayRef
@@ -205,13 +209,13 @@
return [] unless $self->Count;
- $self->GotoFirstItem();
- my @ret;
- while( my $r = $self->Next ) {
- push @ret, $r;
- }
+ $self->GotoFirstItem();
+ my @ret;
+ while ( my $r = $self->Next ) {
+ push @ret, $r;
+ }
- return \@ret;
+ return \@ret;
}
=head1 AUTHOR
Modified: Jifty-DBI/trunk/lib/Jifty/DBI/Unique.pm
==============================================================================
--- Jifty-DBI/trunk/lib/Jifty/DBI/Unique.pm (original)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Unique.pm Mon Jul 25 20:40:33 2005
@@ -1,22 +1,20 @@
package Jifty::DBI::Unique;
use base 'Exporter';
-our @EXPORT = qw(AddRecord);
+our @EXPORT = qw(AddRecord);
our $VERSION = "0.01";
use strict;
use warnings;
-
-
sub AddRecord {
- my $self = shift;
+ 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;
+ $self->{"dbix_sb_unique_cache"} = {} unless ( @{ $self->{'items'} }[0] );
+ return if $self->{"dbix_sb_unique_cache"}->{ $record->id }++;
+ push @{ $self->{'items'} }, $record;
}
1;
More information about the Rt-commit
mailing list