reverted previous deploy change(r8255) - sorry matt, i wont break it again

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI.pm

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index c485257..cb61070 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -29,10 +29,38 @@ sub new {
   $self;
 }
 
+sub _RowNumberOver {
+  my ($self, $sql, $order, $rows, $offset ) = @_;
+
+  $offset += 1;
+  my $last = $rows + $offset;
+  my ( $order_by ) = $self->_order_by( $order );
+
+  $sql = <<"";
+SELECT * FROM
+(
+   SELECT Q1.*, ROW_NUMBER() OVER( ) AS ROW_NUM FROM (
+      $sql
+      $order_by
+   ) Q1
+) Q2
+WHERE ROW_NUM BETWEEN $offset AND $last
+
+  return $sql;
+}
+
+
 # While we're at it, this should make LIMIT queries more efficient,
 #  without digging into things too deeply
+use Scalar::Util 'blessed';
 sub _find_syntax {
   my ($self, $syntax) = @_;
+  my $dbhname = blessed($syntax) ?  $syntax->{Driver}{Name} : $syntax;
+#  print STDERR "Found DBH $syntax >$dbhname< ", $syntax->{Driver}->{Name}, "\n";
+  if(ref($self) && $dbhname && $dbhname eq 'DB2') {
+    return 'RowNumberOver';
+  }
+
   $self->{_cached_syntax} ||= $self->SUPER::_find_syntax($syntax);
 }
 
