add quote_names connect_info option
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI.pm
index e67d36b..7d7a8bb 100644 (file)
@@ -23,7 +23,12 @@ use namespace::clean;
 # default cursor class, overridable in connect_info attributes
 __PACKAGE__->cursor_class('DBIx::Class::Storage::DBI::Cursor');
 
-__PACKAGE__->mk_group_accessors('inherited' => qw/sql_maker_class sql_limit_dialect/);
+__PACKAGE__->mk_group_accessors('inherited' => qw/
+  sql_maker_class sql_limit_dialect sql_quote_char sql_name_sep
+/);
+
+__PACKAGE__->sql_name_sep('.');
+
 __PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker');
 
 __PACKAGE__->mk_group_accessors('simple' => qw/
@@ -449,6 +454,12 @@ Sets a specific SQL::Abstract::Limit-style limit dialect, overriding the
 default L</sql_limit_dialect> setting of the storage (if any). For a list
 of available limit dialects see L<DBIx::Class::SQLMaker::LimitDialects>.
 
+=item quote_names
+
+When true automatically sets L</quote_char> and L</name_sep> to the characters
+appropriate for your particular RDBMS. This option is preferred over specifying
+L</quote_char> directly.
+
 =item quote_char
 
 Specifies what characters to use to quote table and column names.
@@ -595,8 +606,18 @@ sub connect_info {
 
   my @args = @{ $info->{arguments} };
 
-  $self->_dbi_connect_info([@args,
-    %attrs && !(ref $args[0] eq 'CODE') ? \%attrs : ()]);
+  if (keys %attrs and ref $args[0] ne 'CODE') {
+    carp
+        'You provided explicit AutoCommit => 0 in your connection_info. '
+      . 'This is almost universally a bad idea (see the footnotes of '
+      . 'DBIx::Class::Storage::DBI for more info). If you still want to '
+      . 'do this you can set $ENV{DBIC_UNSAFE_AUTOCOMMIT_OK} to disable '
+      . 'this warning.'
+      if ! $attrs{AutoCommit} and ! $ENV{DBIC_UNSAFE_AUTOCOMMIT_OK};
+
+    push @args, \%attrs if keys %attrs;
+  }
+  $self->_dbi_connect_info(\@args);
 
   # FIXME - dirty:
   # save attributes them in a separate accessor so they are always
@@ -656,7 +677,7 @@ sub _normalize_connect_info {
     delete @attrs{@storage_opts} if @storage_opts;
 
   my @sql_maker_opts = grep exists $attrs{$_},
-    qw/limit_dialect quote_char name_sep/;
+    qw/limit_dialect quote_char name_sep quote_names/;
 
   @{ $info{sql_maker_options} }{@sql_maker_opts} =
     delete @attrs{@sql_maker_opts} if @sql_maker_opts;
@@ -666,11 +687,12 @@ sub _normalize_connect_info {
   return \%info;
 }
 
-sub _default_dbi_connect_attributes {
-  return {
+sub _default_dbi_connect_attributes () {
+  +{
     AutoCommit => 1,
-    RaiseError => 1,
     PrintError => 0,
+    RaiseError => 1,
+    ShowErrorStatement => 1,
   };
 }
 
@@ -987,18 +1009,39 @@ sub sql_maker {
           "Your storage class ($s_class) does not set sql_limit_dialect and you "
         . 'have not supplied an explicit limit_dialect in your connection_info. '
         . 'DBIC will attempt to use the GenericSubQ dialect, which works on most '
-        . 'databases but can be (and often is) painfully slow.'
+        . 'databases but can be (and often is) painfully slow. '
+        . "Please file an RT ticket against '$s_class' ."
         );
 
         'GenericSubQ';
       }
     ;
 
+    my ($quote_char, $name_sep);
+
+    if ($opts{quote_names}) {
+      $quote_char = (delete $opts{quote_char}) || $self->sql_quote_char || do {
+        my $s_class = (ref $self) || $self;
+        carp (
+          "You requested 'quote_names' but your storage class ($s_class) does "
+        . 'not explicitly define a default sql_quote_char and you have not '
+        . 'supplied a quote_char as part of your connection_info. DBIC will '
+        .q{default to the ANSI SQL standard quote '"', which works most of }
+        . "the time. Please file an RT ticket against '$s_class'."
+        );
+
+        '"'; # RV
+      };
+
+      $name_sep = (delete $opts{name_sep}) || $self->sql_name_sep;
+    }
+
     $self->_sql_maker($sql_maker_class->new(
       bindtype=>'columns',
       array_datatypes => 1,
       limit_dialect => $dialect,
-      name_sep => '.',
+      ($quote_char ? (quote_char => $quote_char) : ()),
+      name_sep => ($name_sep || '.'),
       %opts,
     ));
   }
@@ -1257,6 +1300,27 @@ sub _connect {
 
     unless ($self->unsafe) {
 
+      $self->throw_exception(
+        'Refusing clobbering of {HandleError} installed on externally supplied '
+       ."DBI handle $dbh. Either remove the handler or use the 'unsafe' attribute."
+      ) if $dbh->{HandleError} and ref $dbh->{HandleError} ne '__DBIC__DBH__ERROR__HANDLER__';
+
+      # Default via _default_dbi_connect_attributes is 1, hence it was an explicit
+      # request, or an external handle. Complain and set anyway
+      unless ($dbh->{RaiseError}) {
+        carp( ref $info[0] eq 'CODE'
+
+          ? "The 'RaiseError' of the externally supplied DBI handle is set to false. "
+           ."DBIx::Class will toggle it back to true, unless the 'unsafe' connect "
+           .'attribute has been supplied'
+
+          : 'RaiseError => 0 supplied in your connection_info, without an explicit '
+           .'unsafe => 1. Toggling RaiseError back to true'
+        );
+
+        $dbh->{RaiseError} = 1;
+      }
+
       # this odd anonymous coderef dereference is in fact really
       # necessary to avoid the unwanted effect described in perl5
       # RT#75792
@@ -1264,7 +1328,9 @@ sub _connect {
         my $weak_self = $_[0];
         weaken $weak_self;
 
-        $_[1]->{HandleError} = sub {
+        # the coderef is blessed so we can distinguish it from externally
+        # supplied handles (which must be preserved)
+        $_[1]->{HandleError} = bless sub {
           if ($weak_self) {
             $weak_self->throw_exception("DBI Exception: $_[0]");
           }
@@ -1273,12 +1339,8 @@ sub _connect {
             # the scope of DBIC
             croak ("DBI Exception (unhandled by DBIC, ::Schema GCed): $_[0]");
           }
-        };
+        }, '__DBIC__DBH__ERROR__HANDLER__';
       }->($self, $dbh);
-
-      $dbh->{ShowErrorStatement} = 1;
-      $dbh->{RaiseError} = 1;
-      $dbh->{PrintError} = 0;
     }
   }
   catch {
@@ -1420,7 +1482,10 @@ sub _dbh_begin_work {
 
 sub txn_commit {
   my $self = shift;
-  if ($self->{transaction_depth} == 1) {
+  if (! $self->_dbh) {
+    $self->throw_exception('cannot COMMIT on a disconnected handle');
+  }
+  elsif ($self->{transaction_depth} == 1) {
     $self->debugobj->txn_commit()
       if ($self->debug);
     $self->_dbh_commit;
@@ -1432,6 +1497,17 @@ sub txn_commit {
     $self->svp_release
       if $self->auto_savepoint;
   }
+  elsif (! $self->_dbh->FETCH('AutoCommit') ) {
+
+    carp "Storage transaction_depth $self->{transaction_depth} does not match "
+        ."false AutoCommit of $self->{_dbh}, attempting COMMIT anyway";
+
+    $self->debugobj->txn_commit()
+      if ($self->debug);
+    $self->_dbh_commit;
+    $self->{transaction_depth} = 0
+      if $self->_dbh_autocommit;
+  }
   else {
     $self->throw_exception( 'Refusing to commit without a started transaction' );
   }
@@ -1815,6 +1891,14 @@ sub _execute_array {
     $err = shift;
   };
 
+  # Not all DBDs are create equal. Some throw on error, some return
+  # an undef $rv, and some set $sth->err - try whatever we can
+  $err = ($sth->errstr || 'UNKNOWN ERROR ($sth->errstr is unset)') if (
+    ! defined $err
+      and
+    ( !defined $rv or $sth->err )
+  );
+
   # Statement must finish even if there was an exception.
   try {
     $sth->finish
@@ -1823,9 +1907,6 @@ sub _execute_array {
     $err = shift unless defined $err
   };
 
-  $err = $sth->errstr
-    if (! defined $err and $sth->err);
-
   if (defined $err) {
     my $i = 0;
     ++$i while $i <= $#$tuple_status && !ref $tuple_status->[$i];
@@ -2025,7 +2106,7 @@ sub _select_args {
     from => $ident,
     where => $where,
     $rs_alias && $alias2source->{$rs_alias}
-      ? ( _rsroot_source_handle => $alias2source->{$rs_alias}->handle )
+      ? ( _rsroot_rsrc => $alias2source->{$rs_alias} )
       : ()
     ,
   };