X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FSybase%2FASE.pm;h=dbbee6f081ecdaf00163ae0d8ffe41e8ac9cca15;hb=52416317a26986602098ffe2ea6aa64a05925b6f;hp=0a0295f977e75f5e28a8320f10c71cc57197a0cc;hpb=ed7ab0f4ce1a9118ea6285ee562ef003085a6b64;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 0a0295f..dbbee6f 100644 --- a/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm +++ b/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm @@ -9,11 +9,14 @@ use base qw/ /; use mro 'c3'; use Carp::Clan qw/^DBIx::Class/; -use Scalar::Util(); -use List::Util(); +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__->mk_group_accessors('simple' => qw/_identity _blob_log_on_update _writer_storage _is_extra_storage @@ -82,8 +85,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 { @@ -101,7 +104,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); } } @@ -248,19 +251,18 @@ sub _prep_for_execute { 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}] ); - 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 $identity_col = + blessed $ident && + first { $_->{is_auto_increment} } values %{ $ident->columns_info } ; if (($op eq 'insert' && $bound_identity_col) || @@ -348,9 +350,9 @@ sub insert { my $self = shift; my ($source, $to_insert) = @_; - my $identity_col = (List::Util::first - { $source->column_info($_)->{is_auto_increment} } - $source->columns) || ''; + my $identity_col = + (first { $_->{is_auto_increment} } values %{ $source->columns_info } ) + || ''; # check for empty insert # INSERT INTO foo DEFAULT VALUES -- does not work with Sybase @@ -433,9 +435,8 @@ sub update { my $table = $source->name; - my $identity_col = List::Util::first - { $source->column_info($_)->{is_auto_increment} } - $source->columns; + my $identity_col = + first { $_->{is_auto_increment} } values %{ $source->columns_info }; my $is_identity_update = $identity_col && defined $fields->{$identity_col}; @@ -484,14 +485,10 @@ 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 $identity_col = + first { $_->{is_auto_increment} } values %{ $source->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; @@ -597,7 +594,7 @@ EOF return 0; }); - my $exception; + my $exception = ''; try { my $bulk = $self->_bulk_storage; @@ -731,9 +728,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; @@ -765,9 +764,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); @@ -782,14 +783,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; @@ -807,19 +807,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; + }; } } @@ -1151,7 +1152,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 *