@@ -118,7 +146,7 @@ sub _order_by {
       $ret .= $self->_sqlcase(' having ').$frag;
     }
     if (defined $_[0]->{order_by}) {
-      $ret .= $self->SUPER::_order_by($_[0]->{order_by});
+      $ret .= $self->_order_by($_[0]->{order_by});
     }
   } elsif (ref $_[0] eq 'SCALAR') {
     $ret = $self->_sqlcase(' order by ').${ $_[0] };
@@ -275,7 +303,9 @@ This class represents the connection to the database
 =cut
 
 sub new {
-  my $new = bless({}, ref $_[0] || $_[0]);
+  my $new = {};
+  bless $new, (ref $_[0] || $_[0]);
+
   $new->cursor("DBIx::Class::Storage::DBI::Cursor");
   $new->transaction_depth(0);
 
@@ -749,7 +779,7 @@ sub _execute {
     $self->throw_exception("'$sql' did not generate a statement.");
   }
   if ($self->debug) {
-      my @debug_bind = map { defined $_ ? qq{`$_'} : q{`NULL'} } @bind;
+      my @debug_bind = map { defined $_ ? qq{`$_'} : q{`NULL'} } @bind; 
       $self->debugobj->query_end($sql, @debug_bind);
   }
   return (wantarray ? ($rv, $sth, @bind) : $rv);
@@ -800,6 +830,12 @@ sub _select {
 
 =head2 select
 
+=over 4
+
+=item Arguments: $ident, $select, $condition, $attrs
+
+=back
+
 Handle a SQL select statement.
 
 =cut
@@ -829,6 +865,12 @@ sub select_single {
 
 =head2 sth
 
+=over 4
+
+=item Arguments: $sql
+
+=back
+
 Returns a L<DBI> sth (statement handle) for the supplied SQL.
 
 =cut
@@ -841,7 +883,7 @@ sub sth {
 
 =head2 columns_info_for
 
-Returns database type info for a given table columns.
+Returns database type info for a given table column.
 
 =cut
 
@@ -852,14 +894,13 @@ sub columns_info_for {
 
   if ($dbh->can('column_info')) {
     my %result;
-    my $old_raise_err = $dbh->{RaiseError};
-    my $old_print_err = $dbh->{PrintError};
-    $dbh->{RaiseError} = 1;
-    $dbh->{PrintError} = 0;
+    local $dbh->{RaiseError} = 1;
+    local $dbh->{PrintError} = 0;
     eval {
       my ($schema,$tab) = $table =~ /^(.+?)\.(.+)$/ ? ($1,$2) : (undef,$table);
       my $sth = $dbh->column_info( undef,$schema, $tab, '%' );
       $sth->execute();
+
       while ( my $info = $sth->fetchrow_hashref() ){
         my %column_info;
         $column_info{data_type}   = $info->{TYPE_NAME};
@@ -872,9 +913,7 @@ sub columns_info_for {
         $result{$col_name} = \%column_info;
       }
     };
-    $dbh->{RaiseError} = $old_raise_err;
-    $dbh->{PrintError} = $old_print_err;
-    return \%result if !$@;
+    return \%result if !$@ && scalar keys %result;
   }
 
   my %result;
@@ -933,7 +972,7 @@ sub sqlt_type { shift->dbh->{Driver}->{Name} }
 
 =back
 
-Creates an SQL file based on the Schema, for each of the specified
+Creates a SQL file based on the Schema, for each of the specified
 database types, in the given directory.
 
 Note that this feature is currently EXPERIMENTAL and may not work correctly
@@ -953,14 +992,12 @@ sub create_ddl_dir
   $databases ||= ['MySQL', 'SQLite', 'PostgreSQL'];
   $databases = [ $databases ] if(ref($databases) ne 'ARRAY');
   $version ||= $schema->VERSION || '1.x';
+  $sqltargs = { ( add_drop_table => 1 ), %{$sqltargs || {}} };
 
   eval "use SQL::Translator";
   $self->throw_exception("Can't deploy without SQL::Translator: $@") if $@;
 
-  my $sqlt = SQL::Translator->new({
-#      debug => 1,
-      add_drop_table => 1,
-  });
+  my $sqlt = SQL::Translator->new($sqltargs);
   foreach my $db (@$databases)
   {
     $sqlt->reset();
@@ -995,8 +1032,24 @@ sub create_ddl_dir
 
 =head2 deployment_statements
 
-Create the statements for L</deploy> and
-L<DBIx::Class::Schema/deploy>.
+=over 4
+
+=item Arguments: $schema, $type, $version, $directory, $sqlt_args
+
+=back
+
+Returns the statements used by L</deploy> and L<DBIx::Class::Schema/deploy>.
+The database driver name is given by C<$type>, though the value from
+L</sqlt_type> is used if it is not specified.
+
+C<$directory> is used to return statements from files in a previously created
+L</create_ddl_dir> directory and is optional. The filenames are constructed
+from L<DBIx::Class::Schema/ddl_filename>, the schema name and the C<$version>.
+
+If no C<$directory> is specified then the statements are constructed on the
+fly using L<SQL::Translator> and C<$version> is ignored.
+
+See L<SQL::Translator/METHODS> for a list of values for C<$sqlt_args>.
 
 =cut
 
@@ -1045,8 +1098,8 @@ L<DBIx::Class::Schema/deploy>.
 =cut
 
 sub deploy {
-  my ($self, $schema, $type, $sqltargs) = @_;
-  foreach my $statement ( $self->deployment_statements($schema, $type, undef, undef, { no_comments => 1, %$sqltargs }) ) {
+  my ($self, $schema, $type, $sqltargs, $dir) = @_;
+  foreach my $statement ( $self->deployment_statements($schema, $type, undef, $dir, { no_comments => 1, %{ $sqltargs || {} } } ) ) {
     for ( split(";\n", $statement)) {
       next if($_ =~ /^--/);
       next if(!$_);
@@ -1095,7 +1148,17 @@ sub build_datetime_parser {
   return $type;
 }
 
-sub DESTROY { shift->disconnect }
+sub DESTROY {
+  # NOTE: if there's a merge conflict here when -current is pushed
+  #  back to trunk, take -current's version and ignore this trunk one :)
+  my $self = shift;
+
+  if($self->_dbh && $self->_conn_pid != $$) {
+    $self->_dbh->{InactiveDestroy} = 1;
+  }
+
+  $self->_dbh(undef);
+}
 
 1;
 
@@ -1164,4 +1227,3 @@ Andy Grundman <andy@hybridized.org>
 You may distribute this code under the same terms as Perl itself.
 
 =cut
-