Another overhaul of transaction/savepoint handling
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI / Sybase / ASE.pm
index e3485ce..a7cf298 100644 (file)
@@ -8,11 +8,17 @@ use base qw/
     DBIx::Class::Storage::DBI::AutoCast
 /;
 use mro 'c3';
-use Carp::Clan qw/^DBIx::Class/;
-use Scalar::Util();
-use List::Util();
+use DBIx::Class::Carp;
+use Scalar::Util 'blessed';
+use List::Util 'first';
 use Sub::Name();
-use Data::Dumper::Concise();
+use Data::Dumper::Concise 'Dumper';
+use Try::Tiny;
+use namespace::clean;
+
+__PACKAGE__->sql_limit_dialect ('RowCountOrGenericSubQ');
+__PACKAGE__->sql_quote_char ([qw/[ ]/]);
+__PACKAGE__->datetime_parser_type('DateTime::Format::Sybase');
 
 __PACKAGE__->mk_group_accessors('simple' =>
     qw/_identity _blob_log_on_update _writer_storage _is_extra_storage
@@ -49,7 +55,7 @@ With this driver there is unfortunately no way to get the C<last_insert_id>
 without doing a C<SELECT MAX(col)>. This is done safely in a transaction
 (locking the table.) See L</INSERTS WITH PLACEHOLDERS>.
 
-A recommended L<DBIx::Class::Storage::DBI/connect_info> setting:
+A recommended L<connect_info|DBIx::Class::Storage::DBI/connect_info> setting:
 
   on_connect_call => [['datetime_setup'], ['blob_setup', log_on_update => 0]]
 
@@ -81,8 +87,8 @@ To turn off this warning set the DBIC_SYBASE_FREETDS_NOWARN environment
 variable.
 EOF
 
-    if (not $self->_typeless_placeholders_supported) {
-      if ($self->_placeholders_supported) {
+    if (not $self->_use_typeless_placeholders) {
+      if ($self->_use_placeholders) {
         $self->auto_cast(1);
       }
       else {
@@ -100,7 +106,7 @@ EOF
     $self->_rebless;
   }
   # this is highly unlikely, but we check just in case
-  elsif (not $self->_typeless_placeholders_supported) {
+  elsif (not $self->_use_typeless_placeholders) {
     $self->auto_cast(1);
   }
 }
@@ -167,35 +173,30 @@ sub disconnect {
   $self->next::method;
 }
 
+# This is only invoked for FreeTDS drivers by ::Storage::DBI::Sybase::FreeTDS
+sub _set_autocommit_stmt {
+  my ($self, $on) = @_;
+
+  return 'SET CHAINED ' . ($on ? 'OFF' : 'ON');
+}
+
 # Set up session settings for Sybase databases for the connection.
 #
 # Make sure we have CHAINED mode turned on if AutoCommit is off in non-FreeTDS
 # DBD::Sybase (since we don't know how DBD::Sybase was compiled.) If however
 # we're using FreeTDS, CHAINED mode turns on an implicit transaction which we
 # only want when AutoCommit is off.
-#
-# Also SET TEXTSIZE for FreeTDS because LongReadLen doesn't work.
 sub _run_connection_actions {
   my $self = shift;
 
   if ($self->_is_bulk_storage) {
-# this should be cleared on every reconnect
+    # this should be cleared on every reconnect
     $self->_began_bulk_work(0);
     return;
   }
 
-  if (not $self->using_freetds) {
-    $self->_dbh->{syb_chained_txn} = 1;
-  } else {
-    # based on LongReadLen in connect_info
-    $self->set_textsize;
-
-    if ($self->_dbh_autocommit) {
-      $self->_dbh->do('SET CHAINED OFF');
-    } else {
-      $self->_dbh->do('SET CHAINED ON');
-    }
-  }
+  $self->_dbh->{syb_chained_txn} = 1
+    unless $self->using_freetds;
 
   $self->next::method(@_);
 }
@@ -229,12 +230,6 @@ sub connect_call_blob_setup {
     if exists $args{log_on_update};
 }
 
-sub _is_lob_type {
-  my $self = shift;
-  my $type = shift;
-  $type && $type =~ /(?:text|image|lob|bytea|binary|memo)/i;
-}
-
 sub _is_lob_column {
   my ($self, $source, $column) = @_;
 
@@ -243,23 +238,26 @@ sub _is_lob_column {
 
 sub _prep_for_execute {
   my $self = shift;
-  my ($op, $extra_bind, $ident, $args) = @_;
+  my ($op, $ident, $args) = @_;
 
   my ($sql, $bind) = $self->next::method (@_);
 
-  my $table = Scalar::Util::blessed($ident) ? $ident->from : $ident;
+  my $table = blessed $ident ? $ident->from : $ident;
 
   my $bind_info = $self->_resolve_column_info(
-    $ident, [map $_->[0], @{$bind}]
+    $ident, [map { $_->[0]{dbic_colname} || () } @{$bind}]
   );
-  my $bound_identity_col = List::Util::first
-    { $bind_info->{$_}{is_auto_increment} }
-    (keys %$bind_info)
+  my $bound_identity_col =
+    first { $bind_info->{$_}{is_auto_increment} }
+    keys %$bind_info
   ;
-  my $identity_col = Scalar::Util::blessed($ident) &&
-    List::Util::first
-    { $ident->column_info($_)->{is_auto_increment} }
-    $ident->columns
+
+  my $columns_info = blessed $ident && $ident->columns_info;
+
+  my $identity_col =
+    $columns_info &&
+    first { $columns_info->{$_}{is_auto_increment} }
+      keys %$columns_info
   ;
 
   if (($op eq 'insert' && $bound_identity_col) ||
@@ -330,7 +328,7 @@ sub _execute {
   my $self = shift;
   my ($op) = @_;
 
-  my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
+  my ($rv, $sth, @bind) = $self->next::method(@_);
 
   if ($op eq 'insert') {
     $self->_identity($sth->fetchrow_array);
@@ -347,9 +345,12 @@ sub insert {
   my $self = shift;
   my ($source, $to_insert) = @_;
 
-  my $identity_col = (List::Util::first
-    { $source->column_info($_)->{is_auto_increment} }
-    $source->columns) || '';
+  my $columns_info = $source->columns_info;
+
+  my $identity_col =
+    (first { $columns_info->{$_}{is_auto_increment} }
+      keys %$columns_info )
+    || '';
 
   # check for empty insert
   # INSERT INTO foo DEFAULT VALUES -- does not work with Sybase
@@ -426,15 +427,15 @@ sub update {
   my $self = shift;
   my ($source, $fields, $where, @rest) = @_;
 
-  my $wantarray = wantarray;
-
   my $blob_cols = $self->_remove_blob_cols($source, $fields);
 
   my $table = $source->name;
 
-  my $identity_col = List::Util::first
-    { $source->column_info($_)->{is_auto_increment} }
-    $source->columns;
+  my $columns_info = $source->columns_info;
+
+  my $identity_col =
+    first { $columns_info->{$_}{is_auto_increment} }
+      keys %$columns_info;
 
   my $is_identity_update = $identity_col && defined $fields->{$identity_col};
 
@@ -463,10 +464,10 @@ sub update {
 
   my @res;
   if (%$fields) {
-    if ($wantarray) {
+    if (wantarray) {
       @res    = $self->next::method(@_);
     }
-    elsif (defined $wantarray) {
+    elsif (defined wantarray) {
       $res[0] = $self->next::method(@_);
     }
     else {
@@ -476,21 +477,20 @@ sub update {
 
   $guard->commit;
 
-  return $wantarray ? @res : $res[0];
+  return wantarray ? @res : $res[0];
 }
 
 sub insert_bulk {
   my $self = shift;
   my ($source, $cols, $data) = @_;
 
-  my $identity_col = List::Util::first
-    { $source->column_info($_)->{is_auto_increment} }
-    $source->columns;
+  my $columns_info = $source->columns_info;
+
+  my $identity_col =
+    first { $columns_info->{$_}{is_auto_increment} }
+      keys %$columns_info;
 
-  my $is_identity_insert = (List::Util::first
-    { $_ eq $identity_col }
-    @{$cols}
-  ) ? 1 : 0;
+  my $is_identity_insert = (first { $_ eq $identity_col } @{$cols}) ? 1 : 0;
 
   my @source_columns = $source->columns;
 
@@ -596,7 +596,8 @@ EOF
       return 0;
   });
 
-  eval {
+  my $exception = '';
+  try {
     my $bulk = $self->_bulk_storage;
 
     my $guard = $bulk->txn_scope_guard;
@@ -628,10 +629,7 @@ EOF
       }
     );
 
-    my @bind = do {
-      my $idx = 0;
-      map [ $_, $idx++ ], @source_columns;
-    };
+    my @bind = map { [ $source_columns[$_] => $_ ] } (0 .. $#source_columns);
 
     $self->_execute_array(
       $source, $sth, \@bind, \@source_columns, \@new_data, sub {
@@ -640,21 +638,19 @@ EOF
     );
 
     $bulk->_query_end($sql);
+  } catch {
+    $exception = shift;
   };
 
-  my $exception = $@;
   DBD::Sybase::set_cslib_cb($orig_cslib_cb);
 
   if ($exception =~ /-Y option/) {
-    carp <<"EOF";
-
-Sybase bulk API operation failed due to character set incompatibility, reverting
-to regular array inserts:
-
-*** Try unsetting the LANG environment variable.
+    my $w = 'Sybase bulk API operation failed due to character set incompatibility, '
+          . 'reverting to regular array inserts. Try unsetting the LANG environment variable'
+    ;
+    $w .= "\n$exception" if $self->debug;
+    carp $w;
 
-$exception
-EOF
     $self->_bulk_storage(undef);
     unshift @_, $self;
     goto \&insert_bulk;
@@ -728,9 +724,11 @@ sub _remove_blob_cols_array {
 sub _update_blobs {
   my ($self, $source, $blob_cols, $where) = @_;
 
-  my @primary_cols = eval { $source->_pri_cols };
-  $self->throw_exception("Cannot update TEXT/IMAGE column(s): $@")
-    if $@;
+  my @primary_cols = try
+    { $source->_pri_cols }
+    catch {
+      $self->throw_exception("Cannot update TEXT/IMAGE column(s): $_")
+    };
 
 # check if we're updating a single row by PK
   my $pk_cols_in_where = 0;
@@ -762,9 +760,11 @@ sub _insert_blobs {
   my $table = $source->name;
 
   my %row = %$row;
-  my @primary_cols = eval { $source->_pri_cols} ;
-  $self->throw_exception("Cannot update TEXT/IMAGE column(s): $@")
-    if $@;
+  my @primary_cols = try
+    { $source->_pri_cols }
+    catch {
+      $self->throw_exception("Cannot update TEXT/IMAGE column(s): $_")
+    };
 
   $self->throw_exception('Cannot update TEXT/IMAGE column(s) without primary key values')
     if ((grep { defined $row{$_} } @primary_cols) != @primary_cols);
@@ -779,14 +779,13 @@ sub _insert_blobs {
     my $sth = $cursor->sth;
 
     if (not $sth) {
-
       $self->throw_exception(
           "Could not find row in table '$table' for blob update:\n"
-        . Data::Dumper::Concise::Dumper (\%where)
+        . (Dumper \%where)
       );
     }
 
-    eval {
+    try {
       do {
         $sth->func('CS_GET', 1, 'ct_data_info') or die $sth->errstr;
       } while $sth->fetch;
@@ -804,19 +803,20 @@ sub _insert_blobs {
       $sth->func($blob, length($blob), 'ct_send_data') or die $sth->errstr;
 
       $sth->func('ct_finish_send') or die $sth->errstr;
-    };
-    my $exception = $@;
-    $sth->finish if $sth;
-    if ($exception) {
+    }
+    catch {
       if ($self->using_freetds) {
         $self->throw_exception (
-          'TEXT/IMAGE operation failed, probably because you are using FreeTDS: '
-          . $exception
+          "TEXT/IMAGE operation failed, probably because you are using FreeTDS: $_"
         );
-      } else {
-        $self->throw_exception($exception);
+      }
+      else {
+        $self->throw_exception($_);
       }
     }
+    finally {
+      $sth->finish if $sth;
+    };
   }
 }
 
@@ -846,7 +846,7 @@ Used as:
 
   on_connect_call => 'datetime_setup'
 
-In L<DBIx::Class::Storage::DBI/connect_info> to set:
+In L<connect_info|DBIx::Class::Storage::DBI/connect_info> to set:
 
   $dbh->syb_date_fmt('ISO_strict'); # output fmt: 2004-08-21T14:36:48.080Z
   $dbh->do('set dateformat mdy');   # input fmt:  08/13/1979 18:08:55.080
@@ -854,42 +854,31 @@ In L<DBIx::Class::Storage::DBI/connect_info> to set:
 On connection for use with L<DBIx::Class::InflateColumn::DateTime>, using
 L<DateTime::Format::Sybase>, which you will need to install.
 
-This works for both C<DATETIME> and C<SMALLDATETIME> columns, although
+This works for both C<DATETIME> and C<SMALLDATETIME> columns, note that
 C<SMALLDATETIME> columns only have minute precision.
 
 =cut
 
-{
-  my $old_dbd_warned = 0;
+sub connect_call_datetime_setup {
+  my $self = shift;
+  my $dbh = $self->_get_dbh;
 
-  sub connect_call_datetime_setup {
-    my $self = shift;
-    my $dbh = $self->_get_dbh;
-
-    if ($dbh->can('syb_date_fmt')) {
-      # amazingly, this works with FreeTDS
-      $dbh->syb_date_fmt('ISO_strict');
-    } elsif (not $old_dbd_warned) {
-      carp "Your DBD::Sybase is too old to support ".
-      "DBIx::Class::InflateColumn::DateTime, please upgrade!";
-      $old_dbd_warned = 1;
-    }
+  if ($dbh->can('syb_date_fmt')) {
+    # amazingly, this works with FreeTDS
+    $dbh->syb_date_fmt('ISO_strict');
+  }
+  else {
+    carp_once
+      'Your DBD::Sybase is too old to support '
+     .'DBIx::Class::InflateColumn::DateTime, please upgrade!';
 
     $dbh->do('SET DATEFORMAT mdy');
-
     1;
   }
 }
 
-sub datetime_parser_type { "DateTime::Format::Sybase" }
-
-# ->begin_work and such have no effect with FreeTDS but we run them anyway to
-# let the DBD keep any state it needs to.
-#
-# If they ever do start working, the extra statements will do no harm (because
-# Sybase supports nested transactions.)
 
-sub _dbh_begin_work {
+sub _exec_txn_begin {
   my $self = shift;
 
 # bulkLogin=1 connections are always in a transaction, and can only call BEGIN
@@ -898,44 +887,24 @@ sub _dbh_begin_work {
 
   $self->next::method(@_);
 
-  if ($self->using_freetds) {
-    $self->_get_dbh->do('BEGIN TRAN');
-  }
-
   $self->_began_bulk_work(1) if $self->_is_bulk_storage;
 }
 
-sub _dbh_commit {
-  my $self = shift;
-  if ($self->using_freetds) {
-    $self->_dbh->do('COMMIT');
-  }
-  return $self->next::method(@_);
-}
-
-sub _dbh_rollback {
-  my $self = shift;
-  if ($self->using_freetds) {
-    $self->_dbh->do('ROLLBACK');
-  }
-  return $self->next::method(@_);
-}
-
 # savepoint support using ASE syntax
 
-sub _svp_begin {
+sub _exec_svp_begin {
   my ($self, $name) = @_;
 
-  $self->_get_dbh->do("SAVE TRANSACTION $name");
+  $self->_dbh->do("SAVE TRANSACTION $name");
 }
 
 # A new SAVE TRANSACTION with the same name releases the previous one.
-sub _svp_release { 1 }
+sub _exec_svp_release { 1 }
 
-sub _svp_rollback {
+sub _exec_svp_rollback {
   my ($self, $name) = @_;
 
-  $self->_get_dbh->do("ROLLBACK TRANSACTION $name");
+  $self->_dbh->do("ROLLBACK TRANSACTION $name");
 }
 
 1;
@@ -943,7 +912,7 @@ sub _svp_rollback {
 =head1 Schema::Loader Support
 
 As of version C<0.05000>, L<DBIx::Class::Schema::Loader> should work well with
-most (if not all) versions of Sybase ASE.
+most versions of Sybase ASE.
 
 =head1 FreeTDS
 
@@ -962,20 +931,24 @@ To see if you're using FreeTDS check C<< $schema->storage->using_freetds >>, or
 
   perl -MDBI -le 'my $dbh = DBI->connect($dsn, $user, $pass); print $dbh->{syb_oc_version}'
 
-Some versions of the libraries involved will not support placeholders, in which
-case the storage will be reblessed to
+It is recommended to set C<tds version> for your ASE server to C<5.0> in
+C</etc/freetds/freetds.conf>.
+
+Some versions or configurations of the libraries involved will not support
+placeholders, in which case the storage will be reblessed to
 L<DBIx::Class::Storage::DBI::Sybase::ASE::NoBindVars>.
 
 In some configurations, placeholders will work but will throw implicit type
 conversion errors for anything that's not expecting a string. In such a case,
 the C<auto_cast> option from L<DBIx::Class::Storage::DBI::AutoCast> is
 automatically set, which you may enable on connection with
-L<DBIx::Class::Storage::DBI::AutoCast/connect_call_set_auto_cast>. The type info
-for the C<CAST>s is taken from the L<DBIx::Class::ResultSource/data_type>
-definitions in your Result classes, and are mapped to a Sybase type (if it isn't
-already) using a mapping based on L<SQL::Translator>.
+L<connect_call_set_auto_cast|DBIx::Class::Storage::DBI::AutoCast/connect_call_set_auto_cast>.
+The type info for the C<CAST>s is taken from the
+L<DBIx::Class::ResultSource/data_type> definitions in your Result classes, and
+are mapped to a Sybase type (if it isn't already) using a mapping based on
+L<SQL::Translator>.
 
-In other configurations, placeholers will work just as they do with the Sybase
+In other configurations, placeholders will work just as they do with the Sybase
 Open Client libraries.
 
 Inserts or updates of TEXT/IMAGE columns will B<NOT> work with FreeTDS.
@@ -991,14 +964,14 @@ In addition, they are done on a separate connection so that it's possible to
 have active cursors when doing an insert.
 
 When using C<DBIx::Class::Storage::DBI::Sybase::ASE::NoBindVars> transactions
-are disabled, as there are no concurrency issues with C<SELECT @@IDENTITY> as
-it's a session variable.
+are unnecessary and not used, as there are no concurrency issues with C<SELECT
+@@IDENTITY> which is a session variable.
 
 =head1 TRANSACTIONS
 
-Due to limitations of the TDS protocol, L<DBD::Sybase>, or both; you cannot
-begin a transaction while there are active cursors; nor can you use multiple
-active cursors within a transaction. An active cursor is, for example, a
+Due to limitations of the TDS protocol and L<DBD::Sybase>, you cannot begin a
+transaction while there are active cursors, nor can you use multiple active
+cursors within a transaction. An active cursor is, for example, a
 L<ResultSet|DBIx::Class::ResultSet> that has been executed using C<next> or
 C<first> but has not been exhausted or L<reset|DBIx::Class::ResultSet/reset>.
 
@@ -1069,11 +1042,12 @@ or
 instead.
 
 However, the C<LongReadLen> you pass in
-L<DBIx::Class::Storage::DBI/connect_info> is used to execute the equivalent
-C<SET TEXTSIZE> command on connection.
+L<connect_info|DBIx::Class::Storage::DBI/connect_info> is used to execute the
+equivalent C<SET TEXTSIZE> command on connection.
 
-See L</connect_call_blob_setup> for a L<DBIx::Class::Storage::DBI/connect_info>
-setting you need to work with C<IMAGE> columns.
+See L</connect_call_blob_setup> for a
+L<connect_info|DBIx::Class::Storage::DBI/connect_info> setting you need to work
+with C<IMAGE> columns.
 
 =head1 BULK API
 
@@ -1091,7 +1065,7 @@ L<populate|DBIx::Class::ResultSet/populate> call, eg.:
 B<NOTE:> the L<add_columns|DBIx::Class::ResultSource/add_columns>
 calls in your C<Result> classes B<must> list columns in database order for this
 to work. Also, you may have to unset the C<LANG> environment variable before
-loading your app, if it doesn't match the character set of your database.
+loading your app, as C<BCP -Y> is not yet supported in DBD::Sybase .
 
 When inserting IMAGE columns using this method, you'll need to use
 L</connect_call_blob_setup> as well.
@@ -1108,6 +1082,7 @@ represent them in your Result classes as:
     data_type => undef,
     default_value => \'getdate()',
     is_nullable => 0,
+    inflate_datetime => 1,
   }
 
 The C<data_type> must exist and must be C<undef>. Then empty inserts will work
@@ -1147,10 +1122,6 @@ Real limits and limited counts using stored procedures deployed on startup.
 
 =item *
 
-Adaptive Server Anywhere (ASA) support, with possible SQLA::Limit support.
-
-=item *
-
 Blob update with a LIKE query on a blob, without invalidating the WHERE condition.
 
 =item *
@@ -1161,7 +1132,7 @@ bulk_insert using prepare_cached (see comments.)
 
 =head1 AUTHOR
 
-See L<DBIx::Class/CONTRIBUTORS>.
+See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>.
 
 =head1 LICENSE