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=16d204d5792cb745dc3919cd8e8841c7bbdc3967;hpb=fd323bf1046faa7de5a8c985268d80ec5b703361;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 16d204d..0e57f02 100644 --- a/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm +++ b/lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm @@ -8,14 +8,18 @@ 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 _bulk_storage _is_bulk_storage _began_bulk_work @@ -83,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 { @@ -102,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); } } @@ -231,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) = @_; @@ -245,23 +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 = 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) || @@ -332,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); @@ -349,9 +350,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 @@ -428,15 +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 $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}; @@ -465,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 { @@ -478,21 +482,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; @@ -598,7 +601,7 @@ EOF return 0; }); - my $exception; + my $exception = ''; try { my $bulk = $self->_bulk_storage; @@ -631,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 { @@ -650,15 +650,12 @@ EOF 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; @@ -789,7 +786,7 @@ sub _insert_blobs { if (not $sth) { $self->throw_exception( "Could not find row in table '$table' for blob update:\n" - . Data::Dumper::Concise::Dumper (\%where) + . (Dumper \%where) ); } @@ -867,29 +864,24 @@ C 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. @@ -1156,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 * @@ -1170,7 +1162,7 @@ bulk_insert using prepare_cached (see comments.) =head1 AUTHOR -See L. +See L and L. =head1 LICENSE