From: Peter Rabbitson Date: Fri, 18 Sep 2009 10:36:42 +0000 (+0000) Subject: Merge 'sybase' into 'trunk' X-Git-Tag: v0.08112~14 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=84f97107323065f3be493552cd70ae9d976a4f80;hp=8a3fa4ae894b55795bcea24a643b42d779cc9d13;p=dbsrgits%2FDBIx-Class.git Merge 'sybase' into 'trunk' --- diff --git a/Changes b/Changes index ce6d3e5..08f0334 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,16 @@ 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 - Remove the recommends from Makefile.PL, DBIx::Class is not supposed to have optional dependencies. ever. - Mangle the DBIx/Class.pm POD to be more clear about @@ -56,7 +67,7 @@ Revision history for DBIx::Class - Support for MSSQL 'money' type - Support for 'smalldatetime' type used in MSSQL and Sybase for InflateColumn::DateTime - - support for Postgres 'timestamp without timezone' type in + - Support for Postgres 'timestamp without timezone' type in InflateColumn::DateTime (RT#48389) - Added new MySQL specific on_connect_call macro 'set_strict_mode' (also known as make_mysql_not_suck_as_much) diff --git a/Makefile.PL b/Makefile.PL index 2c3a6d8..1b97a43 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -110,6 +110,12 @@ my %force_requires_if_author = ( 'DateTime::Format::Oracle' => '0', ) : () , + + $ENV{DBICTEST_SYBASE_DSN} + ? ( + 'DateTime::Format::Sybase' => 0, + ) : () + , ); @@ -126,7 +132,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 71fc173..f9a4c4a 100644 --- a/lib/DBIx/Class/ResultSet.pm +++ b/lib/DBIx/Class/ResultSet.pm @@ -2789,24 +2789,38 @@ sub _resolved_attrs { # build columns (as long as select isn't set) into a set of as/select hashes unless ( $attrs->{select} ) { - @colbits = map { - ( ref($_) eq 'HASH' ) - ? $_ - : { - ( - /^\Q${alias}.\E(.+)$/ - ? "$1" - : "$_" - ) - => - ( - /\./ - ? "$_" - : "${alias}.$_" - ) - } - } ( ref($attrs->{columns}) eq 'ARRAY' ) ? @{ delete $attrs->{columns}} : (delete $attrs->{columns} || $source->columns ); + + my @cols = ( ref($attrs->{columns}) eq 'ARRAY' ) + ? @{ delete $attrs->{columns}} + : ( + ( delete $attrs->{columns} ) + || + $source->storage->_order_select_columns( + $source, + [ $source->columns ], + ) + ) + ; + + @colbits = map { + ( ref($_) eq 'HASH' ) + ? $_ + : { + ( + /^\Q${alias}.\E(.+)$/ + ? "$1" + : "$_" + ) + => + ( + /\./ + ? "$_" + : "${alias}.$_" + ) + } + } @cols; } + # add the additional columns on foreach ( 'include_columns', '+columns' ) { push @colbits, map { diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 7ebea34..4990e78 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -681,7 +681,8 @@ sub disconnect { $self->_do_connection_actions(disconnect_call_ => $_) for @actions; - $self->_dbh->rollback unless $self->_dbh_autocommit; + $self->_dbh_rollback unless $self->_dbh_autocommit; + $self->_dbh->disconnect; $self->_dbh(undef); $self->{_dbh_gen}++; @@ -835,7 +836,9 @@ sub sql_maker { return $self->_sql_maker; } +# nothing to do by default sub _rebless {} +sub _init {} sub _populate_dbh { my ($self) = @_; @@ -902,6 +905,8 @@ sub _determine_driver { $self->_driver_determined(1); + $self->_init; # run driver-specific initializations + $self->_run_connection_actions if $started_unconnected && defined $self->_dbh; } @@ -1106,27 +1111,36 @@ sub txn_begin { if($self->{transaction_depth} == 0) { $self->debugobj->txn_begin() if $self->debug; - - # being here implies we have AutoCommit => 1 - # if the user is utilizing txn_do - good for - # him, otherwise we need to ensure that the - # $dbh is healthy on BEGIN - my $dbh_method = $self->{_in_dbh_do} ? '_dbh' : 'dbh'; - $self->$dbh_method->begin_work; - - } elsif ($self->auto_savepoint) { + $self->_dbh_begin_work; + } + elsif ($self->auto_savepoint) { $self->svp_begin; } $self->{transaction_depth}++; } +sub _dbh_begin_work { + my $self = shift; + + # if the user is utilizing txn_do - good for him, otherwise we need to + # ensure that the $dbh is healthy on BEGIN. + # We do this via ->dbh_do instead of ->dbh, so that the ->dbh "ping" + # will be replaced by a failure of begin_work itself (which will be + # then retried on reconnect) + if ($self->{_in_dbh_do}) { + $self->_dbh->begin_work; + } else { + $self->dbh_do(sub { $_[1]->begin_work }); + } +} + sub txn_commit { my $self = shift; if ($self->{transaction_depth} == 1) { my $dbh = $self->_dbh; $self->debugobj->txn_commit() if ($self->debug); - $dbh->commit; + $self->_dbh_commit; $self->{transaction_depth} = 0 if $self->_dbh_autocommit; } @@ -1137,6 +1151,11 @@ sub txn_commit { } } +sub _dbh_commit { + my $self = shift; + $self->_dbh->commit; +} + sub txn_rollback { my $self = shift; my $dbh = $self->_dbh; @@ -1146,7 +1165,7 @@ sub txn_rollback { if ($self->debug); $self->{transaction_depth} = 0 if $self->_dbh_autocommit; - $dbh->rollback; + $self->_dbh_rollback; } elsif($self->{transaction_depth} > 1) { $self->{transaction_depth}--; @@ -1169,6 +1188,11 @@ sub txn_rollback { } } +sub _dbh_rollback { + my $self = shift; + $self->_dbh->rollback; +} + # This used to be the top-half of _execute. It was split out to make it # easier to override in NoBindVars without duping the rest. It takes up # all of _execute's args, and emits $sql, @bind. @@ -1375,12 +1399,17 @@ sub insert_bulk { } sub update { - my $self = shift @_; - my $source = shift @_; - $self->_determine_driver; + my ($self, $source, @args) = @_; + +# redispatch to update method of storage we reblessed into, if necessary + if (not $self->_driver_determined) { + $self->_determine_driver; + goto $self->can('update'); + } + my $bind_attributes = $self->source_bind_attributes($source); - return $self->_execute('update' => [], $source, $bind_attributes, @_); + return $self->_execute('update' => [], $source, $bind_attributes, @args); } @@ -1957,6 +1986,18 @@ sub _subq_count_select { return @pcols ? \@pcols : [ 1 ]; } +# +# Returns an ordered list of column names before they are used +# in a SELECT statement. By default simply returns the list +# passed in. +# +# This may be overridden in a specific storage when there are +# requirements such as moving BLOB columns to the end of the +# SELECT list. +sub _order_select_columns { + #my ($self, $source, $columns) = @_; + return @{$_[2]}; +} sub source_bind_attributes { my ($self, $source) = @_; @@ -2154,6 +2195,36 @@ sub _native_data_type { return undef } +# Check if placeholders are supported at all +sub _placeholders_supported { + my $self = shift; + my $dbh = $self->_get_dbh; + + # some drivers provide a $dbh attribute (e.g. Sybase and $dbh->{syb_dynamic_supported}) + # but it is inaccurate more often than not + eval { + local $dbh->{PrintError} = 0; + local $dbh->{RaiseError} = 1; + $dbh->do('select ?', {}, 1); + }; + return $@ ? 0 : 1; +} + +# Check if placeholders bound to non-string types throw exceptions +# +sub _typeless_placeholders_supported { + my $self = shift; + my $dbh = $self->_get_dbh; + + eval { + local $dbh->{PrintError} = 0; + local $dbh->{RaiseError} = 1; + # this specifically tests a bind that is NOT a string + $dbh->do('select 1 where 1 = ?', {}, 1); + }; + return $@ ? 0 : 1; +} + =head2 sqlt_type Returns the database driver name. diff --git a/lib/DBIx/Class/Storage/DBI/AutoCast.pm b/lib/DBIx/Class/Storage/DBI/AutoCast.pm index 3391cfb..d854c16 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,8 +64,28 @@ 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 AUTHORS +=head1 AUTHOR See L diff --git a/lib/DBIx/Class/Storage/DBI/Cursor.pm b/lib/DBIx/Class/Storage/DBI/Cursor.pm index 3d5da26..b2c1354 100644 --- a/lib/DBIx/Class/Storage/DBI/Cursor.pm +++ b/lib/DBIx/Class/Storage/DBI/Cursor.pm @@ -3,7 +3,15 @@ package DBIx::Class::Storage::DBI::Cursor; use strict; use warnings; -use base qw/DBIx::Class::Cursor/; +use base qw/ + Class::Accessor::Grouped + DBIx::Class::Cursor +/; +use mro 'c3'; + +__PACKAGE__->mk_group_accessors('simple' => + qw/sth/ +); =head1 NAME @@ -73,24 +81,24 @@ sub _dbh_next { && $self->{attrs}{rows} && $self->{pos} >= $self->{attrs}{rows} ) { - $self->{sth}->finish if $self->{sth}->{Active}; - delete $self->{sth}; + $self->sth->finish if $self->sth->{Active}; + $self->sth(undef); $self->{done} = 1; } return if $self->{done}; - unless ($self->{sth}) { - $self->{sth} = ($storage->_select(@{$self->{args}}))[1]; + unless ($self->sth) { + $self->sth(($storage->_select(@{$self->{args}}))[1]); if ($self->{attrs}{software_limit}) { if (my $offset = $self->{attrs}{offset}) { - $self->{sth}->fetch for 1 .. $offset; + $self->sth->fetch for 1 .. $offset; } } } - my @row = $self->{sth}->fetchrow_array; + my @row = $self->sth->fetchrow_array; if (@row) { $self->{pos}++; } else { - delete $self->{sth}; + $self->sth(undef); $self->{done} = 1; } return @row; @@ -120,8 +128,8 @@ sub _dbh_all { my ($storage, $dbh, $self) = @_; $self->_check_dbh_gen; - $self->{sth}->finish if $self->{sth}->{Active}; - delete $self->{sth}; + $self->sth->finish if $self->sth && $self->sth->{Active}; + $self->sth(undef); my ($rv, $sth) = $storage->_select(@{$self->{args}}); return @{$sth->fetchall_arrayref}; } @@ -146,7 +154,7 @@ sub reset { my ($self) = @_; # No need to care about failures here - eval { $self->{sth}->finish if $self->{sth} && $self->{sth}->{Active} }; + eval { $self->sth->finish if $self->sth && $self->sth->{Active} }; $self->_soft_reset; return undef; } @@ -154,7 +162,7 @@ sub reset { sub _soft_reset { my ($self) = @_; - delete $self->{sth}; + $self->sth(undef); delete $self->{done}; $self->{pos} = 0; } @@ -173,7 +181,7 @@ sub DESTROY { # None of the reasons this would die matter if we're in DESTROY anyways local $@; - eval { $self->{sth}->finish if $self->{sth} && $self->{sth}->{Active} }; + eval { $self->sth->finish if $self->sth && $self->sth->{Active} }; } 1; diff --git a/lib/DBIx/Class/Storage/DBI/NoBindVars.pm b/lib/DBIx/Class/Storage/DBI/NoBindVars.pm index 95f1cac..9f84702 100644 --- a/lib/DBIx/Class/Storage/DBI/NoBindVars.pm +++ b/lib/DBIx/Class/Storage/DBI/NoBindVars.pm @@ -40,24 +40,32 @@ Manually subs in the values for the usual C placeholders. sub _prep_for_execute { my $self = shift; - my ($op, $extra_bind, $ident) = @_; - my ($sql, $bind) = $self->next::method(@_); - # stringify args, quote via $dbh, and manually insert + # stringify bind args, quote via $dbh, and manually insert + #my ($op, $extra_bind, $ident, $args) = @_; + my $ident = $_[2]; my @sql_part = split /\?/, $sql; my $new_sql; + my $col_info = $self->_resolve_column_info($ident, [ map $_->[0], @$bind ]); + foreach my $bound (@$bind) { my $col = shift @$bound; - my $datatype = 'FIXME!!!'; + + my $datatype = $col_info->{$col}{data_type}; + foreach my $data (@$bound) { - if(ref $data) { - $data = ''.$data; - } - $data = $self->_dbh->quote($data); - $new_sql .= shift(@sql_part) . $data; + $data = ''.$data if ref $data; + + $data = $self->_prep_interpolated_value($datatype, $data) + if $datatype; + + $data = $self->_dbh->quote($data) + unless $self->interpolate_unquoted($datatype, $data); + + $new_sql .= shift(@sql_part) . $data; } } $new_sql .= join '', @sql_part; @@ -65,11 +73,43 @@ sub _prep_for_execute { return ($new_sql, []); } -=head1 AUTHORS +=head2 interpolate_unquoted + +This method is called by L for every column in +order to determine if its value should be quoted or not. The arguments +are the current column data type and the actual bind value. The return +value is interpreted as: true - do not quote, false - do quote. You should +override this in you Storage::DBI:: subclass, if your RDBMS +does not like quotes around certain datatypes (e.g. Sybase and integer +columns). The default method always returns false (do quote). + + WARNING!!! + + Always validate that the bind-value is valid for the current datatype. + Otherwise you may very well open the door to SQL injection attacks. -Brandon Black +=cut + +sub interpolate_unquoted { + #my ($self, $datatype, $value) = @_; + return 0; +} + +=head2 _prep_interpolated_value + +Given a datatype and the value to be inserted directly into a SQL query, returns +the necessary string to represent that value (by e.g. adding a '$' sign) + +=cut + +sub _prep_interpolated_value { + #my ($self, $datatype, $value) = @_; + return $_[2]; +} + +=head1 AUTHORS -Trym Skaar +See L =head1 LICENSE 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 e29abec..8519ee5 100644 --- a/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm +++ b/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm @@ -102,8 +102,7 @@ EOF $self->_identity_method('@@identity'); } -sub _rebless { - no warnings 'uninitialized'; +sub _init { my $self = shift; if (ref($self->_dbi_connect_info->[0]) ne 'CODE' && diff --git a/lib/DBIx/Class/Storage/DBI/Oracle.pm b/lib/DBIx/Class/Storage/DBI/Oracle.pm index 7a49b50..da60a2d 100644 --- a/lib/DBIx/Class/Storage/DBI/Oracle.pm +++ b/lib/DBIx/Class/Storage/DBI/Oracle.pm @@ -19,10 +19,8 @@ sub _rebless { ? 'DBIx::Class::Storage::DBI::Oracle::WhereJoins' : 'DBIx::Class::Storage::DBI::Oracle::Generic'; - # Load and rebless - eval "require $class"; - - bless $self, $class unless $@; + $self->ensure_class_loaded ($class); + bless $self, $class; } } diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm index b97e34f..88cf72d 100644 --- a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm +++ b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm @@ -206,12 +206,6 @@ sub connect_call_datetime_setup { "alter session set nls_timestamp_tz_format='$timestamp_tz_format'"); } -sub _svp_begin { - my ($self, $name) = @_; - - $self->_get_dbh->do("SAVEPOINT $name"); -} - =head2 source_bind_attributes Handle LOB types in Oracle. Under a certain size (4k?), you can get away @@ -256,6 +250,12 @@ sub source_bind_attributes return \%bind_attributes; } +sub _svp_begin { + my ($self, $name) = @_; + + $self->_get_dbh->do("SAVEPOINT $name"); +} + # Oracle automatically releases a savepoint when you start another one with the # same name. sub _svp_release { 1 } diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm index ee43384..551dae9 100644 --- a/lib/DBIx/Class/Storage/DBI/Replicated.pm +++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm @@ -222,7 +222,7 @@ has 'pool' => ( isa=>'DBIx::Class::Storage::DBI::Replicated::Pool', lazy_build=>1, handles=>[qw/ - connect_replicants + connect_replicants replicants has_replicants /], @@ -277,7 +277,7 @@ has 'read_handler' => ( select select_single columns_info_for - /], + /], ); =head2 write_handler @@ -290,9 +290,9 @@ has 'write_handler' => ( is=>'ro', isa=>Object, lazy_build=>1, - handles=>[qw/ + handles=>[qw/ on_connect_do - on_disconnect_do + on_disconnect_do connect_info throw_exception sql_maker @@ -300,8 +300,8 @@ has 'write_handler' => ( create_ddl_dir deployment_statements datetime_parser - datetime_parser_type - build_datetime_parser + datetime_parser_type + build_datetime_parser last_insert_id insert insert_bulk @@ -316,19 +316,20 @@ has 'write_handler' => ( sth deploy with_deferred_fk_checks - dbh_do + dbh_do reload_row - with_deferred_fk_checks + with_deferred_fk_checks _prep_for_execute - backup - is_datatype_numeric - _count_select - _subq_count_select - _subq_update_delete - svp_rollback - svp_begin - svp_release + backup + is_datatype_numeric + _count_select + _subq_count_select + _subq_update_delete + _order_select_columns + svp_rollback + svp_begin + svp_release /], ); @@ -364,7 +365,7 @@ around connect_info => sub { ); $self->pool($self->_build_pool) - if $self->pool; + if $self->pool; } if (@opts{qw/balancer_type balancer_args/}) { @@ -376,7 +377,7 @@ around connect_info => sub { ); $self->balancer($self->_build_balancer) - if $self->balancer; + if $self->balancer; } $self->_master_connect_info_opts(\%opts); @@ -413,9 +414,9 @@ sub BUILDARGS { my ($class, $schema, $storage_type_args, @args) = @_; return { - schema=>$schema, - %$storage_type_args, - @args + schema=>$schema, + %$storage_type_args, + @args } } @@ -452,7 +453,7 @@ the balancer knows which pool it's balancing. sub _build_balancer { my $self = shift @_; $self->create_balancer( - pool=>$self->pool, + pool=>$self->pool, master=>$self->master, %{$self->balancer_args}, ); @@ -501,7 +502,7 @@ around connect_replicants => sub { my $i = 0; $i++ while $i < @$r && (reftype($r->[$i])||'') ne 'HASH'; -# make one if none +# make one if none $r->[$i] = {} unless $r->[$i]; # merge if two hashes @@ -600,11 +601,11 @@ sub execute_reliably { ($result[0]) = ($coderef->(@args)); } else { $coderef->(@args); - } + } }; ##Reset to the original state - $self->read_handler($current); + $self->read_handler($current); ##Exception testing has to come last, otherwise you might leave the ##read_handler set to master. @@ -738,7 +739,7 @@ sub debug { if(@_) { foreach my $source ($self->all_storages) { $source->debug(@_); - } + } } return $self->master->debug; } @@ -754,7 +755,7 @@ sub debugobj { if(@_) { foreach my $source ($self->all_storages) { $source->debugobj(@_); - } + } } return $self->master->debugobj; } @@ -770,7 +771,7 @@ sub debugfh { if(@_) { foreach my $source ($self->all_storages) { $source->debugfh(@_); - } + } } return $self->master->debugfh; } @@ -786,7 +787,7 @@ sub debugcb { if(@_) { foreach my $source ($self->all_storages) { $source->debugcb(@_); - } + } } return $self->master->debugcb; } diff --git a/lib/DBIx/Class/Storage/DBI/Sybase.pm b/lib/DBIx/Class/Storage/DBI/Sybase.pm index 41b0c81..1bb8956 100644 --- a/lib/DBIx/Class/Storage/DBI/Sybase.pm +++ b/lib/DBIx/Class/Storage/DBI/Sybase.pm @@ -4,63 +4,781 @@ 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 (); + +__PACKAGE__->mk_group_accessors('simple' => + qw/_identity _blob_log_on_update _writer_storage _is_writer_storage + _identity_method/ +); + +my @also_proxy_to_writer_storage = qw/ + 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