From: Rafael Kitover Date: Sat, 27 Jun 2009 22:20:25 +0000 (+0000) Subject: Merge 'trunk' into 'on_connect_call' X-Git-Tag: v0.08108~48^2~3 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=32e1ae3175995f26e3702b159f5587d752add175;hp=eb0bc670a8a144695c757cddab22920abaede088;p=dbsrgits%2FDBIx-Class.git Merge 'trunk' into 'on_connect_call' r5665@hlagh (orig r6780): ribasushi | 2009-06-24 02:08:02 -0700 Properly name the relinfo variable r5666@hlagh (orig r6781): ribasushi | 2009-06-24 03:12:49 -0700 find_related fix for single-type relationships r5667@hlagh (orig r6782): nigel | 2009-06-24 08:28:33 -0700 r11786@hex: nigel | 2009-06-24 16:27:58 +0100 Fixed set_$rel with where restriction deleting rows outside the restriction r5668@hlagh (orig r6783): nigel | 2009-06-24 08:47:31 -0700 r11788@hex: nigel | 2009-06-24 16:47:04 +0100 Rework of set_$rel patch with less obfuscation r5691@hlagh (orig r6788): ribasushi | 2009-06-25 00:19:10 -0700 Commit test inspired by joel - it seemingly fails on Mac? r5692@hlagh (orig r6789): ribasushi | 2009-06-25 02:04:26 -0700 Minor cleanups r5721@hlagh (orig r6792): teejay | 2009-06-26 05:43:05 -0700 normalised artist_id, and plural relationships to plural names making use of alias/relname less ambiguous than relname/tablename being the same, also added a little more info on joining/relationships r5722@hlagh (orig r6793): tomboh | 2009-06-26 06:25:19 -0700 Documentation fix: - timezone is no longer an extra setting - fix a typo of 'subsequently' r5723@hlagh (orig r6794): gphat | 2009-06-26 07:33:35 -0700 Fix typo in ResultSet docs r5724@hlagh (orig r6802): ribasushi | 2009-06-27 03:39:03 -0700 Todoified (unsolvable) test from RT#42466 r5725@hlagh (orig r6803): ribasushi | 2009-06-27 03:52:26 -0700 POD patch from RT#46808 r5726@hlagh (orig r6804): ribasushi | 2009-06-27 04:59:03 -0700 Adjust sqlt schema parser to add tables in FK dependency order r5727@hlagh (orig r6805): ribasushi | 2009-06-27 05:08:35 -0700 Bump author SQLT dependency for early developer testing Regenerate SQLite schema with new parser/sqlt Use throw_exception in lieu of plain die when possible --- diff --git a/Makefile.PL b/Makefile.PL index 310f12c..2369dd5 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -81,6 +81,9 @@ my %force_requires_if_author = ( 'DateTime::Format::MySQL' => 0, 'DateTime::Format::Pg' => 0, + # t/73oracle_inflate.t + 'DateTime::Format::Oracle' => 0, + # t/96_is_deteministic_value.t 'DateTime::Format::Strptime' => 0, diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 7998423..749c790 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -14,13 +14,15 @@ use List::Util(); __PACKAGE__->mk_group_accessors('simple' => qw/_connect_info _dbi_connect_info _dbh _sql_maker _sql_maker_opts - _conn_pid _conn_tid transaction_depth _dbh_autocommit savepoints/ + _conn_pid _conn_tid transaction_depth _dbh_autocommit _on_connect_do + _on_disconnect_do _on_connect_do_store _on_disconnect_do_store + savepoints/ ); # the values for these accessors are picked out (and deleted) from # the attribute hashref passed to connect_info my @storage_options = qw/ - on_connect_do on_disconnect_do disable_sth_caching unsafe auto_savepoint + on_connect_call on_disconnect_call disable_sth_caching unsafe auto_savepoint /; __PACKAGE__->mk_group_accessors('simple' => @storage_options); @@ -177,6 +179,91 @@ immediately before disconnecting from the database. Note, this only runs if you explicitly call L on the storage object. +=item on_connect_call + +A more generalized form of L that calls the specified +C methods in your storage driver. + + on_connect_do => 'select 1' + +is equivalent to: + + on_connect_call => [ [ do_sql => 'select 1' ] ] + +Its values may contain: + +=over + +=item a scalar + +Will call the C method. + +=item a code reference + +Will execute C<< $code->($storage) >> + +=item an array reference + +Each value can be a method name or code reference. + +=item an array of arrays + +For each array, the first item is taken to be the C method name +or code reference, and the rest are parameters to it. + +=back + +Some predefined storage methods you may use: + +=over + +=item do_sql + +Executes a SQL string or a code reference that returns a SQL string. This is +what L and L use. + +It can take: + +=over + +=item a scalar + +Will execute the scalar as SQL. + +=item an arrayref + +Taken to be arguments to L, the SQL string optionally followed by the +attributes hashref and bind values. + +=item a code reference + +Will execute C<< $code->($storage) >> and execute the return array refs as +above. + +=back + +=item datetime_setup + +Execute any statements necessary to initialize the database session to return +and accept datetime/timestamp values used with +L. + +Only necessary for some databases, see your specific storage driver for +implementation details. + +=back + +=item on_disconnect_call + +Takes arguments in the same form as L and executes them +immediately before disconnecting from the database. + +Calls the C methods as opposed to the +C methods called by L. + +Note, this only runs if you explicitly call L on the +storage object. + =item disable_sth_caching If set to a true value, this option will disable the caching of @@ -347,6 +434,11 @@ sub connect_info { $self->_sql_maker_opts->{$sql_maker_opt} = $opt_val; } } + for my $connect_do_opt (qw/on_connect_do on_disconnect_do/) { + if(my $opt_val = delete $attrs{$connect_do_opt}) { + $self->$connect_do_opt($opt_val); + } + } } %attrs = () if (ref $args[0] eq 'CODE'); # _connect() never looks past $args[0] in this case @@ -359,6 +451,55 @@ sub connect_info { This method is deprecated in favour of setting via L. +=cut + +sub on_connect_do { + my $self = shift; + $self->_setup_connect_do(on_connect_do => @_); +} + +=head2 on_disconnect_do + +This method is deprecated in favour of setting via L. + +=cut + +sub on_disconnect_do { + my $self = shift; + $self->_setup_connect_do(on_disconnect_do => @_); +} + +sub _setup_connect_do { + my ($self, $opt) = (shift, shift); + + my $accessor = "_$opt"; + my $store = "_${opt}_store"; + + return $self->$accessor if not @_; + + my $val = shift; + + if (not defined $val) { + $self->$accessor(undef); + $self->$store(undef); + return; + } + + my @store; + + if (not ref($val)) { + push @store, [ 'do_sql', $val ]; + } elsif (ref($val) eq 'CODE') { + push @store, $val; + } elsif (ref($val) eq 'ARRAY') { + push @store, map [ 'do_sql', $_ ], @$val; + } else { + $self->throw_exception("Invalid type for $opt ".ref($val)); + } + + $self->$store(\@store); + $self->$accessor($val); +} =head2 dbh_do @@ -506,8 +647,12 @@ sub disconnect { my ($self) = @_; if( $self->connected ) { - my $connection_do = $self->on_disconnect_do; - $self->_do_connection_actions($connection_do) if ref($connection_do); + if (my $connection_call = $self->on_disconnect_call) { + $self->_do_connection_actions(disconnect_call_ => $connection_call) + } + if (my $connection_do = $self->_on_disconnect_do_store) { + $self->_do_connection_actions(disconnect_call_ => $connection_do) + } $self->_dbh->rollback unless $self->_dbh_autocommit; $self->_dbh->disconnect; @@ -624,8 +769,12 @@ sub _populate_dbh { # there is no transaction in progress by definition $self->{transaction_depth} = $self->_dbh_autocommit ? 0 : 1; - my $connection_do = $self->on_connect_do; - $self->_do_connection_actions($connection_do) if $connection_do; + if (my $connection_call = $self->on_connect_call) { + $self->_do_connection_actions(connect_call_ => $connection_call) + } + if (my $connection_do = $self->_on_connect_do_store) { + $self->_do_connection_actions(connect_call_ => $connection_do) + } } sub _determine_driver { @@ -650,25 +799,41 @@ sub _determine_driver { } sub _do_connection_actions { - my $self = shift; - my $connection_do = shift; - - if (!ref $connection_do) { - $self->_do_query($connection_do); - } - elsif (ref $connection_do eq 'ARRAY') { - $self->_do_query($_) foreach @$connection_do; - } - elsif (ref $connection_do eq 'CODE') { - $connection_do->($self); - } - else { - $self->throw_exception (sprintf ("Don't know how to process conection actions of type '%s'", ref $connection_do) ); + my $self = shift; + my $method_prefix = shift; + my $call = shift; + + if (not ref($call)) { + my $method = $method_prefix . $call; + $self->$method(@_); + } elsif (ref($call) eq 'CODE') { + $self->$call(@_); + } elsif (ref($call) eq 'ARRAY') { + if (ref($call->[0]) ne 'ARRAY') { + $self->_do_connection_actions($method_prefix, $_) for @$call; + } else { + $self->_do_connection_actions($method_prefix, @$_) for @$call; + } + } else { + $self->throw_exception (sprintf ("Don't know how to process conection actions of type '%s'", ref($call)) ); } return $self; } +sub connect_call_do_sql { + my $self = shift; + $self->_do_query(@_); +} + +sub disconnect_call_do_sql { + my $self = shift; + $self->_do_query(@_); +} + +# override in db-specific backend when necessary +sub connect_call_datetime_setup { 1 } + sub _do_query { my ($self, $action) = @_; diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm index 2021056..7eadf44 100644 --- a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm +++ b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm @@ -183,6 +183,49 @@ L. sub datetime_parser_type { return "DateTime::Format::Oracle"; } +=head2 connect_call_datetime_setup + +Used as: + + on_connect_call => 'datetime_setup' + +In L to set the session nls date, and +timestamp values for use with L and the +necessary environment variables for L, which is used +by it. + +Maximum allowable precision is used, unless the environment variables have +already been set. + +These are the defaults used: + + $ENV{NLS_DATE_FORMAT} ||= 'YYYY-MM-DD HH24:MI:SS'; + $ENV{NLS_TIMESTAMP_FORMAT} ||= 'YYYY-MM-DD HH24:MI:SS.FF'; + $ENV{NLS_TIMESTAMP_TZ_FORMAT} ||= 'YYYY-MM-DD HH24:MI:SS.FF TZHTZM'; + +To get more than second precision with L +for your timestamps, use something like this: + + use Time::HiRes 'time'; + my $ts = DateTime->from_epoch(epoch => time); + +=cut + +sub connect_call_datetime_setup { + my $self = shift; + my $dbh = $self->dbh; + + my $date_format = $ENV{NLS_DATE_FORMAT} ||= 'YYYY-MM-DD HH24:MI:SS'; + my $timestamp_format = $ENV{NLS_TIMESTAMP_FORMAT} ||= + 'YYYY-MM-DD HH24:MI:SS.FF'; + my $timestamp_tz_format = $ENV{NLS_TIMESTAMP_TZ_FORMAT} ||= + 'YYYY-MM-DD HH24:MI:SS.FF TZHTZM'; + + $dbh->do("alter session set nls_date_format = '$date_format'"); + $dbh->do("alter session set nls_timestamp_format = '$timestamp_format'"); + $dbh->do("alter session set nls_timestamp_tz_format='$timestamp_tz_format'"); +} + sub _svp_begin { my ($self, $name) = @_; diff --git a/t/73oracle.t b/t/73oracle.t index 2e73050..59f93fb 100644 --- a/t/73oracle.t +++ b/t/73oracle.t @@ -32,6 +32,7 @@ use Test::Exception; use Test::More; use lib qw(t/lib); use DBICTest; +use DateTime; my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_ORA_${_}" } qw/DSN USER PASS/}; @@ -40,7 +41,7 @@ plan skip_all => 'Set $ENV{DBICTEST_ORA_DSN}, _USER and _PASS to run this test. ' as well as following sequences: \'pkid1_seq\', \'pkid2_seq\' and \'nonpkid_seq\'' unless ($dsn && $user && $pass); -plan tests => 34; +plan tests => 35; DBICTest::Schema->load_classes('ArtistFQN'); my $schema = DBICTest::Schema->connect($dsn, $user, $pass); @@ -113,14 +114,18 @@ $new = $schema->resultset('ArtistFQN')->create( { name => 'bar' } ); is( $new->artistid, 2, "Oracle Auto-PK worked with fully-qualified tablename" ); # test join with row count ambiguity + my $cd = $schema->resultset('CD')->create({ cdid => 1, artist => 1, title => 'EP C', year => '2003' }); -my $track = $schema->resultset('Track')->create({ trackid => 1, cd => 1, position => 1, title => 'Track1' }); +my $track = $schema->resultset('Track')->create({ trackid => 1, cd => 1, + position => 1, title => 'Track1' }); my $tjoin = $schema->resultset('Track')->search({ 'me.title' => 'Track1'}, { join => 'cd', rows => 2 } ); -is($tjoin->next->title, 'Track1', "ambiguous column ok"); +ok(my $row = $tjoin->next); + +is($row->title, 'Track1', "ambiguous column ok"); # check count distinct with multiple columns my $other_track = $schema->resultset('Track')->create({ trackid => 2, cd => 1, position => 1, title => 'Track2' }); diff --git a/t/73oracle_inflate.t b/t/73oracle_inflate.t index 0f2fc23..22fabce 100644 --- a/t/73oracle_inflate.t +++ b/t/73oracle_inflate.t @@ -17,7 +17,7 @@ else { plan skip_all => 'needs DateTime and DateTime::Format::Oracle for testing'; } else { - plan tests => 7; + plan tests => 10; } } @@ -67,9 +67,36 @@ $track->update; is( $track->last_updated_on->month, $dt->month, "deflate ok"); is( int $track->last_updated_at->nanosecond, int $dt->nanosecond, "deflate ok with nanosecond precision"); +# test datetime_setup + +$schema->storage->disconnect; + +delete $ENV{NLS_DATE_FORMAT}; +delete $ENV{NLS_TIMESTAMP_FORMAT}; + +$schema->connection($dsn, $user, $pass, { + on_connect_call => 'datetime_setup' +}); + +$dt = DateTime->now(); + +my $timestamp = $dt->clone; +$timestamp->set_nanosecond( int 500_000_000 ); + +$track = $schema->resultset('Track')->find( 1 ); +$track->update({ last_updated_on => $dt, last_updated_at => $timestamp }); + +$track = $schema->resultset('Track')->find(1); + +is( $track->last_updated_on, $dt, 'DateTime round-trip as DATE' ); +is( $track->last_updated_at, $timestamp, 'DateTime round-trip as TIMESTAMP' ); + +is( int $track->last_updated_at->nanosecond, int 500_000_000, + 'TIMESTAMP nanoseconds survived' ); + # clean up our mess END { - if($dbh) { + if($schema && ($dbh = $schema->storage->dbh)) { $dbh->do("DROP TABLE track"); } } diff --git a/t/92storage_on_connect_call.t b/t/92storage_on_connect_call.t new file mode 100644 index 0000000..09befcd --- /dev/null +++ b/t/92storage_on_connect_call.t @@ -0,0 +1,68 @@ +use strict; +use warnings; +no warnings qw/once redefine/; + +use lib qw(t/lib); +use DBICTest; + +use Test::More tests => 9; + +my $schema = DBICTest->init_schema( + no_connect => 1, + no_deploy => 1, +); + +local *DBIx::Class::Storage::DBI::connect_call_foo = sub { + isa_ok $_[0], 'DBIx::Class::Storage::DBI', + 'got storage in connect_call method'; + is $_[1], 'bar', 'got param in connect_call method'; +}; + +local *DBIx::Class::Storage::DBI::disconnect_call_foo = sub { + isa_ok $_[0], 'DBIx::Class::Storage::DBI', + 'got storage in disconnect_call method'; +}; + +ok $schema->connection( + DBICTest->_database, + { + on_connect_call => [ + [ do_sql => 'create table test1 (id integer)' ], + [ do_sql => [ 'insert into test1 values (?)', {}, 1 ] ], + [ do_sql => sub { ['insert into test1 values (2)'] } ], + [ sub { $_[0]->dbh->do($_[1]) }, 'insert into test1 values (3)' ], + # this invokes $storage->connect_call_foo('bar') (above) + [ foo => 'bar' ], + ], + on_connect_do => 'insert into test1 values (4)', + on_disconnect_call => 'foo', + }, +), 'connection()'; + +is_deeply ( + $schema->storage->dbh->selectall_arrayref('select * from test1'), + [ [ 1 ], [ 2 ], [ 3 ], [ 4 ] ], + 'on_connect_call/do actions worked' +); + +local *DBIx::Class::Storage::DBI::connect_call_foo = sub { + isa_ok $_[0], 'DBIx::Class::Storage::DBI', + 'got storage in connect_call method'; +}; + +local *DBIx::Class::Storage::DBI::connect_call_bar = sub { + isa_ok $_[0], 'DBIx::Class::Storage::DBI', + 'got storage in connect_call method'; +}; + +$schema->storage->disconnect; + +ok $schema->connection( + DBICTest->_database, + { + # method list form + on_connect_call => [ 'foo', sub { ok 1, "coderef in list form" }, 'bar' ], + }, +), 'connection()'; + +$schema->storage->ensure_connected;