Merge 'trunk' into 'on_connect_call'
Rafael Kitover [Sat, 27 Jun 2009 22:20:25 +0000 (22:20 +0000)]
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

Makefile.PL
lib/DBIx/Class/Storage/DBI.pm
lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
t/73oracle.t
t/73oracle_inflate.t
t/92storage_on_connect_call.t [new file with mode: 0644]

index 310f12c..2369dd5 100644 (file)
@@ -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,
 
index 7998423..749c790 100644 (file)
@@ -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</disconnect> on the
 storage object.
 
+=item on_connect_call
+
+A more generalized form of L</on_connect_do> that calls the specified
+C<connect_call_METHOD> 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<connect_call_METHOD> 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<connect_call_> 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</on_connect_do> and L</on_disconnect_do> use.
+
+It can take:
+
+=over
+
+=item a scalar
+
+Will execute the scalar as SQL.
+
+=item an arrayref
+
+Taken to be arguments to L<DBI/do>, 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<DBIx::Class::InflateColumn::DateTime>.
+
+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</on_connect_call> and executes them
+immediately before disconnecting from the database.
+
+Calls the C<disconnect_call_METHOD> methods as opposed to the
+C<connect_call_METHOD> methods called by L</on_connect_call>.
+
+Note, this only runs if you explicitly call L</disconnect> 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</connect_info>.
 
+=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</connect_info>.
+
+=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) = @_;
 
index 2021056..7eadf44 100644 (file)
@@ -183,6 +183,49 @@ L<DBIx::Class::InflateColumn::DateTime>.
 
 sub datetime_parser_type { return "DateTime::Format::Oracle"; }
 
+=head2 connect_call_datetime_setup
+
+Used as:
+
+    on_connect_call => 'datetime_setup'
+
+In L<DBIx::Class::Storage::DBI/connect_info> to set the session nls date, and
+timestamp values for use with L<DBIx::Class::InflateColumn::DateTime> and the
+necessary environment variables for L<DateTime::Format::Oracle>, 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<DBIx::Class::InflateColumn::DateTime>
+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) = @_;
  
index 2e73050..59f93fb 100644 (file)
@@ -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' });
index 0f2fc23..22fabce 100644 (file)
@@ -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 (file)
index 0000000..09befcd
--- /dev/null
@@ -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;