X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FSybase.pm;h=eeb4f01edf2a3806495f10925641a7d166d036b6;hb=6862815907d42aa2f5fcc70afd4ff2dbc9b48f79;hp=792252f4a17bc7d6e3ef9342be121d61f2ef7fe4;hpb=c080561b566a9d8764ef64b3b7d61c130139d9b9;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/Sybase.pm b/lib/DBIx/Class/Storage/DBI/Sybase.pm index 792252f..eeb4f01 100644 --- a/lib/DBIx/Class/Storage/DBI/Sybase.pm +++ b/lib/DBIx/Class/Storage/DBI/Sybase.pm @@ -9,17 +9,21 @@ use base qw/ /; use mro 'c3'; use Carp::Clan qw/^DBIx::Class/; -use List::Util (); -use Sub::Name (); +use List::Util(); +use Sub::Name(); +use Data::Dumper::Concise(); __PACKAGE__->mk_group_accessors('simple' => qw/_identity _blob_log_on_update _writer_storage _is_extra_storage - _bulk_storage _is_bulk_storage _began_bulk_work + _bulk_storage _is_bulk_storage _began_bulk_work _bulk_disabled_due_to_coderef_connect_info_warned _identity_method/ ); my @also_proxy_to_extra_storages = qw/ + connect_call_set_auto_cast auto_cast connect_call_blob_setup + connect_call_datetime_setup + disconnect _connect_info _sql_maker _sql_maker_opts disable_sth_caching auto_savepoint unsafe cursor_class debug debugobj schema /; @@ -126,6 +130,7 @@ sub _init { $writer_storage->_is_extra_storage(1); $writer_storage->connect_info($self->connect_info); + $writer_storage->auto_cast($self->auto_cast); $self->_writer_storage($writer_storage); @@ -141,7 +146,7 @@ sub _init { # this is why $bulk_storage->_dbi_connect_info->[0] .= ';bulkLogin=1'; - + $self->_bulk_storage($bulk_storage); } @@ -237,47 +242,59 @@ sub _is_lob_type { $type && $type =~ /(?:text|image|lob|bytea|binary|memo)/i; } +sub _is_lob_column { + my ($self, $source, $column) = @_; + + return $self->_is_lob_type($source->column_info($column)->{data_type}); +} + sub _prep_for_execute { my $self = shift; my ($op, $extra_bind, $ident, $args) = @_; my ($sql, $bind) = $self->next::method (@_); - if ($op eq 'insert') { - my $table = $ident->from; + my $table = Scalar::Util::blessed($ident) ? $ident->from : $ident; - my $bind_info = $self->_resolve_column_info( - $ident, [map $_->[0], @{$bind}] + 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 $identity_col = Scalar::Util::blessed($ident) && + List::Util::first + { $ident->column_info($_)->{is_auto_increment} } + $ident->columns + ; + + if (($op eq 'insert' && $bound_identity_col) || + ($op eq 'update' && exists $args->[0]{$identity_col})) { + $sql = join ("\n", + $self->_set_table_identity_sql($op => $table, 'on'), + $sql, + $self->_set_table_identity_sql($op => $table, 'off'), ); - my $identity_col = List::Util::first - { $bind_info->{$_}{is_auto_increment} } - (keys %$bind_info) - ; - - if ($identity_col) { - $sql = join ("\n", - "SET IDENTITY_INSERT $table ON", - $sql, - "SET IDENTITY_INSERT $table OFF", - ); - } - else { - $identity_col = List::Util::first - { $ident->column_info($_)->{is_auto_increment} } - $ident->columns - ; - } + } - if ($identity_col) { - $sql = - "$sql\n" . - $self->_fetch_identity_sql($ident, $identity_col); - } + if ($op eq 'insert' && (not $bound_identity_col) && $identity_col && + (not $self->{insert_bulk})) { + $sql = + "$sql\n" . + $self->_fetch_identity_sql($ident, $identity_col); } return ($sql, $bind); } +sub _set_table_identity_sql { + my ($self, $op, $table, $on_off) = @_; + + return sprintf 'SET IDENTITY_%s %s %s', + uc($op), $self->sql_maker->_quote($table), uc($on_off); +} + # Stolen from SQLT, with some modifications. This is a makeshift # solution before a sane type-mapping library is available, thus # the 'our' for easy overrides. @@ -337,11 +354,21 @@ sub insert { my $self = shift; my ($source, $to_insert) = @_; - my $blob_cols = $self->_remove_blob_cols($source, $to_insert); - - my $identity_col = List::Util::first + my $identity_col = (List::Util::first { $source->column_info($_)->{is_auto_increment} } - $source->columns; + $source->columns) || ''; + + # check for empty insert + # INSERT INTO foo DEFAULT VALUES -- does not work with Sybase + # try to insert explicit 'DEFAULT's instead (except for identity) + if (not %$to_insert) { + for my $col ($source->columns) { + next if $col eq $identity_col; + $to_insert->{$col} = \'DEFAULT'; + } + } + + my $blob_cols = $self->_remove_blob_cols($source, $to_insert); # do we need the horrific SELECT MAX(COL) hack? my $dumb_last_insert_id = @@ -382,7 +409,8 @@ sub _insert { my $updated_cols = $self->$next ($source, $to_insert); my $final_row = { - $identity_col => $self->last_insert_id($source, $identity_col), + ($identity_col ? + ($identity_col => $self->last_insert_id($source, $identity_col)) : ()), %$to_insert, %$updated_cols, }; @@ -394,106 +422,130 @@ sub _insert { sub update { my $self = shift; - my ($source, $fields, $where) = @_; + my ($source, $fields, $where, @rest) = @_; my $wantarray = wantarray; + my $blob_cols = $self->_remove_blob_cols($source, $fields); - if (not $blob_cols) { - return $self->next::method(@_); - } + my $table = $source->name; -# update+blob update(s) done atomically on separate connection - $self = $self->_writer_storage; + my $identity_col = List::Util::first + { $source->column_info($_)->{is_auto_increment} } + $source->columns; - my $guard = $self->txn_scope_guard; + my $is_identity_update = $identity_col && defined $fields->{$identity_col}; - my @res; - if ($wantarray) { - @res = $self->next::method(@_); - } - elsif (defined $wantarray) { - $res[0] = $self->next::method(@_); - } - else { - $self->next::method(@_); - } + return $self->next::method(@_) unless $blob_cols; - $self->_update_blobs($source, $blob_cols, $where); +# If there are any blobs in $where, Sybase will return a descriptive error +# message. +# XXX blobs can still be used with a LIKE query, and this should be handled. - $guard->commit; +# update+blob update(s) done atomically on separate connection + $self = $self->_writer_storage; - return $wantarray ? @res : $res[0]; -} + my $guard = $self->txn_scope_guard; -### the insert_bulk partially stolen from DBI/MSSQL.pm +# First update the blob columns to be updated to '' (taken from $fields, where +# it is originally put by _remove_blob_cols .) + my %blobs_to_empty = map { ($_ => delete $fields->{$_}) } keys %$blob_cols; -sub _set_identity_insert { - my ($self, $table) = @_; +# We can't only update NULL blobs, because blobs cannot be in the WHERE clause. - my $sql = sprintf ( - 'SET IDENTITY_INSERT %s ON', - $self->sql_maker->_quote ($table), - ); + $self->next::method($source, \%blobs_to_empty, $where, @rest); - my $dbh = $self->_get_dbh; - eval { $dbh->do ($sql) }; - if ($@) { - $self->throw_exception (sprintf "Error executing '%s': %s", - $sql, - $dbh->errstr, - ); - } -} +# Now update the blobs before the other columns in case the update of other +# columns makes the search condition invalid. + $self->_update_blobs($source, $blob_cols, $where); -sub _unset_identity_insert { - my ($self, $table) = @_; + my @res; + if (%$fields) { + if ($wantarray) { + @res = $self->next::method(@_); + } + elsif (defined $wantarray) { + $res[0] = $self->next::method(@_); + } + else { + $self->next::method(@_); + } + } - my $sql = sprintf ( - 'SET IDENTITY_INSERT %s OFF', - $self->sql_maker->_quote ($table), - ); + $guard->commit; - my $dbh = $self->_get_dbh; - $dbh->do ($sql); + return $wantarray ? @res : $res[0]; } -## XXX add blob support 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 $is_identity_insert = (List::Util::first - { $source->column_info ($_)->{is_auto_increment} } @{$cols} + { $_ eq $identity_col } + @{$cols} ) ? 1 : 0; my @source_columns = $source->columns; my $use_bulk_api = - $self->_bulk_storage && + $self->_bulk_storage && $self->_get_dbh->{syb_has_blk}; if ((not $use_bulk_api) && (Scalar::Util::reftype($self->_dbi_connect_info->[0])||'') eq 'CODE' && - $self->_bulk_disabled_due_to_coderef_connect_info_warned) { + (not $self->_bulk_disabled_due_to_coderef_connect_info_warned)) { carp <<'EOF'; Bulk API support disabled due to use of a CODEREF connect_info. Reverting to -array inserts. +regular array inserts. EOF $self->_bulk_disabled_due_to_coderef_connect_info_warned(1); } if (not $use_bulk_api) { - if ($is_identity_insert) { - $self->_set_identity_insert ($source->name); - } + my $blob_cols = $self->_remove_blob_cols_array($source, $cols, $data); + +# _execute_array uses a txn anyway, but it ends too early in case we need to +# select max(col) to get the identity for inserting blobs. + ($self, my $guard) = $self->{transaction_depth} == 0 ? + ($self->_writer_storage, $self->_writer_storage->txn_scope_guard) + : + ($self, undef); + + local $self->{insert_bulk} = 1; $self->next::method(@_); - if ($is_identity_insert) { - $self->_unset_identity_insert ($source->name); + if ($blob_cols) { + if ($is_identity_insert) { + $self->_insert_blobs_array ($source, $blob_cols, $cols, $data); + } + else { + my @cols_with_identities = (@$cols, $identity_col); + + ## calculate identities + # XXX This assumes identities always increase by 1, which may or may not + # be true. + my ($last_identity) = + $self->_dbh->selectrow_array ( + $self->_fetch_identity_sql($source, $identity_col) + ); + my @identities = (($last_identity - @$data + 1) .. $last_identity); + + my @data_with_identities = map [@$_, shift @identities], @$data; + + $self->_insert_blobs_array ( + $source, $blob_cols, \@cols_with_identities, \@data_with_identities + ); + } } + $guard->commit if $guard; + return; } @@ -518,9 +570,6 @@ EOF push @new_data, $new_datum; } - my $identity_col = List::Util::first - { $source->column_info($_)->{is_auto_increment} } @source_columns; - # bcp identity index is 1-based my $identity_idx = exists $new_idx{$identity_col} ? $new_idx{$identity_col} + 1 : 0; @@ -534,12 +583,12 @@ EOF return 1 if $errno == 36; - carp + carp "Layer: $layer, Origin: $origin, Severity: $severity, Error: $errno" . ($errmsg ? "\n$errmsg" : '') . ($osmsg ? "\n$osmsg" : '') . ($blkmsg ? "\n$blkmsg" : ''); - + return 0; }); @@ -553,7 +602,7 @@ EOF # $bulk->next::method($source, \@source_columns, \@new_data, { # syb_bcp_attribs => { # identity_flag => $is_identity_insert, -# identity_column => $identity_idx, +# identity_column => $identity_idx, # } # }); my $sql = 'INSERT INTO ' . @@ -570,24 +619,28 @@ EOF { syb_bcp_attribs => { identity_flag => $is_identity_insert, - identity_column => $identity_idx, + identity_column => $identity_idx, } } ); - $bulk->_query_start($sql); - - for my $datum (@new_data) { - $sth->execute(@$datum); - die $sth->errstr if $sth->errstr; # just in case - } + my @bind = do { + my $idx = 0; + map [ $_, $idx++ ], @source_columns; + }; - $guard->commit; - $sth->finish; + $self->_execute_array( + $source, $sth, \@bind, \@source_columns, \@new_data, sub { + $guard->commit + } + ); $bulk->_query_end($sql); }; + my $exception = $@; + DBD::Sybase::set_cslib_cb($orig_cslib_cb); + if ($exception =~ /-Y option/) { carp <<"EOF"; @@ -596,36 +649,76 @@ to regular array inserts: *** Try unsetting the LANG environment variable. -$@ +$exception EOF $self->_bulk_storage(undef); - DBD::Sybase::set_cslib_cb($orig_cslib_cb); unshift @_, $self; goto \&insert_bulk; } elsif ($exception) { - DBD::Sybase::set_cslib_cb($orig_cslib_cb); # rollback makes the bulkLogin connection unusable $self->_bulk_storage->disconnect; - $self->throw_exception($exception) if $exception; + $self->throw_exception($exception); } +} - DBD::Sybase::set_cslib_cb($orig_cslib_cb); +sub _dbh_execute_array { + my ($self, $sth, $tuple_status, $cb) = @_; + + my $rv = $self->next::method($sth, $tuple_status); + $cb->() if $cb; + + return $rv; } +# Make sure blobs are not bound as placeholders, and return any non-empty ones +# as a hash. sub _remove_blob_cols { my ($self, $source, $fields) = @_; my %blob_cols; for my $col (keys %$fields) { - if ($self->_is_lob_type($source->column_info($col)->{data_type})) { - $blob_cols{$col} = delete $fields->{$col}; - $fields->{$col} = \"''"; + if ($self->_is_lob_column($source, $col)) { + my $blob_val = delete $fields->{$col}; + if (not defined $blob_val) { + $fields->{$col} = \'NULL'; + } + else { + $fields->{$col} = \"''"; + $blob_cols{$col} = $blob_val unless $blob_val eq ''; + } } } - return keys %blob_cols ? \%blob_cols : undef; + return %blob_cols ? \%blob_cols : undef; +} + +# same for insert_bulk +sub _remove_blob_cols_array { + my ($self, $source, $cols, $data) = @_; + + my @blob_cols; + + for my $i (0..$#$cols) { + my $col = $cols->[$i]; + + if ($self->_is_lob_column($source, $col)) { + for my $j (0..$#$data) { + my $blob_val = delete $data->[$j][$i]; + if (not defined $blob_val) { + $data->[$j][$i] = \'NULL'; + } + else { + $data->[$j][$i] = \"''"; + $blob_cols[$j][$i] = $blob_val + unless $blob_val eq ''; + } + } + } + } + + return @blob_cols ? \@blob_cols : undef; } sub _update_blobs { @@ -633,7 +726,7 @@ sub _update_blobs { my (@primary_cols) = $source->primary_columns; - croak "Cannot update TEXT/IMAGE column(s) without a primary key" + $self->throw_exception('Cannot update TEXT/IMAGE column(s) without a primary key') unless @primary_cols; # check if we're updating a single row by PK @@ -663,17 +756,16 @@ sub _insert_blobs { my ($self, $source, $blob_cols, $row) = @_; my $dbh = $self->_get_dbh; - my $table = $source->from; + my $table = $source->name; my %row = %$row; my (@primary_cols) = $source->primary_columns; - croak "Cannot update TEXT/IMAGE column(s) without a primary key" + $self->throw_exception('Cannot update TEXT/IMAGE column(s) without a primary key') unless @primary_cols; - if ((grep { defined $row{$_} } @primary_cols) != @primary_cols) { - croak "Cannot update TEXT/IMAGE column(s) without primary key values"; - } + $self->throw_exception('Cannot update TEXT/IMAGE column(s) without primary key values') + if ((grep { defined $row{$_} } @primary_cols) != @primary_cols); for my $col (keys %$blob_cols) { my $blob = $blob_cols->{$col}; @@ -684,6 +776,14 @@ sub _insert_blobs { $cursor->next; 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) + ); + } + eval { do { $sth->func('CS_GET', 1, 'ct_data_info') or die $sth->errstr; @@ -707,17 +807,37 @@ sub _insert_blobs { $sth->finish if $sth; if ($exception) { if ($self->using_freetds) { - croak ( + $self->throw_exception ( 'TEXT/IMAGE operation failed, probably because you are using FreeTDS: ' . $exception ); } else { - croak $exception; + $self->throw_exception($exception); } } } } +sub _insert_blobs_array { + my ($self, $source, $blob_cols, $cols, $data) = @_; + + for my $i (0..$#$data) { + my $datum = $data->[$i]; + + my %row; + @row{ @$cols } = @$datum; + + my %blob_vals; + for my $j (0..$#$cols) { + if (exists $blob_cols->[$i][$j]) { + $blob_vals{ $cols->[$j] } = $blob_cols->[$i][$j]; + } + } + + $self->_insert_blobs ($source, \%blob_vals, \%row); + } +} + =head2 connect_call_datetime_setup Used as: @@ -742,7 +862,7 @@ C columns only have minute precision. sub connect_call_datetime_setup { my $self = shift; - my $dbh = $self->_dbh; + my $dbh = $self->_get_dbh; if ($dbh->can('syb_date_fmt')) { # amazingly, this works with FreeTDS @@ -879,10 +999,10 @@ session variable. =head1 TRANSACTIONS Due to limitations of the TDS protocol, L, or both; you cannot -begin a transaction while there are active cursors. An active cursor is, for -example, a L that has been executed using -C or C but has not been exhausted or -L. +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 that has been executed using C or +C but has not been exhausted or L. For example, this will not work: @@ -896,6 +1016,11 @@ For example, this will not work: } }); +This won't either: + + my $first_row = $large_rs->first; + $schema->txn_do(sub { ... }); + Transactions done for inserts in C mode when placeholders are in use are not affected, as they are done on an extra database handle. @@ -970,6 +1095,36 @@ calls in your C classes B list columns in database order for this to work. Also, you may have to unset the C environment variable before loading your app, if it doesn't match the character set of your database. +When inserting IMAGE columns using this method, you'll need to use +L as well. + +=head1 TODO + +=over + +=item * + +Transitions to AutoCommit=0 (starting a transaction) mode by exhausting +any active cursors, using eager cursors. + +=item * + +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 * + +bulk_insert using prepare_cached (see comments.) + +=back + =head1 AUTHOR See L.