Replace the fallback _dbh_last_insert_id with an explicit exception.
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI.pm
index 978a12e..d70bed2 100644 (file)
@@ -50,6 +50,9 @@ sub new {
   $self;
 }
 
+# DB2 is the only remaining DB using this. Even though we are not sure if
+# RowNumberOver is still needed here (should be part of SQLA) leave the 
+# code in place
 sub _RowNumberOver {
   my ($self, $sql, $order, $rows, $offset ) = @_;
 
@@ -57,7 +60,7 @@ sub _RowNumberOver {
   my $last = $rows + $offset;
   my ( $order_by ) = $self->_order_by( $order );
 
-  $sql = <<"";
+  $sql = <<"SQL";
 SELECT * FROM
 (
    SELECT Q1.*, ROW_NUMBER() OVER( ) AS ROW_NUM FROM (
@@ -67,6 +70,8 @@ SELECT * FROM
 ) Q2
 WHERE ROW_NUM BETWEEN $offset AND $last
 
+SQL
+
   return $sql;
 }
 
@@ -76,17 +81,26 @@ WHERE ROW_NUM BETWEEN $offset AND $last
 use Scalar::Util 'blessed';
 sub _find_syntax {
   my ($self, $syntax) = @_;
-  my $dbhname = blessed($syntax) ?  $syntax->{Driver}{Name} : $syntax;
+  
+  # DB2 is the only remaining DB using this. Even though we are not sure if
+  # RowNumberOver is still needed here (should be part of SQLA) leave the 
+  # code in place
+  my $dbhname = blessed($syntax) ? $syntax->{Driver}{Name} : $syntax;
   if(ref($self) && $dbhname && $dbhname eq 'DB2') {
     return 'RowNumberOver';
   }
-
+  
   $self->{_cached_syntax} ||= $self->SUPER::_find_syntax($syntax);
 }
 
 sub select {
   my ($self, $table, $fields, $where, $order, @rest) = @_;
-  $table = $self->_quote($table) unless ref($table);
+  if (ref $table eq 'SCALAR') {
+    $table = $$table;
+  }
+  elsif (not ref $table) {
+    $table = $self->_quote($table);
+  }
   local $self->{rownum_hack_count} = 1
     if (defined $rest[0] && $self->{limit_dialect} eq 'RowNum');
   @rest = (-1) unless defined $rest[0];
@@ -157,6 +171,13 @@ sub _recurse_fields {
         .'( '.$self->_recurse_fields($fields->{$func}).' )';
     }
   }
+  # Is the second check absolutely necessary?
+  elsif ( $ref eq 'REF' and ref($$fields) eq 'ARRAY' ) {
+    return $self->_bind_to_sql( $fields );
+  }
+  else {
+    Carp::croak($ref . qq{ unexpected in _recurse_fields()})
+  }
 }
 
 sub _order_by {
@@ -177,6 +198,9 @@ sub _order_by {
     if (defined $_[0]->{order_by}) {
       $ret .= $self->_order_by($_[0]->{order_by});
     }
+    if (grep { $_ =~ /^-(desc|asc)/i } keys %{$_[0]}) {
+      return $self->SUPER::_order_by($_[0]);
+    }
   } elsif (ref $_[0] eq 'SCALAR') {
     $ret = $self->_sqlcase(' order by ').${ $_[0] };
   } elsif (ref $_[0] eq 'ARRAY' && @{$_[0]}) {
@@ -242,10 +266,20 @@ sub _recurse_from {
   return join('', @sqlf);
 }
 
+sub _bind_to_sql {
+  my $self = shift;
+  my $arr  = shift;
+  my $sql = shift @$$arr;
+  $sql =~ s/\?/$self->_quote((shift @$$arr)->[1])/eg;
+  return $sql
+}
+
 sub _make_as {
   my ($self, $from) = @_;
-  return join(' ', map { (ref $_ eq 'SCALAR' ? $$_ : $self->_quote($_)) }
-                     reverse each %{$self->_skip_options($from)});
+  return join(' ', map { (ref $_ eq 'SCALAR' ? $$_ 
+                        : ref $_ eq 'REF'    ? $self->_bind_to_sql($_) 
+                        : $self->_quote($_)) 
+                       } reverse each %{$self->_skip_options($from)});
 }
 
 sub _skip_options {
@@ -322,6 +356,15 @@ DBIx::Class::Storage::DBI - DBI storage handler
 
 =head1 SYNOPSIS
 
+  my $schema = MySchema->connect('dbi:SQLite:my.db');
+
+  $schema->storage->debug(1);
+  $schema->dbh_do("DROP TABLE authors");
+
+  $schema->resultset('Book')->search({
+     written_on => $schema->storage->datetime_parser(DateTime->now)
+  });
+
 =head1 DESCRIPTION
 
 This class represents the connection to an RDBMS via L<DBI>.  See
@@ -355,23 +398,26 @@ The argument list may contain:
 
 =item *
 
-The same 4-element argument set one would normally pass to L<DBI/connect>,
-optionally followed by L<extra attributes|/DBIx::Class specific connection attributes>
+The same 4-element argument set one would normally pass to
+L<DBI/connect>, optionally followed by
+L<extra attributes|/DBIx::Class specific connection attributes>
 recognized by DBIx::Class:
 
-  $connect_info_args = [ $dsn, $user, $password, \%dbi_attributes, \%extra_attributes ];
+  $connect_info_args = [ $dsn, $user, $password, \%dbi_attributes?, \%extra_attributes? ];
 
 =item *
 
-A single code reference which returns a connected L<DBI database handle|DBI/connect>
-optinally followed by L<extra attributes|/DBIx::Class specific connection attributes>
-recognized by DBIx::Class:
+A single code reference which returns a connected 
+L<DBI database handle|DBI/connect> optionally followed by 
+L<extra attributes|/DBIx::Class specific connection attributes> recognized
+by DBIx::Class:
 
-  $connect_info_args = [ sub { DBI->connect (...) }, \%extra_attributes ];
+  $connect_info_args = [ sub { DBI->connect (...) }, \%extra_attributes? ];
 
 =item *
 
-A single hashref with all the attributes and the dsn/user/password mixed together:
+A single hashref with all the attributes and the dsn/user/password
+mixed together:
 
   $connect_info_args = [{
     dsn => $dsn,
@@ -382,7 +428,7 @@ A single hashref with all the attributes and the dsn/user/password mixed togethe
   }];
 
 This is particularly useful for L<Catalyst> based applications, allowing the 
-following config:
+following config (L<Config::General> style):
 
   <Model::DB>
     schema_class   App::DB
@@ -396,13 +442,12 @@ following config:
 
 =back
 
-Please note that the L<DBI> docs
-recommend that you always explicitly set C<AutoCommit> to either
-C<0> or C<1>.   L<DBIx::Class> further recommends that it be set
-to C<1>, and that you perform transactions via our L</txn_do>
-method.  L<DBIx::Class> will set it to C<1> if you do not do explicitly
-set it to zero.  This is the default for most DBDs. See
-L</DBIx::Class and AutoCommit> for details.
+Please note that the L<DBI> docs recommend that you always explicitly
+set C<AutoCommit> to either I<0> or I<1>.  L<DBIx::Class> further
+recommends that it be set to I<1>, and that you perform transactions
+via our L<DBIx::Class::Schema/txn_do> method.  L<DBIx::Class> will set it
+to I<1> if you do not do explicitly set it to zero.  This is the default 
+for most DBDs. See L</DBIx::Class and AutoCommit> for details.
 
 =head3 DBIx::Class specific connection attributes
 
@@ -417,7 +462,7 @@ these options will be cleared before setting the new ones, regardless of
 whether any options are specified in the new C<connect_info>.
 
 
-=over 4
+=over
 
 =item on_connect_do
 
@@ -440,10 +485,10 @@ array reference, its return value is ignored.
 
 =item on_disconnect_do
 
-Takes arguments in the same form as L<on_connect_do> and executes them
+Takes arguments in the same form as L</on_connect_do> and executes them
 immediately before disconnecting from the database.
 
-Note, this only runs if you explicitly call L<disconnect> on the
+Note, this only runs if you explicitly call L</disconnect> on the
 storage object.
 
 =item disable_sth_caching
@@ -455,26 +500,31 @@ statement handles via L<DBI/prepare_cached>.
 
 Sets the limit dialect. This is useful for JDBC-bridge among others
 where the remote SQL-dialect cannot be determined by the name of the
-driver alone.
+driver alone. See also L<SQL::Abstract::Limit>.
 
 =item quote_char
 
 Specifies what characters to use to quote table and column names. If 
-you use this you will want to specify L<name_sep> as well.
+you use this you will want to specify L</name_sep> as well.
 
-quote_char expects either a single character, in which case is it is placed
-on either side of the table/column, or an arrayref of length 2 in which case the
-table/column name is placed between the elements.
+C<quote_char> expects either a single character, in which case is it
+is placed on either side of the table/column name, or an arrayref of length
+2 in which case the table/column name is placed between the elements.
 
-For example under MySQL you'd use C<quote_char =E<gt> '`'>, and user SQL Server you'd 
-use C<quote_char =E<gt> [qw/[ ]/]>.
+For example under MySQL you should use C<< quote_char => '`' >>, and for
+SQL Server you should use C<< quote_char => [qw/[ ]/] >>.
 
 =item name_sep
 
-This only needs to be used in conjunction with L<quote_char>, and is used to 
+This only needs to be used in conjunction with C<quote_char>, and is used to 
 specify the charecter that seperates elements (schemas, tables, columns) from 
 each other. In most cases this is simply a C<.>.
 
+The consequences of not supplying this value is that L<SQL::Abstract>
+will assume DBIx::Class' uses of aliases to be complete column
+names. The output will look like I<"me.name"> when it should actually
+be I<"me"."name">.
+
 =item unsafe
 
 This Storage driver normally installs its own C<HandleError>, sets
@@ -504,7 +554,8 @@ L<DBIx::Class::Storage::DBI::Cursor>.
 
 =back
 
-Some real-life examples of arguments to L</connect_info> and L<DBIx::Class::Schema/connect>
+Some real-life examples of arguments to L</connect_info> and
+L<DBIx::Class::Schema/connect>
 
   # Simple SQLite connection
   ->connect_info([ 'dbi:SQLite:./foo.db' ]);
@@ -534,7 +585,7 @@ Some real-life examples of arguments to L</connect_info> and L<DBIx::Class::Sche
   );
 
   # Same, but with hashref as argument
-  # See C<parse_connect_info> for explanation
+  # See parse_connect_info for explanation
   ->connect_info(
     [{
       dsn         => 'dbi:Pg:dbname=foo',
@@ -620,7 +671,7 @@ sub connect_info {
 
 =head2 on_connect_do
 
-This method is deprecated in favor of setting via L</connect_info>.
+This method is deprecated in favour of setting via L</connect_info>.
 
 
 =head2 dbh_do
@@ -858,7 +909,7 @@ sub dbh {
 sub _sql_maker_args {
     my ($self) = @_;
     
-    return ( bindtype=>'columns', limit_dialect => $self->dbh, %{$self->_sql_maker_opts} );
+    return ( bindtype=>'columns', array_datatypes => 1, limit_dialect => $self->dbh, %{$self->_sql_maker_opts} );
 }
 
 sub sql_maker {
@@ -889,11 +940,11 @@ sub _populate_dbh {
     }
   }
 
-  my $connection_do = $self->on_connect_do;
-  $self->_do_connection_actions($connection_do) if ref($connection_do);
-
   $self->_conn_pid($$);
   $self->_conn_tid(threads->tid) if $INC{'threads.pm'};
+
+  my $connection_do = $self->on_connect_do;
+  $self->_do_connection_actions($connection_do) if ref($connection_do);
 }
 
 sub _do_connection_actions {
@@ -904,7 +955,7 @@ sub _do_connection_actions {
     $self->_do_query($_) foreach @$connection_do;
   }
   elsif (ref $connection_do eq 'CODE') {
-    $connection_do->();
+    $connection_do->($self);
   }
 
   return $self;
@@ -918,10 +969,18 @@ sub _do_query {
     $self->_do_query($_) foreach @$action;
   }
   else {
-    my @to_run = (ref $action eq 'ARRAY') ? (@$action) : ($action);
-    $self->_query_start(@to_run);
-    $self->_dbh->do(@to_run);
-    $self->_query_end(@to_run);
+    # Most debuggers expect ($sql, @bind), so we need to exclude
+    # the attribute hash which is the second argument to $dbh->do
+    # furthermore the bind values are usually to be presented
+    # as named arrayref pairs, so wrap those here too
+    my @do_args = (ref $action eq 'ARRAY') ? (@$action) : ($action);
+    my $sql = shift @do_args;
+    my $attrs = shift @do_args;
+    my @bind = map { [ undef, $_ ] } @do_args;
+
+    $self->_query_start($sql, @bind);
+    $self->_dbh->do($sql, $attrs, @do_args);
+    $self->_query_end($sql, @bind);
   }
 
   return $self;
@@ -1131,11 +1190,15 @@ sub txn_rollback {
 sub _prep_for_execute {
   my ($self, $op, $extra_bind, $ident, $args) = @_;
 
+  if( blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) {
+    $ident = $ident->from();
+  }
+
   my ($sql, @bind) = $self->sql_maker->$op($ident, @$args);
+
   unshift(@bind,
     map { ref $_ eq 'ARRAY' ? $_ : [ '!!dummy', $_ ] } @$extra_bind)
       if $extra_bind;
-
   return ($sql, \@bind);
 }
 
@@ -1176,10 +1239,6 @@ sub _query_end {
 
 sub _dbh_execute {
   my ($self, $dbh, $op, $extra_bind, $ident, $bind_attributes, @args) = @_;
-  
-  if( blessed($ident) && $ident->isa("DBIx::Class::ResultSource") ) {
-    $ident = $ident->from();
-  }
 
   my ($sql, $bind) = $self->_prep_for_execute($op, $extra_bind, $ident, \@args);
 
@@ -1199,7 +1258,8 @@ sub _dbh_execute {
     }
 
     foreach my $data (@data) {
-      $data = ref $data ? ''.$data : $data; # stringify args
+      my $ref = ref $data;
+      $data = $ref && $ref ne 'ARRAY' ? ''.$data : $data; # stringify args (except arrayrefs)
 
       $sth->bind_param($placeholder_index, $data, $attributes);
       $placeholder_index++;
@@ -1314,6 +1374,13 @@ sub delete {
 }
 
 sub _select {
+  my $self = shift;
+  my $sql_maker = $self->sql_maker;
+  local $sql_maker->{for};
+  return $self->_execute($self->_select_args(@_));
+}
+
+sub _select_args {
   my ($self, $ident, $select, $condition, $attrs) = @_;
   my $order = $attrs->{order_by};
 
@@ -1327,7 +1394,7 @@ sub _select {
 
   my $for = delete $attrs->{for};
   my $sql_maker = $self->sql_maker;
-  local $sql_maker->{for} = $for;
+  $sql_maker->{for} = $for;
 
   if (exists $attrs->{group_by} || $attrs->{having}) {
     $order = {
@@ -1349,8 +1416,7 @@ sub _select {
     $attrs->{rows} = 2**48 if not defined $attrs->{rows} and defined $attrs->{offset};
     push @args, $attrs->{rows}, $attrs->{offset};
   }
-
-  return $self->_execute(@args);
+  return @args;
 }
 
 sub source_bind_attributes {
@@ -1389,7 +1455,8 @@ sub select_single {
   my $self = shift;
   my ($rv, $sth, @bind) = $self->_select(@_);
   my @row = $sth->fetchrow_array;
-  if(@row && $sth->fetchrow_array) {
+  my @nextrow = $sth->fetchrow_array if @row;
+  if(@row && @nextrow) {
     carp "Query returned more than one row.  SQL that returns multiple rows is DEPRECATED for ->find and ->single";
   }
   # Need to call finish() to work round broken DBDs
@@ -1498,9 +1565,18 @@ Return the row id of the last insert.
 =cut
 
 sub _dbh_last_insert_id {
-    my ($self, $dbh, $source, $col) = @_;
-    # XXX This is a SQLite-ism as a default... is there a DBI-generic way?
-    $dbh->func('last_insert_rowid');
+    # All Storage's need to register their own _dbh_last_insert_id
+    # the old SQLite-based method was highly inappropriate
+
+    my $self = shift;
+    my $class = ref $self;
+    $self->throw_exception (<<EOE);
+
+No _dbh_last_insert_id() method found in $class.
+Since the method of obtaining the autoincrement id of the last insert
+operation varies greatly between different databases, this method must be
+individually implemented for every storage class.
+EOE
 }
 
 sub last_insert_id {
@@ -1518,9 +1594,9 @@ sub sqlt_type { shift->dbh->{Driver}->{Name} }
 
 =head2 bind_attribute_by_data_type
 
-Given a datatype from column info, returns a database specific bind attribute for
-$dbh->bind_param($val,$attribute) or nothing if we will let the database planner
-just handle it.
+Given a datatype from column info, returns a database specific bind
+attribute for C<< $dbh->bind_param($val,$attribute) >> or nothing if we will
+let the database planner just handle it.
 
 Generally only needed for special case column types, like bytea in postgres.
 
@@ -1561,7 +1637,10 @@ sub create_ddl_dir {
   }
   $databases ||= ['MySQL', 'SQLite', 'PostgreSQL'];
   $databases = [ $databases ] if(ref($databases) ne 'ARRAY');
-  $version ||= $schema->VERSION || '1.x';
+
+  my $schema_version = $schema->schema_version || '1.x';
+  $version ||= $schema_version;
+
   $sqltargs = {
     add_drop_table => 1, 
     ignore_constraint_names => 1,
@@ -1569,7 +1648,7 @@ sub create_ddl_dir {
     %{$sqltargs || {}}
   };
 
-  $self->throw_exception(q{Can't create a ddl file without SQL::Translator 0.09: '}
+  $self->throw_exception(q{Can't create a ddl file without SQL::Translator 0.09003: '}
       . $self->_check_sqlt_message . q{'})
           if !$self->_check_sqlt_version;
 
@@ -1586,7 +1665,7 @@ sub create_ddl_dir {
 
     my $file;
     my $filename = $schema->ddl_filename($db, $version, $dir);
-    if (-e $filename && (!$version || ($version == $schema->schema_version()))) {
+    if (-e $filename && ($version eq $schema_version )) {
       # if we are dumping the current version, overwrite the DDL
       warn "Overwriting existing DDL file - $filename";
       unlink($filename);
@@ -1703,9 +1782,9 @@ sub deployment_statements {
   # Need to be connected to get the correct sqlt_type
   $self->ensure_connected() unless $type;
   $type ||= $self->sqlt_type;
-  $version ||= $schema->VERSION || '1.x';
+  $version ||= $schema->schema_version || '1.x';
   $dir ||= './';
-  my $filename = $schema->ddl_filename($type, $dir, $version);
+  my $filename = $schema->ddl_filename($type, $version, $dir);
   if(-f $filename)
   {
       my $file;
@@ -1716,7 +1795,7 @@ sub deployment_statements {
       return join('', @rows);
   }
 
-  $self->throw_exception(q{Can't deploy without SQL::Translator 0.09: '}
+  $self->throw_exception(q{Can't deploy without SQL::Translator 0.09003: '}
       . $self->_check_sqlt_message . q{'})
           if !$self->_check_sqlt_version;
 
@@ -1736,22 +1815,32 @@ sub deployment_statements {
 
 sub deploy {
   my ($self, $schema, $type, $sqltargs, $dir) = @_;
-  foreach my $statement ( $self->deployment_statements($schema, $type, undef, $dir, { no_comments => 1, %{ $sqltargs || {} } } ) ) {
-    foreach my $line ( split(";\n", $statement)) {
-      next if($line =~ /^--/);
-      next if(!$line);
-#      next if($line =~ /^DROP/m);
-      next if($line =~ /^BEGIN TRANSACTION/m);
-      next if($line =~ /^COMMIT/m);
-      next if $line =~ /^\s+$/; # skip whitespace only
-      $self->_query_start($line);
-      eval {
-        $self->dbh->do($line); # shouldn't be using ->dbh ?
-      };
-      if ($@) {
-        warn qq{$@ (running "${line}")};
-      }
-      $self->_query_end($line);
+  my $deploy = sub {
+    my $line = shift;
+    return if($line =~ /^--/);
+    return if(!$line);
+    # next if($line =~ /^DROP/m);
+    return if($line =~ /^BEGIN TRANSACTION/m);
+    return if($line =~ /^COMMIT/m);
+    return if $line =~ /^\s+$/; # skip whitespace only
+    $self->_query_start($line);
+    eval {
+      $self->dbh->do($line); # shouldn't be using ->dbh ?
+    };
+    if ($@) {
+      warn qq{$@ (running "${line}")};
+    }
+    $self->_query_end($line);
+  };
+  my @statements = $self->deployment_statements($schema, $type, undef, $dir, { no_comments => 1, %{ $sqltargs || {} } } );
+  if (@statements > 1) {
+    foreach my $statement (@statements) {
+      $deploy->( $statement );
+    }
+  }
+  elsif (@statements == 1) {
+    foreach my $line ( split(";\n", $statements[0])) {
+      $deploy->( $line );
     }
   }
 }
@@ -1798,7 +1887,7 @@ sub build_datetime_parser {
     my $_check_sqlt_message; # private
     sub _check_sqlt_version {
         return $_check_sqlt_version if defined $_check_sqlt_version;
-        eval 'use SQL::Translator "0.09"';
+        eval 'use SQL::Translator "0.09003"';
         $_check_sqlt_message = $@ || '';
         $_check_sqlt_version = !$@;
     }
@@ -1882,17 +1971,14 @@ The following methods are extended:-
 =item limit_dialect
 
 See L</connect_info> for details.
-For setting, this method is deprecated in favor of L</connect_info>.
 
 =item quote_char
 
 See L</connect_info> for details.
-For setting, this method is deprecated in favor of L</connect_info>.
 
 =item name_sep
 
 See L</connect_info> for details.
-For setting, this method is deprecated in favor of L</connect_info>.
 
 =back