X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FSybase%2FASE.pm;h=0e57f02104a6e91f15834c9e04a421c1387b7e0c;hb=0e773352a;hp=637d4eca6a709c28e2e35177de39c077ee46a495;hpb=bbdda28109ffb2442af84b3cbe5c4921714a52dd;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm b/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm
index 637d4ec..0e57f02 100644
--- a/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm
+++ b/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm
@@ -8,7 +8,7 @@ use base qw/
     DBIx::Class::Storage::DBI::AutoCast
 /;
 use mro 'c3';
-use Carp::Clan qw/^DBIx::Class/;
+use DBIx::Class::Carp;
 use Scalar::Util 'blessed';
 use List::Util 'first';
 use Sub::Name();
@@ -16,6 +16,10 @@ 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
        _bulk_storage _is_bulk_storage _began_bulk_work
@@ -152,16 +156,6 @@ for my $method (@also_proxy_to_extra_storages) {
   };
 }
 
-sub _sql_maker_opts {
-  my ( $self, $opts ) = @_;
-
-  if ( $opts ) {
-    $self->{_sql_maker_opts} = { %$opts };
-  }
-
-  return { limit_dialect => 'RowCountOrGenericSubQ', %{$self->{_sql_maker_opts}||{}} };
-}
-
 sub disconnect {
   my $self = shift;
 
@@ -241,12 +235,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) = @_;
 
@@ -255,22 +243,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 = 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 =
     first { $bind_info->{$_}{is_auto_increment} }
     keys %$bind_info
   ;
+
+  my $columns_info = blessed $ident && $ident->columns_info;
+
   my $identity_col =
-    blessed $ident &&
-    first { $ident->column_info($_)->{is_auto_increment} } $ident->columns
+    $columns_info &&
+    first { $columns_info->{$_}{is_auto_increment} }
+      keys %$columns_info
   ;
 
   if (($op eq 'insert' && $bound_identity_col) ||
@@ -341,7 +333,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);
@@ -358,8 +350,11 @@ sub insert {
   my $self = shift;
   my ($source, $to_insert) = @_;
 
+  my $columns_info = $source->columns_info;
+
   my $identity_col =
-    (first { $source->column_info($_)->{is_auto_increment} } $source->columns)
+    (first { $columns_info->{$_}{is_auto_increment} }
+      keys %$columns_info )
     || '';
 
   # check for empty insert
@@ -437,14 +432,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 $columns_info = $source->columns_info;
+
   my $identity_col =
-    first { $source->column_info($_)->{is_auto_increment} } $source->columns;
+    first { $columns_info->{$_}{is_auto_increment} }
+      keys %$columns_info;
 
   my $is_identity_update = $identity_col && defined $fields->{$identity_col};
 
@@ -473,10 +469,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 {
@@ -486,15 +482,18 @@ 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 $columns_info = $source->columns_info;
+
   my $identity_col =
-    first { $source->column_info($_)->{is_auto_increment} } $source->columns;
+    first { $columns_info->{$_}{is_auto_increment} }
+      keys %$columns_info;
 
   my $is_identity_insert = (first { $_ eq $identity_col } @{$cols}) ? 1 : 0;
 
@@ -635,10 +634,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 {
@@ -654,15 +650,12 @@ EOF
   DBD::Sybase::set_cslib_cb($orig_cslib_cb);
 
   if ($exception =~ /-Y option/) {
-    carp <<"EOF";
+    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;
 
-Sybase bulk API operation failed due to character set incompatibility, reverting
-to regular array inserts:
-
-*** Try unsetting the LANG environment variable.
-
-$exception
-EOF
     $self->_bulk_storage(undef);
     unshift @_, $self;
     goto \&insert_bulk;
@@ -871,29 +864,24 @@ 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.
@@ -1160,7 +1148,7 @@ Real limits and limited counts using stored procedures deployed on startup.
 
 =item *
 
-Adaptive Server Anywhere (ASA) support, with possible SQLA::Limit support.
+Adaptive Server Anywhere (ASA) support
 
 =item *
 
@@ -1174,7 +1162,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