From: Rafael Kitover Date: Sun, 18 Oct 2009 09:13:29 +0000 (+0000) Subject: Merge 'sybase_support' into 'trunk' X-Git-Tag: v0.08113~32 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=25be6a7ef8a802690a388ab504554a444d1e497f;hp=746c315f6356bbe180b8bc738d85738f822687dd;p=dbsrgits%2FDBIx-Class.git Merge 'sybase_support' into 'trunk' r20728@hlagh (orig r7703): ribasushi | 2009-09-20 18:51:16 -0400 Another try at a clean sybase branch r20730@hlagh (orig r7705): ribasushi | 2009-09-20 18:58:09 -0400 Part one of the sybase work by Caelum (mostly reviewed) r20731@hlagh (orig r7706): ribasushi | 2009-09-20 19:18:40 -0400 main sybase branch ready r21051@hlagh (orig r7797): caelum | 2009-10-18 04:57:43 -0400 r20732@hlagh (orig r7707): ribasushi | 2009-09-20 19:20:00 -0400 Branch for bulk insert r20733@hlagh (orig r7708): ribasushi | 2009-09-20 20:06:21 -0400 All sybase bulk-insert code by Caelum r20750@hlagh (orig r7725): caelum | 2009-09-24 02:47:39 -0400 clean up set_identity stuff r20751@hlagh (orig r7726): caelum | 2009-09-24 05:21:18 -0400 minor cleanups, test update of blob to NULL r20752@hlagh (orig r7727): caelum | 2009-09-24 08:45:04 -0400 remove some duplicate code r20753@hlagh (orig r7728): caelum | 2009-09-24 09:57:58 -0400 fix insert with all defaults r20786@hlagh (orig r7732): caelum | 2009-09-25 21:17:16 -0400 some cleanups r20804@hlagh (orig r7736): caelum | 2009-09-28 05:31:38 -0400 minor changes r20805@hlagh (orig r7737): caelum | 2009-09-28 06:25:48 -0400 fix DT stuff r20809@hlagh (orig r7741): caelum | 2009-09-28 22:25:55 -0400 removed some dead code, added fix and test for _execute_array_empty r20811@hlagh (orig r7743): caelum | 2009-09-29 13:36:20 -0400 minor changes after review r20812@hlagh (orig r7744): caelum | 2009-09-29 14:16:03 -0400 do not clobber $rv from execute_array r20813@hlagh (orig r7745): caelum | 2009-09-29 14:38:14 -0400 make insert_bulk atomic r20815@hlagh (orig r7747): caelum | 2009-09-29 20:35:26 -0400 remove _exhaaust_statements r20816@hlagh (orig r7748): caelum | 2009-09-29 21:48:38 -0400 fix insert_bulk when not using bulk api inside a txn r20831@hlagh (orig r7749): caelum | 2009-09-30 02:53:42 -0400 added test for populate being atomic r20832@hlagh (orig r7750): caelum | 2009-09-30 03:00:59 -0400 factor out subclass-specific _execute_array callback r20833@hlagh (orig r7751): caelum | 2009-10-01 11:59:30 -0400 remove a piece of dead code r20840@hlagh (orig r7758): caelum | 2009-10-03 15:46:56 -0400 remove _pretty_print r20842@hlagh (orig r7760): caelum | 2009-10-04 16:19:56 -0400 minor optimization for insert_bulk r21050@hlagh (orig r7796): caelum | 2009-10-18 04:56:54 -0400 error checking related to literal SQL for insert_bulk --- diff --git a/Changes b/Changes index f39901e..c0a3163 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,18 @@ Revision history for DBIx::Class + + - Complete Sybase RDBMS support including: + - Support for TEXT/IMAGE columns + - Support for the 'money' datatype + - Transaction savepoints support + - DateTime inflation support + - Support for bind variables when connecting to a newer Sybase with + OpenClient libraries + - Support for connections via FreeTDS with CASTs for bind variables + when needed + - Support for interpolated variables with proper quoting when + connecting to an older Sybase and/or via FreeTDS + - bulk API support for populate() - Add is_paged method to DBIx::Class::ResultSet so that we can check that if we want a pager - Skip versioning test on really old perls lacking Time::HiRes diff --git a/Makefile.PL b/Makefile.PL index e3885d2..3d1462b 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -45,6 +45,7 @@ requires 'Scope::Guard' => '0.03'; requires 'SQL::Abstract' => '1.60'; requires 'SQL::Abstract::Limit' => '0.13'; requires 'Sub::Name' => '0.04'; +requires 'Data::Dumper::Concise' => '1.000'; my %replication_requires = ( 'Moose', => '0.87', @@ -114,6 +115,12 @@ my %force_requires_if_author = ( 'DateTime::Format::Oracle' => '0', ) : () , + + $ENV{DBICTEST_SYBASE_DSN} + ? ( + 'DateTime::Format::Sybase' => 0, + ) : () + , ); #************************************************************************# # Make ABSOLUTELY SURE that nothing on the list above is a real require, # @@ -135,7 +142,7 @@ resources 'license' => 'http://dev.perl.org/licenses/'; resources 'repository' => 'http://dev.catalyst.perl.org/svnweb/bast/browse/DBIx-Class/'; resources 'MailingList' => 'http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/dbix-class'; -no_index 'DBIx::Class::Storage::DBI::Sybase::Base'; +no_index 'DBIx::Class::Storage::DBI::Sybase::Common'; no_index 'DBIx::Class::SQLAHacks'; no_index 'DBIx::Class::SQLAHacks::MSSQL'; no_index 'DBIx::Class::Storage::DBI::AmbiguousGlob'; diff --git a/lib/DBIx/Class/ResultSet.pm b/lib/DBIx/Class/ResultSet.pm index e0e1686..31bc5b4 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -1796,7 +1796,10 @@ sub populate { } else { my ($first, @rest) = @$data; - my @names = grep {!ref $first->{$_}} keys %$first; + my @names = grep { + (not ref $first->{$_}) || (ref $first->{$_} eq 'SCALAR') + } keys %$first; + my @rels = grep { $self->result_source->has_relationship($_) } keys %$first; my @pks = $self->result_source->primary_columns; diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index fdff258..5a6d4d7 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -13,6 +13,7 @@ use DBIx::Class::Storage::DBI::Cursor; use DBIx::Class::Storage::Statistics; use Scalar::Util(); use List::Util(); +use Data::Dumper::Concise(); # what version of sqlt do we require if deploy() without a ddl_dir is invoked # when changing also adjust the corresponding author_require in Makefile.PL @@ -1344,14 +1345,96 @@ sub insert_bulk { } my %colvalues; - my $table = $source->from; @colvalues{@$cols} = (0..$#$cols); - my ($sql, @bind) = $self->sql_maker->insert($table, \%colvalues); + + for my $i (0..$#$cols) { + my $first_val = $data->[0][$i]; + next unless ref $first_val eq 'SCALAR'; + + $colvalues{ $cols->[$i] } = $first_val; +## This is probably unnecessary since $rs->populate only looks at the first +## slice anyway. +# if (grep { +# ref $_ eq 'SCALAR' && $$_ eq $$first_val +# } map $data->[$_][$i], (1..$#$data)) == (@$data - 1); + } + + # check for bad data + my $bad_slice = sub { + my ($msg, $slice_idx) = @_; + $self->throw_exception(sprintf "%s for populate slice:\n%s", + $msg, + Data::Dumper::Concise::Dumper({ + map { $cols->[$_] => $data->[$slice_idx][$_] } (0 .. $#$cols) + }), + ); + }; + + for my $datum_idx (0..$#$data) { + my $datum = $data->[$datum_idx]; + + for my $col_idx (0..$#$cols) { + my $val = $datum->[$col_idx]; + my $sqla_bind = $colvalues{ $cols->[$col_idx] }; + my $is_literal_sql = (ref $sqla_bind) eq 'SCALAR'; + + if ($is_literal_sql) { + if (not ref $val) { + $bad_slice->('bind found where literal SQL expected', $datum_idx); + } + elsif ((my $reftype = ref $val) ne 'SCALAR') { + $bad_slice->("$reftype reference found where literal SQL expected", + $datum_idx); + } + elsif ($$val ne $$sqla_bind){ + $bad_slice->("inconsistent literal SQL value, expecting: '$$sqla_bind'", + $datum_idx); + } + } + elsif (my $reftype = ref $val) { + $bad_slice->("$reftype reference found where bind expected", + $datum_idx); + } + } + } + + my ($sql, $bind) = $self->_prep_for_execute ( + 'insert', undef, $source, [\%colvalues] + ); + my @bind = @$bind; + + my $empty_bind = 1 if (not @bind) && + (grep { ref $_ eq 'SCALAR' } values %colvalues) == @$cols; + + if ((not @bind) && (not $empty_bind)) { + $self->throw_exception( + 'Cannot insert_bulk without support for placeholders' + ); + } $self->_query_start( $sql, @bind ); my $sth = $self->sth($sql); -# @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args + my $rv = do { + if ($empty_bind) { + # bind_param_array doesn't work if there are no binds + $self->_dbh_execute_inserts_with_no_binds( $sth, scalar @$data ); + } + else { +# @bind = map { ref $_ ? ''.$_ : $_ } @bind; # stringify args + $self->_execute_array( $source, $sth, \@bind, $cols, $data ); + } + }; + + $self->_query_end( $sql, @bind ); + + return (wantarray ? ($rv, $sth, @bind) : $rv); +} + +sub _execute_array { + my ($self, $source, $sth, $bind, $cols, $data, @extra) = @_; + + my $guard = $self->txn_scope_guard unless $self->{transaction_depth} != 0; ## This must be an arrayref, else nothing works! my $tuple_status = []; @@ -1362,7 +1445,7 @@ sub insert_bulk { ## Bind the values and execute my $placeholder_index = 1; - foreach my $bound (@bind) { + foreach my $bound (@$bind) { my $attributes = {}; my ($column_name, $data_index) = @$bound; @@ -1377,32 +1460,65 @@ sub insert_bulk { $sth->bind_param_array( $placeholder_index, [@data], $attributes ); $placeholder_index++; } - my $rv = eval { $sth->execute_array({ArrayTupleStatus => $tuple_status}) }; - if (my $err = $@) { + + my $rv = eval { + $self->_dbh_execute_array($sth, $tuple_status, @extra); + }; + my $err = $@ || $sth->errstr; + +# Statement must finish even if there was an exception. + eval { $sth->finish }; + $err = $@ unless $err; + + if ($err) { my $i = 0; ++$i while $i <= $#$tuple_status && !ref $tuple_status->[$i]; - $self->throw_exception($sth->errstr || "Unexpected populate error: $err") + $self->throw_exception("Unexpected populate error: $err") if ($i > $#$tuple_status); - require Data::Dumper; - local $Data::Dumper::Terse = 1; - local $Data::Dumper::Indent = 1; - local $Data::Dumper::Useqq = 1; - local $Data::Dumper::Quotekeys = 0; - local $Data::Dumper::Sortkeys = 1; - $self->throw_exception(sprintf "%s for populate slice:\n%s", - $tuple_status->[$i][1], - Data::Dumper::Dumper( - { map { $cols->[$_] => $data->[$i][$_] } (0 .. $#$cols) } - ), + ($tuple_status->[$i][1] || $err), + Data::Dumper::Concise::Dumper({ + map { $cols->[$_] => $data->[$i][$_] } (0 .. $#$cols) + }), ); } - $self->throw_exception($sth->errstr) if !$rv; - $self->_query_end( $sql, @bind ); - return (wantarray ? ($rv, $sth, @bind) : $rv); + $guard->commit if $guard; + + return $rv; +} + +sub _dbh_execute_array { + my ($self, $sth, $tuple_status, @extra) = @_; + + return $sth->execute_array({ArrayTupleStatus => $tuple_status}); +} + +sub _dbh_execute_inserts_with_no_binds { + my ($self, $sth, $count) = @_; + + my $guard = $self->txn_scope_guard unless $self->{transaction_depth} != 0; + + eval { + my $dbh = $self->_get_dbh; + local $dbh->{RaiseError} = 1; + local $dbh->{PrintError} = 0; + + $sth->execute foreach 1..$count; + }; + my $exception = $@; + +# Make sure statement is finished even if there was an exception. + eval { $sth->finish }; + $exception = $@ unless $exception; + + $self->throw_exception($exception) if $exception; + + $guard->commit if $guard; + + return $count; } sub update { @@ -1993,7 +2109,6 @@ sub _subq_count_select { return @pcols ? \@pcols : [ 1 ]; } - sub source_bind_attributes { my ($self, $source) = @_; diff --git a/lib/DBIx/Class/Storage/DBI/AutoCast.pm b/lib/DBIx/Class/Storage/DBI/AutoCast.pm index c3b154b..c887a86 100644 --- a/lib/DBIx/Class/Storage/DBI/AutoCast.pm +++ b/lib/DBIx/Class/Storage/DBI/AutoCast.pm @@ -29,6 +29,10 @@ converted to: CAST(? as $mapped_type) +This option can also be enabled in L as: + + on_connect_call => ['set_auto_cast'] + =cut sub _prep_for_execute { @@ -60,6 +64,26 @@ sub _prep_for_execute { return ($sql, $bind); } +=head2 connect_call_set_auto_cast + +Executes: + + $schema->storage->auto_cast(1); + +on connection. + +Used as: + + on_connect_call => ['set_auto_cast'] + +in L. + +=cut + +sub connect_call_set_auto_cast { + my $self = shift; + $self->auto_cast(1); +} =head1 AUTHOR diff --git a/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm b/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm index bf01131..d0a0133 100644 --- a/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm +++ b/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm @@ -61,7 +61,7 @@ sub connect_call_use_dynamic_cursors { my $self = shift; if (ref($self->_dbi_connect_info->[0]) eq 'CODE') { - $self->throw_exception ('cannot set DBI attributes on a CODE ref connect_info'); + $self->throw_exception ('Cannot set DBI attributes on a CODE ref connect_info'); } my $dbi_attrs = $self->_dbi_connect_info->[-1]; diff --git a/lib/DBIx/Class/Storage/DBI/Sybase.pm b/lib/DBIx/Class/Storage/DBI/Sybase.pm index 41b0c81..eeb4f01 100644 --- a/lib/DBIx/Class/Storage/DBI/Sybase.pm +++ b/lib/DBIx/Class/Storage/DBI/Sybase.pm @@ -4,63 +4,1134 @@ use strict; use warnings; use base qw/ - DBIx::Class::Storage::DBI::Sybase::Base - DBIx::Class::Storage::DBI::NoBindVars + DBIx::Class::Storage::DBI::Sybase::Common + DBIx::Class::Storage::DBI::AutoCast /; use mro 'c3'; +use Carp::Clan qw/^DBIx::Class/; +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_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 +/; + +=head1 NAME + +DBIx::Class::Storage::DBI::Sybase - Sybase support for DBIx::Class + +=head1 SYNOPSIS + +This subclass supports L for real Sybase databases. If you are +using an MSSQL database via L, your storage will be reblessed to +L. + +=head1 DESCRIPTION + +If your version of Sybase does not support placeholders, then your storage +will be reblessed to L. You can +also enable that driver explicitly, see the documentation for more details. + +With this driver there is unfortunately no way to get the C +without doing a C, which is the only way to get the C value in this +mode. + +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 transactions are +disabled, as there are no concurrency issues with C will work +for obtainging the last insert id of an C column, instead of having to +do C