[Rt-commit] r3532 - in Jifty-DBI/trunk: . inc/Module
inc/Module/Install lib/Jifty/DBI lib/Jifty/DBI/Handle
lib/Jifty/DBI/Record t
alexmv at bestpractical.com
alexmv at bestpractical.com
Mon Jul 25 16:13:00 EDT 2005
Author: alexmv
Date: Mon Jul 25 16:12:59 2005
New Revision: 3532
Removed:
Jifty-DBI/trunk/t/01nocap_api.t
Modified:
Jifty-DBI/trunk/ (props changed)
Jifty-DBI/trunk/MANIFEST
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/Collection.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/SQLite.pm
Jifty-DBI/trunk/lib/Jifty/DBI/Handle/Sybase.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/t/01records.t
Jifty-DBI/trunk/t/01searches.t
Jifty-DBI/trunk/t/02records_object.t
Jifty-DBI/trunk/t/11schema_records.t
Jifty-DBI/trunk/t/testmodels.pl
Log:
r5377 at zoq-fot-pik: chmrr | 2005-07-25 16:12:30 -0400
* More capitalization fixes; passes all tests
Modified: Jifty-DBI/trunk/MANIFEST
==============================================================================
--- Jifty-DBI/trunk/MANIFEST (original)
+++ Jifty-DBI/trunk/MANIFEST Mon Jul 25 16:12:59 2005
@@ -7,30 +7,28 @@
inc/Module/Install/Base.pm
inc/Module/Install/Makefile.pm
inc/Module/Install/Metadata.pm
+lib/Jifty/DBI/Collection.pm
+lib/Jifty/DBI/Handle.pm
+lib/Jifty/DBI/Handle/Informix.pm
+lib/Jifty/DBI/Handle/mysql.pm
+lib/Jifty/DBI/Handle/mysqlPP.pm
+lib/Jifty/DBI/Handle/ODBC.pm
+lib/Jifty/DBI/Handle/Oracle.pm
+lib/Jifty/DBI/Handle/Pg.pm
+lib/Jifty/DBI/Handle/SQLite.pm
+lib/Jifty/DBI/Handle/Sybase.pm
+lib/Jifty/DBI/Record.pm
+lib/Jifty/DBI/Record/Cachable.pm
+lib/Jifty/DBI/SchemaGenerator.pm
+lib/Jifty/DBI/Union.pm
+lib/Jifty/DBI/Unique.pm
Makefile.PL
MANIFEST This list of files
META.yml
-pm_to_blib
README
-SearchBuilder.pm
-SearchBuilder/Handle.pm
-SearchBuilder/Handle/Informix.pm
-SearchBuilder/Handle/mysql.pm
-SearchBuilder/Handle/mysqlPP.pm
-SearchBuilder/Handle/ODBC.pm
-SearchBuilder/Handle/Oracle.pm
-SearchBuilder/Handle/Pg.pm
-SearchBuilder/Handle/SQLite.pm
-SearchBuilder/Handle/Sybase.pm
-SearchBuilder/Record.pm
-SearchBuilder/Record/Cachable.pm
-SearchBuilder/SchemaGenerator.pm
-SearchBuilder/Union.pm
-SearchBuilder/Unique.pm
-SIGNATURE
+ROADMAP
t/00.load.t
t/01basics.t
-t/01nocap_api.t
t/01records.t
t/01searches.t
t/02records_object.t
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 16:12:59 2005
@@ -1,4 +1,4 @@
-#line 1 "inc/Module/Install.pm - /usr/local/share/perl/5.8.4/Module/Install.pm"
+#line 1 "inc/Module/Install.pm - /usr/lib/perl5/site_perl/5.8.7/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 16:12:59 2005
@@ -1,4 +1,4 @@
-#line 1 "inc/Module/Install/AutoInstall.pm - /usr/local/share/perl/5.8.4/Module/Install/AutoInstall.pm"
+#line 1 "inc/Module/Install/AutoInstall.pm - /usr/lib/perl5/site_perl/5.8.7/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 16:12:59 2005
@@ -1,4 +1,4 @@
-#line 1 "inc/Module/Install/Base.pm - /usr/local/share/perl/5.8.4/Module/Install/Base.pm"
+#line 1 "inc/Module/Install/Base.pm - /usr/lib/perl5/site_perl/5.8.7/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 16:12:59 2005
@@ -1,4 +1,4 @@
-#line 1 "inc/Module/Install/Makefile.pm - /usr/local/share/perl/5.8.4/Module/Install/Makefile.pm"
+#line 1 "inc/Module/Install/Makefile.pm - /usr/lib/perl5/site_perl/5.8.7/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 16:12:59 2005
@@ -1,4 +1,4 @@
-#line 1 "inc/Module/Install/Metadata.pm - /usr/local/share/perl/5.8.4/Module/Install/Metadata.pm"
+#line 1 "inc/Module/Install/Metadata.pm - /usr/lib/perl5/site_perl/5.8.7/Module/Install/Metadata.pm"
package Module::Install::Metadata;
use Module::Install::Base; @ISA = qw(Module::Install::Base);
Modified: Jifty-DBI/trunk/lib/Jifty/DBI/Collection.pm
==============================================================================
--- Jifty-DBI/trunk/lib/Jifty/DBI/Collection.pm (original)
+++ Jifty-DBI/trunk/lib/Jifty/DBI/Collection.pm Mon Jul 25 16:12:59 2005
@@ -4,15 +4,13 @@
use strict;
use vars qw($VERSION);
-$VERSION = "1.30_03";
-
=head1 NAME
-Jifty::DBI - Encapsulate SQL queries and rows in simple perl objects
+Jifty::DBI::Collection - Encapsulate SQL queries and rows in simple perl objects
=head1 SYNOPSIS
- use Jifty::DBI;
+ use Jifty::DBI::Collection;
package My::Things;
use base qw/Jifty::DBI::Collection/;
@@ -47,11 +45,11 @@
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
+In order to use this module, you should create a subclass of C<Jifty::DBI::Collection> 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<new_item>, and probably should override
+Your C<Jifty::DBI::Collection> subclass must override C<new_item>, 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
@@ -558,7 +556,7 @@
=head2 new_item
-new_item must be subclassed. It is used by Jifty::DBI to create record
+new_item must be subclassed. It is used by Jifty::DBI::Collection to create record
objects for each row returned from the database.
=cut
@@ -567,14 +565,14 @@
my $self = shift;
die
-"Jifty::DBI needs to be subclassed. you can't use it directly.\n";
+"Jifty::DBI::Collection needs to be subclassed. you can't use it directly.\n";
}
=head2 redo_search
-Takes no arguments. Tells Jifty::DBI that the next time it's asked
+Takes no arguments. Tells Jifty::DBI::Collection that the next time it's asked
for a record, it should requery the database
=cut
@@ -1172,7 +1170,7 @@
=head2 Join
-Join instructs Jifty::DBI to join two tables.
+Join instructs Jifty::DBI::Collection 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->new_alias or
@@ -1580,7 +1578,7 @@
=head1 TESTING
-In order to test most of the features of C<Jifty::DBI>, you need
+In order to test most of the features of C<Jifty::DBI::Collection>, 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,
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 16:12:59 2005
@@ -22,7 +22,7 @@
use Jifty::DBI::Handle;
my $handle = Jifty::DBI::Handle->new();
- $handle->Connect( Driver => 'mysql',
+ $handle->connect( Driver => 'mysql',
Database => 'dbname',
Host => 'hostname',
User => 'dbuser',
@@ -59,12 +59,6 @@
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,
@@ -73,47 +67,42 @@
=cut
sub connect {
- my $self = shift;
+ 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->_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
- $self->{'DisconnectHandleOnDestroy'} = $args{'DisconnectHandleOnDestroy'};
-
-
- $self->build_dsn(%args);
+ $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" ;
+ 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';
+ #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);
+ #Set the handle
+ $self->dbh($handle);
- return (1);
+ return (1);
}
return(undef);
@@ -155,34 +144,34 @@
=cut
sub build_dsn {
- my $self = shift;
- my %args = ( Driver => undef,
- Database => undef,
- Host => undef,
- Port => undef,
- SID => undef,
- RequireSSL => undef,
+ 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'});
+ 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
+=head2 DSN
- Returns the DSN for this database connection.
+Returns the DSN for this database connection.
=cut
-sub dsn {
+sub DSN {
my $self = shift;
return($self->{'dsn'});
}
@@ -236,10 +225,9 @@
sub log_sql_statements {
my $self = shift;
if (@_) {
-
require Time::HiRes;
- $self->{'_DoLogSQL'} = shift;
- return ($self->{'_DoLogSQL'});
+ $self->{'_dologsql'} = shift;
+ return ($self->{'_dologsql'});
}
}
@@ -327,9 +315,6 @@
=cut
-# allow use of Handle as a synonym for DBH
-*Handle=\&dbh;
-
sub dbh {
my $self=shift;
@@ -360,8 +345,8 @@
}
my $QueryString =
- "INSERT INTO $table (". join(", ", @cols). ") VALUES ".
- "(". join(", ", @vals). ")";
+ "INSERT INTO $table (". CORE::join(", ", @cols). ") VALUES ".
+ "(". CORE::join(", ", @vals). ")";
my $sth = $self->simple_query($QueryString, @bind);
return ($sth);
@@ -382,30 +367,30 @@
sub update_record_value {
my $self = shift;
- my %args = ( Table => undef,
- Column => undef,
- IsSQLFunction => undef,
- PrimaryKeys => 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'} . '=';
+ 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'} . ' ';
+ if ($args{'is_sql_function'}) {
+ $query .= $args{'value'} . ' ';
}
else {
$query .= '? ';
- push (@bind, $args{'Value'});
+ push (@bind, $args{'value'});
}
## Constructs the where clause.
my $where = 'WHERE ';
- foreach my $key (keys %{$args{'PrimaryKeys'}}) {
+ foreach my $key (keys %{$args{'primary_keys'}}) {
$where .= $key . "=?" . " AND ";
- push (@bind, $args{'PrimaryKeys'}{$key});
+ push (@bind, $args{'primary_keys'}{$key});
}
$where =~ s/AND\s$//;
@@ -428,11 +413,11 @@
## This is just a wrapper to update_record_value().
my %args = ();
- $args{'Table'} = shift;
- $args{'Column'} = shift;
- $args{'Value'} = shift;
- $args{'PrimaryKeys'} = shift;
- $args{'IsSQLFunction'} = shift;
+ $args{'table'} = shift;
+ $args{'column'} = shift;
+ $args{'value'} = shift;
+ $args{'primary_keys'} = shift;
+ $args{'is_sql_function'} = shift;
return $self->update_record_value(%args)
}
@@ -560,28 +545,28 @@
-=head2 KnowsBLOBs
+=head2 knows_blobs
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 {
+sub knows_blobs {
my $self = shift;
return(1);
}
-=head2 BLOBParams FIELD_NAME FIELD_TYPE
+=head2 blob_params 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 {
+sub blob_params {
my $self = shift;
# Don't assign to key 'value' as it is defined later.
return ( {} );
@@ -947,7 +932,7 @@
}
}
- my $join_clause = $sb->Table . " main ";
+ my $join_clause = $sb->table . " main ";
my @keys = ( keys %{ $sb->{'left_joins'} } );
@@ -959,7 +944,7 @@
$join_clause .=
$sb->{'left_joins'}{$join}{'alias_string'} . " ON (";
$join_clause .=
- join ( ') AND( ',
+ CORE::join ( ') AND( ',
values %{ $sb->{'left_joins'}{$join}{'criteria'} } );
$join_clause .= ")) ";
@@ -972,7 +957,7 @@
}
}
- return ( join ( ", ", ( $join_clause, @{ $sb->{'aliases'} } ) ) );
+ return ( CORE::join ( ", ", ( $join_clause, @{ $sb->{'aliases'} } ) ) );
}
@@ -1041,7 +1026,7 @@
sub DESTROY {
my $self = shift;
- $self->Disconnect if $self->{'DisconnectHandleOnDestroy'};
+ $self->disconnect;
delete $DBIHandle{$self};
}
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 16:12:59 2005
@@ -24,7 +24,7 @@
=cut
-=head2 Insert
+=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,10 +33,10 @@
=cut
-sub Insert {
+sub insert {
my $self = shift;
- my $sth = $self->SUPER::Insert(@_);
+ my $sth = $self->SUPER::insert(@_);
if (!$sth) {
print "no sth! (".$self->dbh->{ix_sqlerrd}[1].")\n";
return ($sth);
@@ -49,25 +49,25 @@
}
-=head2 CaseSensitive
+=head2 case_sensitive
Returns 1, since Informix's searches are case sensitive by default
=cut
-sub CaseSensitive {
+sub case_sensitive {
my $self = shift;
return(1);
}
-=head2 BuildDSN
+=head2 build_dsn
Builder for Informix DSNs.
=cut
-sub BuildDSN {
+sub build_dsn {
my $self = shift;
my %args = ( Driver => undef,
Database => undef,
@@ -85,14 +85,14 @@
}
-=head2 ApplyLimits STATEMENTREF ROWS_PER_PAGE FIRST_ROW
+=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;
=cut
-sub ApplyLimits {
+sub apply_limits {
my $self = shift;
my $statementref = shift;
my $per_page = shift;
@@ -105,7 +105,7 @@
}
-sub Disconnect {
+sub disconnect {
my $self = shift;
if ($self->dbh) {
my $status = $self->dbh->disconnect();
@@ -124,7 +124,7 @@
=cut
-sub DistinctQuery {
+sub distinct_query {
my $self = shift;
my $statementref = shift;
my $table = shift;
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 16:12:59 2005
@@ -29,7 +29,7 @@
=cut
-sub CaseSensitive {
+sub case_sensitive {
my $self = shift;
return (undef);
}
@@ -38,7 +38,7 @@
=cut
-sub BuildDSN {
+sub build_dsn {
my $self = shift;
my %args = (
Driver => undef,
@@ -59,7 +59,7 @@
=cut
-sub ApplyLimits {
+sub apply_limits {
my $self = shift;
my $statementref = shift;
my $per_page = shift or return;
@@ -74,14 +74,14 @@
=cut
-sub DistinctQuery {
+sub distinct_query {
my $self = shift;
my $statementref = shift;
$$statementref = "SELECT main.* FROM $$statementref";
}
-sub Encoding {
+sub encoding {
}
1;
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 16:12:59 2005
@@ -62,7 +62,7 @@
return(1);
}
-sub BinarySafeBLOBs {
+sub binary_safe_blobs {
return undef;
}
@@ -112,7 +112,7 @@
}
}
- my $join_clause = $sb->Table . " main ";
+ my $join_clause = $sb->table . " main ";
my @keys = ( keys %{ $sb->{'left_joins'} } );
my %seen;
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 16:12:59 2005
@@ -24,7 +24,7 @@
=cut
-=head2 Insert
+=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.
@@ -34,19 +34,19 @@
=cut
-sub Insert {
+sub insert {
my $self = shift;
my $table = shift;
my %pairs = @_;
- my $sth = $self->SUPER::Insert( $table, %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');
+ my @row = $self->fetch_result('SELECT @@identity');
# TODO: Propagate Class::ReturnValue up here.
unless ( $row[0] ) {
@@ -61,28 +61,28 @@
-=head2 DatabaseVersion
+=head2 database_version
return the database version, trimming off any -foo identifier
=cut
-sub DatabaseVersion {
+sub database_version {
my $self = shift;
- my $v = $self->SUPER::DatabaseVersion();
+ my $v = $self->SUPER::database_version();
$v =~ s/\-(.*)$//;
return ($v);
}
-=head2 CaseSensitive
+=head2 case_sensitive
Returns undef, since Sybase's searches are not case sensitive by default
=cut
-sub CaseSensitive {
+sub case_sensitive {
my $self = shift;
return(1);
}
@@ -90,7 +90,7 @@
-sub ApplyLimits {
+sub apply_limits {
my $self = shift;
my $statementref = shift;
my $per_page = shift;
@@ -99,12 +99,12 @@
}
-=head2 DistinctQuery STATEMENTREFtakes an incomplete SQL SELECT statement and massages it to return a DISTINCT result set.
+=head2 distinct_query STATEMENTREFtakes an incomplete SQL SELECT statement and massages it to return a DISTINCT result set.
=cut
-sub DistinctQuery {
+sub distinct_query {
my $self = shift;
my $statementref = shift;
my $table = shift;
@@ -116,14 +116,14 @@
}
-=head2 BinarySafeBLOBs
+=head2 binary_safe_blobs
Return undef, as Oracle doesn't support binary-safe CLOBS
=cut
-sub BinarySafeBLOBs {
+sub binary_safe_blobs {
my $self = shift;
return(undef);
}
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 16:12:59 2005
@@ -23,12 +23,12 @@
my $DBIxHandle =
shift; # A Jifty::DBI::Handle::foo object for your database
- $self->_Handle($DBIxHandle);
- $self->Table("Users");
+ $self->_handle($DBIxHandle);
+ $self->table("Users");
}
# Tell Record what the primary keys are
- sub _PrimaryKeys {
+ sub _primary_keys {
return ['id'];
}
@@ -38,7 +38,7 @@
# 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 {
+ sub _class_accessible {
{
Tofu => { 'read' => 1, 'write' => 1 },
Maz => { 'auto' => 1, },
@@ -52,10 +52,10 @@
my $self = shift;
my $try = shift;
- # note two __s in __Value. Subclasses may muck with _Value, but
- # they should never touch __Value
+ # note two __s in __value. Subclasses may muck with _value, but
+ # they should never touch __value
- if ( $try eq $self->__Value('Password') ) {
+ if ( $try eq $self->__value('Password') ) {
return (1);
}
else {
@@ -118,7 +118,7 @@
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
+The two methods in question are '_Init' and '_class_accessible', 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.
@@ -130,7 +130,7 @@
Defines what table we are talking about, and set a variable to store
the database handle.
-=item '_ClassAccessible
+=item '_class_accessible
Defines what operations may be performed on various data selected
from the database. For example you can define fields to be mutable,
@@ -191,8 +191,8 @@
005: my $this = shift;
006: my $handle = shift;
007:
- 008: $this->_Handle($handle);
- 009: $this->Table("Simple");
+ 008: $this->_handle($handle);
+ 009: $this->table("Simple");
010:
011: return ($this);
012: }
@@ -203,7 +203,7 @@
is not bound to a single object but rather, its shared across objects.
013:
- 014: sub _ClassAccessible {
+ 014: sub _class_accessible {
015: {
016: Foo => { 'read' => 1 },
017: Bar => { 'read' => 1, 'write' => 1 },
@@ -245,24 +245,24 @@
009:
010: my $s = Simple->new($handle);
011:
- 012: $s->LoadById(1);
+ 012: $s->load_by_id(1);
-LoadById is one of four 'LoadBy' methods, as the name suggests it searches
+load_by_id 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
+reasonably it also assumes that the id field is unique. load_by_id($id) will
do undefined things if there is >1 row with the same id.
-In addition to LoadById, we also have:
+In addition to load_by_id, we also have:
=over 4
-=item LoadByCol
+=item load_by_col
Takes two arguments, a column name and a value. Again, it will do
undefined things if you use non-unique things.
-=item LoadByCols
+=item load_by_cols
Takes a hash of columns=>values and returns the *first* to match.
First is probably lossy across databases vendors.
@@ -326,7 +326,7 @@
028:
029: $s1 = undef;
030: $s1 = Simple->new($handle);
- 031: $s1->LoadById(4);
+ 031: $s1->load_by_id(4);
032: $s1->Delete();
And its gone.
@@ -338,7 +338,7 @@
=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>.
+For example, the method C<_primary_keys> has the alias C<_primary_keys>.
=head1 METHODS
@@ -359,17 +359,17 @@
my $class = ref($proto) || $proto;
my $self = {};
bless ($self, $class);
- $self->_Init(@_);
+ $self->_init(@_);
return $self;
}
# Not yet documented here. Should almost certainly be overloaded.
-sub _Init {
+sub _init {
my $self = shift;
my $handle = shift;
- $self->_Handle($handle);
+ $self->_handle($handle);
}
@@ -379,12 +379,8 @@
=cut
-
-
-*id = \&Id;
-
-sub Id {
- my $pkey = $_[0]->_PrimaryKey();
+sub id {
+ my $pkey = $_[0]->_primary_key();
my $ret = $_[0]->{'values'}->{$pkey};
return $ret;
}
@@ -392,18 +388,13 @@
=head2 primary_keys
-=head2 PrimaryKeys
-
Return a hash of the values of our primary keys for this function.
=cut
-
-
-
-sub PrimaryKeys {
+sub primary_keys {
my $self = shift;
- my %hash = map { $_ => $self->{'values'}->{$_} } @{$self->_PrimaryKeys};
+ my %hash = map { $_ => $self->{'values'}->{$_} } @{$self->_primary_keys};
return (%hash);
}
@@ -421,37 +412,37 @@
no strict 'refs';
my ($Attrib) = ( $AUTOLOAD =~ /::(\w+)$/o );
- if ( $self->_Accessible( $Attrib, 'read' ) ) {
- *{$AUTOLOAD} = sub { return ( $_[0]->_Value($Attrib) ) };
+ 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) ) };
+ 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]->_CollectionValue( $Attrib ) };
+ elsif ( $self->_accessible( $Attrib, 'foreign-collection') ) {
+ *{$AUTOLOAD} = sub { $_[0]->_collection_value( $Attrib ) };
goto &$AUTOLOAD;
}
- elsif ( $AUTOLOAD =~ /.*::[sS]et_?(\w+)/o ) {
+ elsif ( $AUTOLOAD =~ /.*::set_(\w+)/o ) {
$Attrib = $1;
- if ( $self->_Accessible( $Attrib, 'write' ) ) {
+ if ( $self->_accessible( $Attrib, 'write' ) ) {
*{$AUTOLOAD} = sub {
- return ( $_[0]->_Set( Field => $Attrib, Value => $_[1] ) );
+ 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;
$val = $val->id if UNIVERSAL::isa($val, 'Jifty::DBI::Record');
- return ( $self->_Set( Field => $Attrib, Value => $val ) );
+ return ( $self->_set( field => $Attrib, value => $val ) );
};
goto &$AUTOLOAD;
}
- elsif ( $self->_Accessible( $Attrib, 'read' ) ) {
+ elsif ( $self->_accessible( $Attrib, 'read' ) ) {
*{$AUTOLOAD} = sub { return ( 0, 'Immutable field' ) };
goto &$AUTOLOAD;
}
@@ -459,13 +450,13 @@
return ( 0, 'Nonexistant field?' );
}
}
- elsif ( $AUTOLOAD =~ /.*::(\w+?)_?[oO]bj$/o ) {
+ elsif ( $AUTOLOAD =~ /.*::(\w+?)_obj$/o ) {
$Attrib = $1;
- if ( $self->_Accessible( $Attrib, 'object' ) ) {
+ if ( $self->_accessible( $Attrib, 'object' ) ) {
*{$AUTOLOAD} = sub {
- return (shift)->_Object(
- Field => $Attrib,
- Args => [@_],
+ return (shift)->_object(
+ field => $Attrib,
+ args => [@_],
);
};
goto &$AUTOLOAD;
@@ -479,10 +470,10 @@
#right idea. it breaks the ability to do ValidateQueue for a ticket
#on creation.
- elsif ( $AUTOLOAD =~ /.*::[vV]alidate_?(\w+)/o ) {
+ elsif ( $AUTOLOAD =~ /.*::validate_(\w+)/o ) {
$Attrib = $1;
- *{$AUTOLOAD} = sub { return ( $_[0]->_Validate( $Attrib, $_[1] ) ) };
+ *{$AUTOLOAD} = sub { return ( $_[0]->_validate( $Attrib, $_[1] ) ) };
goto &$AUTOLOAD;
}
@@ -500,7 +491,7 @@
-=head2 _Accessible KEY MODE
+=head2 _accessible KEY MODE
Private method.
@@ -509,49 +500,49 @@
=cut
-sub _Accessible {
+sub _accessible {
my $self = shift;
my $attr = shift;
my $mode = lc(shift || '');
- my $attribute = $self->_ClassAccessible(@_)->{$attr};
+ my $attribute = $self->_class_accessible(@_)->{$attr};
return unless defined $attribute;
return $attribute->{$mode};
}
-=head2 _PrimaryKeys
+=head2 _primary_keys
Return our primary keys. (Subclasses should override this, but our default is that we have one primary key, named 'id'.)
=cut
-sub _PrimaryKeys {
+sub _primary_keys {
my $self = shift;
return ['id'];
}
-sub _PrimaryKey {
+sub _primary_key {
my $self = shift;
- my $pkeys = $self->_PrimaryKeys();
+ 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 _ClassAccessible
+=head2 _class_accessible
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>.)
+(The current preferred method is by overriding C<schema>; if you do
+this and don't override C<_class_accessible>, the module will generate
+an appropriate C<_class_accessible> based on your C<schema>.)
Here's an example declaration:
- sub _ClassAccessible {
+ sub _class_accessible {
{
Tofu => { 'read'=>1, 'write'=>1 },
Maz => { 'auto'=>1, },
@@ -562,58 +553,58 @@
=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
+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
-
- my %accessible;
- while ( my $col = shift ) {
- $accessible{$col}->{lc($_)} = 1
- foreach split(/[\/,]/, shift);
- }
- return(\%accessible);
+
+ my %accessible;
+ while ( my $col = shift ) {
+ $accessible{$col}->{lc($_)} = 1
+ foreach split(/[\/,]/, shift);
+ }
+ return(\%accessible);
}
-sub _ClassAccessibleFromSchema {
- my $self = shift;
+sub _class_accessible_from_schema {
+ my $self = shift;
- my $accessible = {};
- foreach my $key ($self->_PrimaryKeys) {
- $accessible->{$key} = { 'read' => 1 };
- };
+ my $accessible = {};
+ foreach my $key ($self->_primary_keys) {
+ $accessible->{$key} = { 'read' => 1 };
+ };
- my $schema = $self->Schema;
+ 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";
+ 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;
+ return $accessible;
}
-sub _ToRecord {
+sub _to_record {
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;
@@ -625,18 +616,19 @@
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 );
+ my $object = $classname->new( $self->_handle );
+ $object->load_by_id( $value );
return $object;
}
-sub _CollectionValue {
+
+sub _collection_value {
my $self = 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;
@@ -644,39 +636,42 @@
return unless UNIVERSAL::isa($classname, 'Jifty::DBI::Collection');
- my $coll = $classname->new( Handle => $self->_Handle );
+ my $coll = $classname->new( handle => $self->_handle );
$coll->Limit( FIELD => $description->{'KEY'}, VALUE => $self->id);
return $coll;
}
-# sub {{{ ReadableAttributes
-=head2 ReadableAttributes
+# sub {{{ readable_attributes
-Returns an array of the attributes of this class defined as "read" => 1 in this class' _ClassAccessible datastructure
+=head2 readable_attributes
+
+Returns an array of the attributes of this class defined as "read" =>
+1 in this class' _class_accessible datastructure
=cut
-sub ReadableAttributes {
+sub readable_attributes {
my $self = shift;
- my $ca = $self->_ClassAccessible();
+ my $ca = $self->_class_accessible();
my @readable = grep { $ca->{$_}->{'read'} or $ca->{$_}->{'record-read'} } keys %{$ca};
return (@readable);
}
-=head2 WritableAttributes
+=head2 writable_attributes
-Returns an array of the attributes of this class defined as "write" => 1 in this class' _ClassAccessible datastructure
+Returns an array of the attributes of this class defined as "write" =>
+1 in this class' _class_accessible datastructure
=cut
-sub WritableAttributes {
+sub writable_attributes {
my $self = shift;
- my $ca = $self->_ClassAccessible();
+ my $ca = $self->_class_accessible();
my @writable = grep { $ca->{$_}->{'write'} || $ca->{$_}->{'record-write'} } keys %{$ca};
return @writable;
}
@@ -684,82 +679,83 @@
-=head2 __Value
+=head2 __value
-Takes a field name and returns that field's value. Subclasses should never
-override __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;
+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 $@;
+ if (!$self->{'fetched'}{$field} and my $id = $self->id() ) {
+ my $pkey = $self->_primary_key();
+ 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->{'fetched'}{$field} = 1;
- }
+ $self->{'values'}{$field} = $value;
+ $self->{'fetched'}{$field} = 1;
+ }
- my $value = $self->{'values'}{$field};
-
- return $value;
+ my $value = $self->{'values'}{$field};
+
+ return $value;
}
-=head2 _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.
+_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 {
+sub _value {
my $self = shift;
- return ($self->__Value(@_));
+ return ($self->__value(@_));
}
-=head2 _Set
+=head2 _set
-_Set takes a single column name and a single unquoted value.
+_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.
+Subclasses can override _set to insert custom access control.
=cut
-sub _Set {
+sub _set {
my $self = shift;
- return ($self->__Set(@_));
+ return ($self->__set(@_));
}
-sub __Set {
+sub __set {
my $self = shift;
my %args = (
- 'Field' => undef,
- 'Value' => undef,
- 'IsSQL' => undef,
+ 'field' => undef,
+ 'value' => undef,
+ 'is_sql' => undef,
@_
);
- $args{'Column'} = delete $args{'Field'};
- $args{'IsSQLFunction'} = delete $args{'IsSQL'};
+ $args{'column'} = delete $args{'field'};
+ $args{'is_sql_function'} = delete $args{'is_sql'};
my $ret = Class::ReturnValue->new();
- unless ( $args{'Column'} ) {
+ unless ( $args{'column'} ) {
$ret->as_array( 0, 'No column specified' );
$ret->as_error(
errno => 5,
@@ -768,18 +764,18 @@
);
return ( $ret->return_value );
}
- my $column = lc $args{'Column'};
- if ( !defined( $args{'Value'} ) ) {
- $ret->as_array( 0, "No value passed to _Set" );
+ 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"
+ message => "No value passed to _set"
);
return ( $ret->return_value );
}
- elsif ( ( defined $self->__Value($column) )
- and ( $args{'Value'} eq $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" );
$ret->as_error(
@@ -796,43 +792,43 @@
#
- $args{'Value'} = $self->TruncateValue ( $args{'Column'}, $args{'Value'});
+ $args{'value'} = $self->truncate_value ( $args{'column'}, $args{'value'});
- my $method = "Validate" . $args{'Column'};
- unless ( $self->$method( $args{'Value'} ) ) {
- $ret->as_array( 0, 'Illegal value for ' . $args{'Column'} );
+ 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'}
+ message => "Illegal value for " . $args{'column'}
);
return ( $ret->return_value );
}
- $args{'Table'} = $self->Table();
- $args{'PrimaryKeys'} = { $self->PrimaryKeys() };
+ $args{'table'} = $self->table();
+ $args{'primary_keys'} = { $self->primary_keys() };
# 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'};
+ my $unmunged_value = $args{'value'};
- unless ( $self->_Handle->KnowsBLOBs ) {
+ unless ( $self->_handle->knows_blobs ) {
# Support for databases which don't deal with LOBs automatically
- my $ca = $self->_ClassAccessible();
- my $key = $args{'Column'};
+ my $ca = $self->_class_accessible();
+ 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 $bhash = $self->_handle->blob_params( $key, $ca->{$key}->{'type'} );
+ $bhash->{'value'} = $args{'value'};
+ $args{'value'} = $bhash;
}
}
- my $val = $self->_Handle->UpdateRecordValue(%args);
+ my $val = $self->_handle->update_record_value(%args);
unless ($val) {
my $message =
- $args{'Column'} . " could not be set to " . $args{'Value'} . "." ;
+ $args{'column'} . " could not be set to " . $args{'value'} . "." ;
$ret->as_array( 0, $message);
$ret->as_error(
errno => 4,
@@ -844,7 +840,7 @@
# 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'} ) {
+ if ( $args{'is_sql_function'} ) {
$self->Load( $self->Id );
}
else {
@@ -854,7 +850,7 @@
return ( $ret->return_value );
}
-=head2 _Canonicalize PARAMHASH
+=head2 _canonicalize PARAMHASH
This routine massages an input value (VALUE) for FIELD into something that's
going to be acceptable.
@@ -888,7 +884,7 @@
=cut
-sub _Canonicalize {
+sub _canonicalize {
my $self = shift;
my $field = shift;
@@ -910,7 +906,7 @@
-sub _Validate {
+sub _validate {
my $self = shift;
my $field = shift;
my $value = shift;
@@ -928,7 +924,7 @@
-=head2 TruncateValue KEY VALUE
+=head2 truncate_value 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.
@@ -937,7 +933,7 @@
=cut
-sub TruncateValue {
+sub truncate_value {
my $self = shift;
my $key = shift;
my $value = shift;
@@ -945,7 +941,7 @@
# We don't need to truncate empty things.
return undef unless (defined ($value));
- my $metadata = $self->_ClassAccessible->{$key};
+ my $metadata = $self->_class_accessible->{$key};
my $truncate_to;
if ( $metadata->{'length'} && !$metadata->{'is_numeric'} ) {
@@ -981,33 +977,32 @@
}
-=head2 _Object
+=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.
+_object takes a single column name and an array reference. It creates
+new object instance of class specified in _class_accessable structure
+and calls load_by_id 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,
+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 {
+sub _object {
my $self = shift;
- return $self->__Object(@_);
+ return $self->__object(@_);
}
-sub __Object {
+sub __object {
my $self = shift;
- my %args = ( Field => '', Args => [], @_ );
+ my %args = ( field => '', args => [], @_ );
- my $field = $args{'Field'};
- my $class = $self->_Accessible( $field, 'object' );
+ 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
@@ -1021,8 +1016,8 @@
}
}
- my $object = $class->new( @{ $args{'Args'} } );
- $object->LoadById( $self->__Value($field) );
+ my $object = $class->new( @{ $args{'args'} } );
+ $object->load_by_id( $self->__value($field) );
return $object;
}
@@ -1035,23 +1030,21 @@
# 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
+=head2 load
-Takes a single argument, $id. Calls LoadById to retrieve the row whose primary key
+Takes a single argument, $id. Calls load_by_id to retrieve the row whose primary key
is $id
=cut
-
-
-sub Load {
+sub load {
my $self = shift;
# my ($package, $filename, $line) = caller;
- return $self->LoadById(@_);
+ return $self->load_by_id(@_);
}
-=head2 LoadByCol
+=head2 load_by_col
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
@@ -1061,17 +1054,17 @@
-sub LoadByCol {
+sub load_by_col {
my $self = shift;
my $col = shift;
my $val = shift;
- return($self->LoadByCols($col => $val));
+ return($self->load_by_cols($col => $val));
}
-=head2 LoadByCols
+=head2 loadbycols
Takes a hash of columns and values. Loads the first record that matches all
keys.
@@ -1083,8 +1076,7 @@
=cut
-
-sub LoadByCols {
+sub load_by_cols {
my $self = shift;
my %hash = (@_);
my (@bind, @phrases);
@@ -1107,7 +1099,7 @@
}
else {
push @phrases, "($key IS NULL OR $key = ?)";
- my $meta = $self->_ClassAccessible->{$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 ) {
@@ -1119,66 +1111,62 @@
}
}
- my $QueryString = "SELECT * FROM ".$self->Table." WHERE ".
+ my $QueryString = "SELECT * FROM ".$self->table." WHERE ".
join(' AND ', @phrases) ;
- return ($self->_LoadFromSQL($QueryString, @bind));
+ return ($self->_load_from_sql($QueryString, @bind));
}
-=head2 LoadById
+=head2 loadbyid
Loads a record by its primary key. Your record class must define a single primary key column.
=cut
-sub LoadById {
+sub load_by_id {
my $self = shift;
my $id = shift;
$id = 0 if (!defined($id));
- my $pkey = $self->_PrimaryKey();
- return ($self->LoadByCols($pkey => $id));
+ my $pkey = $self->_primary_key();
+ return ($self->load_by_cols($pkey => $id));
}
-=head2 LoadByPrimaryKeys
+=head2 load_by_primary_keys
-Like LoadById with basic support for compound primary keys.
+Like load_by_id with basic support for compound primary keys.
=cut
-
-
-sub LoadByPrimaryKeys {
+sub load_by_primary_keys {
my $self = shift;
my $data = (ref $_[0] eq 'HASH')? $_[0]: {@_};
my %cols=();
- foreach (@{$self->_PrimaryKeys}) {
+ foreach (@{$self->_primary_keys}) {
return (0, "Missing PK field: '$_'") unless defined $data->{$_};
$cols{$_}=$data->{$_};
}
- return ($self->LoadByCols(%cols));
+ return ($self->load_by_cols(%cols));
}
-=head2 LoadFromHash
+=head2 load_from_hash
Takes a hashref, such as created by Jifty::DBI and populates this record's
loaded values hash.
=cut
-
-
-sub LoadFromHash {
+sub load_from_hash {
my $self = shift;
my $hashref = shift;
@@ -1192,7 +1180,7 @@
-=head2 _LoadFromSQL QUERYSTRING @BIND_VALUES
+=head2 _load_from_sql QUERYSTRING @BIND_VALUES
Load a record as the result of an SQL statement
@@ -1201,12 +1189,12 @@
-sub _LoadFromSQL {
+sub _load_from_sql {
my $self = shift;
my $QueryString = shift;
my @bind_values = (@_);
- my $sth = $self->_Handle->SimpleQuery( $QueryString, @bind_values );
+ my $sth = $self->_handle->simple_query( $QueryString, @bind_values );
#TODO this only gets the first row. we should check if there are more.
@@ -1225,7 +1213,7 @@
## I guess to be consistant with the old code, make sure the primary
## keys exist.
- if( grep { not defined } $self->PrimaryKeys ) {
+ if( grep { not defined } $self->primary_keys ) {
return ( 0, "Missing a primary key?" );
}
@@ -1240,62 +1228,59 @@
-=head2 Create
+=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 {
+sub create {
my $self = shift;
my %attribs = @_;
my ($key);
foreach $key ( keys %attribs ) {
- if ( $self->_Accessible( $key, 'record-write' ) ) {
+ 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} );
+ $attribs{$key} = $self->truncate_value( $key => $attribs{$key} );
}
- unless ( $self->_Handle->KnowsBLOBs ) {
+ unless ( $self->_handle->knows_blobs ) {
# Support for databases which don't deal with LOBs automatically
- my $ca = $self->_ClassAccessible();
+ my $ca = $self->_class_accessible();
foreach $key ( keys %attribs ) {
if ( $ca->{$key}->{'type'} =~ /^(text|longtext|clob|blob|lob)$/i ) {
my $bhash =
- $self->_Handle->BLOBParams( $key, $ca->{$key}->{'type'} );
+ $self->_handle->blob_params( $key, $ca->{$key}->{'type'} );
$bhash->{'value'} = $attribs{$key};
$attribs{$key} = $bhash;
}
}
}
- return ( $self->_Handle->Insert( $self->Table, %attribs ) );
+ return ( $self->_handle->insert( $self->table, %attribs ) );
}
-=head2 Delete
+=head2 delete
-Delete this record from the database. On failure return a Class::ReturnValue with the error. On success, return 1;
+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 {
+ $_[0]->__delete;
}
-sub __Delete {
+sub __delete {
my $self = shift;
#TODO Check to make sure the key's not already listed.
@@ -1303,7 +1288,7 @@
## Constructs the where clause.
my @bind=();
- my %pkeys=$self->PrimaryKeys();
+ my %pkeys=$self->primary_keys();
my $where = 'WHERE ';
foreach my $key (keys %pkeys) {
$where .= $key . "=?" . " AND ";
@@ -1311,8 +1296,8 @@
}
$where =~ s/AND\s$//;
- my $QueryString = "DELETE FROM ". $self->Table . ' ' . $where;
- my $return = $self->_Handle->SimpleQuery($QueryString, @bind);
+ my $QueryString = "DELETE FROM ". $self->table . ' ' . $where;
+ my $return = $self->_handle->simple_query($QueryString, @bind);
if (UNIVERSAL::isa('Class::ReturnValue', $return)) {
return ($return);
@@ -1325,15 +1310,13 @@
-=head2 Table
+=head2 table
-Returns or sets the name of the current Table
+Returns or sets the name of the current table
=cut
-
-
-sub Table {
+sub table {
my $self = shift;
if (@_) {
$self->{'table'} = shift;
@@ -1343,24 +1326,19 @@
-=head2 _Handle
+=head2 _handle
Returns or sets the current Jifty::DBI::Handle object
=cut
-sub _Handle {
+sub _handle {
my $self = shift;
if (@_) {
- $self->{'DBIxHandle'} = shift;
+ $self->{'DBIxHandle'} = shift;
}
return ($self->{'DBIxHandle'});
- }
-
-
-if( eval { require capitalization } ) {
- capitalization->unimport( __PACKAGE__ );
}
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 16:12:59 2005
@@ -46,50 +46,49 @@
return ($self);
}
-sub _SetupCache {
+sub _setup_cache {
my $self = shift;
my $cache = shift;
$_CACHES{$cache} = Cache::Simple::TimedExpiry->new();
- $_CACHES{$cache}->expire_after( $self->_CacheConfig->{'cache_for_sec'} );
+ $_CACHES{$cache}->expire_after( $self->_cache_config->{'cache_for_sec'} );
}
-=head2 FlushCache
+=head2 flush_cache
This class method flushes the _global_ Jifty::DBI::Record::Cachable
cache. All caches are immediately expired.
=cut
-sub FlushCache {
+sub flush_cache {
%_CACHES = ();
}
-sub _KeyCache {
+sub _key_cache {
my $self = shift;
- my $cache = $self->_Handle->DSN . "-KEYS--" . ($self->{'_Class'} ||= ref($self));
- $self->_SetupCache($cache) unless exists ($_CACHES{$cache});
+ my $cache = $self->_handle->DSN . "-KEYS--" . ($self->{'_Class'} ||= ref($self));
+ $self->_setup_cache($cache) unless exists ($_CACHES{$cache});
return ($_CACHES{$cache});
}
-=head2 _FlushKeyCache
+=head2 _flush_key_cache
Blow away this record type's key cache
=cut
-
-sub _FlushKeyCache {
+sub _flush_key_cache {
my $self = shift;
- my $cache = $self->_Handle->DSN . "-KEYS--" . ($self->{'_Class'} ||= ref($self));
- $self->_SetupCache($cache);
+ my $cache = $self->_handle->DSN . "-KEYS--" . ($self->{'_Class'} ||= ref($self));
+ $self->_setup_cache($cache);
}
-sub _RecordCache {
+sub _record_cache {
my $self = shift;
- my $cache = $self->_Handle->DSN . "--" . ($self->{'_Class'} ||= ref($self));
- $self->_SetupCache($cache) unless exists ($_CACHES{$cache});
+ my $cache = $self->_handle->DSN . "--" . ($self->{'_Class'} ||= ref($self));
+ $self->_setup_cache($cache) unless exists ($_CACHES{$cache});
return ($_CACHES{$cache});
}
@@ -99,12 +98,12 @@
# Args : See Jifty::DBI::Record::LoadFromHash
# Lvalue : array(boolean, message)
-sub LoadFromHash {
+sub load_from_hash {
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 ( $rvalue, $msg ) = $self->SUPER::load_from_hash(@_);
my $cache_key = $self->_primary_RecordCache_key();
@@ -121,7 +120,7 @@
# Args : see Jifty::DBI::Record::LoadByCols
# Lvalue : array(boolean, message)
-sub LoadByCols {
+sub load_by_cols {
my ( $self, %attr ) = @_;
## Generate the cache key
@@ -134,12 +133,12 @@
$self->{'_SB_Record_Primary_RecordCache_key'} = undef;
## Fetch from the DB!
- my ( $rvalue, $msg ) = $self->SUPER::LoadByCols(%attr);
+ my ( $rvalue, $msg ) = $self->SUPER::load_by_cols(%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);
+ $self->_key_cache->set( $alt_key, $self->_primary_RecordCache_key);
}
return ( $rvalue, $msg );
@@ -151,11 +150,11 @@
# Args : see Jifty::DBI::Record::_Set
# Lvalue : ?
-sub __Set () {
+sub __set () {
my ( $self, %attr ) = @_;
$self->_expire();
- return $self->SUPER::__Set(%attr);
+ return $self->SUPER::__set(%attr);
}
@@ -164,12 +163,12 @@
# Args : nil
# Lvalue : ?
-sub __Delete () {
+sub __delete () {
my ($self) = @_;
$self->_expire();
- return $self->SUPER::__Delete();
+ return $self->SUPER::__delete();
}
@@ -181,9 +180,9 @@
sub _expire (\$) {
my $self = shift;
- $self->_RecordCache->set( $self->_primary_RecordCache_key , undef, time-1);
+ $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->_FlushKeyCache;
+ $self->_flush_key_cache;
}
@@ -195,7 +194,7 @@
sub _fetch () {
my ( $self, $cache_key ) = @_;
- my $data = $self->_RecordCache->fetch($cache_key) or return;
+ my $data = $self->_record_cache->fetch($cache_key) or return;
@{$self}{keys %$data} = values %$data; # deserialize
return 1;
@@ -206,7 +205,7 @@
sub __Value {
my $self = shift;
my $field = shift;
- return ( $self->SUPER::__Value($field) );
+ return ( $self->SUPER::__value($field) );
}
# Function: _store
@@ -217,7 +216,7 @@
sub _store (\$) {
my $self = shift;
- $self->_RecordCache->set( $self->_primary_RecordCache_key, $self->_serialize);
+ $self->_record_cache->set( $self->_primary_RecordCache_key, $self->_serialize);
return (1);
}
@@ -226,7 +225,7 @@
return (
{
values => $self->{'values'},
- table => $self->Table,
+ table => $self->table,
fetched => $self->{'fetched'}
}
);
@@ -265,7 +264,7 @@
sub _fetch_RecordCache_key {
my ($self) = @_;
- my $cache_key = $self->_CacheConfig->{'cache_key'};
+ my $cache_key = $self->_cache_config->{'cache_key'};
return ($cache_key);
}
@@ -279,14 +278,14 @@
sub _primary_RecordCache_key {
my ($self) = @_;
- return undef unless ( $self->Id );
+ return undef unless ( $self->id );
unless ( $self->{'_SB_Record_Primary_RecordCache_key'} ) {
- my $primary_RecordCache_key = $self->Table() . ':';
+ my $primary_RecordCache_key = $self->table() . ':';
my @attributes;
- foreach my $key ( @{ $self->_PrimaryKeys } ) {
- push @attributes, $key . '=' . $self->SUPER::__Value($key);
+ foreach my $key ( @{ $self->_primary_keys } ) {
+ push @attributes, $key . '=' . $self->SUPER::__value($key);
}
$primary_RecordCache_key .= join( ',', @attributes );
@@ -306,13 +305,13 @@
my $alternate_key = shift;
return undef unless ($alternate_key);
- my $primary_key = $self->_KeyCache->fetch($alternate_key);
+ my $primary_key = $self->_key_cache->fetch($alternate_key);
if ($primary_key) {
return ($primary_key);
}
# If the alternate key is really the primary one
- elsif ( $self->_RecordCache->fetch($alternate_key) ) {
+ elsif ( $self->_record_cache->fetch($alternate_key) ) {
return ($alternate_key);
}
else { # empty!
@@ -333,7 +332,7 @@
=cut
-sub _CacheConfig {
+sub _cache_config {
{
'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 16:12:59 2005
@@ -110,8 +110,8 @@
my $self = shift;
my $model = shift;
- my $table_name = $model->Table;
- my $schema = $model->Schema;
+ my $table_name = $model->table;
+ my $schema = $model->schema;
my $primary = "id"; # TODO allow override
my $primary_col = DBIx::DBSchema::Column->new({
Modified: Jifty-DBI/trunk/t/01records.t
==============================================================================
--- Jifty-DBI/trunk/t/01records.t (original)
+++ Jifty-DBI/trunk/t/01records.t Mon Jul 25 16:12:59 2005
@@ -30,15 +30,15 @@
isa_ok($ret,'DBI::st', "Inserted the schema. got a statement handle back");
my $rec = TestApp::Address->new($handle);
- isa_ok($rec, 'Jifty::DBI::record');
+ isa_ok($rec, 'Jifty::DBI::Record');
# _Accessible testings
is( $rec->_accessible('id' => 'read'), 1, 'id is accessible for read' );
is( $rec->_accessible('id' => 'write'), undef, 'id is not accessible for write' );
is( $rec->_accessible('id'), undef, "any field is not accessible in undefined mode" );
is( $rec->_accessible('unexpected_field' => 'read'), undef, "field doesn't exist and can't be accessible for read" );
- is_deeply( [sort($rec->readable_attributes)], [qw(employee_id name phone id)], 'readable attributes' );
- is_deeply( [sort($rec->writable_attributes)], [qw(employee_id name phone)], 'writable attributes' );
+ is_deeply( [sort($rec->readable_attributes)], [sort qw(employee_id id name phone)], 'readable attributes' );
+ is_deeply( [sort($rec->writable_attributes)], [sort qw(employee_id name phone)], 'writable attributes' );
can_ok($rec,'create');
@@ -65,7 +65,7 @@
{
# test produce DBI warning
local $SIG{__WARN__} = sub {return};
- is( $rec->_Value( 'some_unexpected_field' ), undef, "The record has no 'some_unexpected_field'");
+ is( $rec->_value( 'some_unexpected_field' ), undef, "The record has no 'some_unexpected_field'");
}
($val, $msg) = $rec->set_some_unexpected_field( 'foo' );
ok(!$val, $msg);
@@ -181,7 +181,7 @@
is( $rec->name, 'Obra', "old value is still there");
$val = $rec->set_name( 'invalid' );
isa_ok( $val, 'Class::ReturnValue', "couldn't set invalid value, error returned");
- is( ($val->as_array)[1], 'Illegal value for Name', "correct error message" );
+ is( ($val->as_array)[1], 'Illegal value for name', "correct error message" );
is( $rec->name, 'Obra', "old value is still there");
# XXX TODO FIXME: this test cover current implementation that is broken //RUZ
$val = $rec->set_name( );
@@ -211,7 +211,7 @@
sub _init {
my $self = shift;
my $handle = shift;
- $welf->table('address');
+ $self->table('address');
$self->_handle($handle);
}
Modified: Jifty-DBI/trunk/t/01searches.t
==============================================================================
--- Jifty-DBI/trunk/t/01searches.t (original)
+++ Jifty-DBI/trunk/t/01searches.t Mon Jul 25 16:12:59 2005
@@ -55,7 +55,7 @@
is_deeply( $items_ref, [], 'items_array_ref returns [] on not limited obj' );
# unlimit new object and check
- $users_obj->un_limit;
+ $users_obj->unlimit;
is( $users_obj->count, $count_all, 'count returns same number of records as was inserted' );
isa_ok( $users_obj->first, 'Jifty::DBI::Record', 'first returns record object' );
isa_ok( $users_obj->last, 'Jifty::DBI::Record', 'last returns record object' );
@@ -147,7 +147,7 @@
# ORDER BY / GROUP BY
$users_obj->clean_slate;
is_deeply( $users_obj, $clean_obj, 'after clean_slate looks like new object');
- $users_obj->un_limit;
+ $users_obj->unlimit;
$users_obj->group_by_cols({FIELD => 'login'});
$users_obj->order_by(FIELD => 'login', ORDER => 'desc');
$users_obj->column(FIELD => 'login');
Modified: Jifty-DBI/trunk/t/02records_object.t
==============================================================================
--- Jifty-DBI/trunk/t/02records_object.t (original)
+++ Jifty-DBI/trunk/t/02records_object.t Mon Jul 25 16:12:59 2005
@@ -113,7 +113,7 @@
sub _init {
my $self = shift;
my $handle = shift;
- $self->Table('employees');
+ $self->table('employees');
$self->_handle($handle);
}
Modified: Jifty-DBI/trunk/t/11schema_records.t
==============================================================================
--- Jifty-DBI/trunk/t/11schema_records.t (original)
+++ Jifty-DBI/trunk/t/11schema_records.t Mon Jul 25 16:12:59 2005
@@ -240,7 +240,7 @@
use base qw/Jifty::DBI::Record/;
-sub Table { 'employees' }
+sub table { 'employees' }
sub schema {
return {
@@ -262,7 +262,7 @@
use base qw/Jifty::DBI::Record/;
-sub Table { 'phones' }
+sub table { 'phones' }
sub schema {
return {
Modified: Jifty-DBI/trunk/t/testmodels.pl
==============================================================================
--- Jifty-DBI/trunk/t/testmodels.pl (original)
+++ Jifty-DBI/trunk/t/testmodels.pl Mon Jul 25 16:12:59 2005
@@ -4,7 +4,7 @@
# Class and instance method
-sub Table { "addresses" }
+sub table { "addresses" }
# Class and instance method
More information about the Rt-commit
mailing list