From: Alexander Hartmaier Date: Tue, 25 May 2010 15:55:26 +0000 (+0000) Subject: support INSERT ... RETURNING in Oracle 8i and later X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=bf51641f97a504ae9796fcc45da4e409c6466ca4;p=dbsrgits%2FDBIx-Class-Historic.git support INSERT ... RETURNING in Oracle 8i and later --- diff --git a/Changes b/Changes index 9e8df50..5595ab1 100644 --- a/Changes +++ b/Changes @@ -12,6 +12,7 @@ Revision history for DBIx::Class values to DBI: search({ array_col => { -value => [1,2,3] }}) - +columns now behaves just like columns by not stripping a fully-qualified 'as' spec (i.e. foo.bar results in $obj->foo->bar) + - Add full INSERT...RETURNING support for Oracle * Fixes - Fixed read-only attribute set attempt in ::Storage::Replicated diff --git a/Makefile.PL b/Makefile.PL index 15ff7e2..3a91cc7 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -68,7 +68,7 @@ my $runtime_requires = { 'Module::Find' => '0.06', 'Path::Class' => '0.18', 'Scope::Guard' => '0.03', - 'SQL::Abstract' => '1.71', + 'SQL::Abstract' => '1.72', 'Try::Tiny' => '0.04', # XS (or XS-dependent) libs diff --git a/lib/DBIx/Class/SQLMaker.pm b/lib/DBIx/Class/SQLMaker.pm index 6db2aba..67f0a0a 100644 --- a/lib/DBIx/Class/SQLMaker.pm +++ b/lib/DBIx/Class/SQLMaker.pm @@ -220,15 +220,18 @@ sub insert { # which is sadly understood only by MySQL. Change default behavior here, # until SQLA2 comes with proper dialect support if (! $_[2] or (ref $_[2] eq 'HASH' and !keys %{$_[2]} ) ) { + my @bind; my $sql = sprintf( 'INSERT INTO %s DEFAULT VALUES', $_[0]->_quote($_[1]) ); - if (my $ret = ($_[3]||{})->{returning} ) { - $sql .= $_[0]->_insert_returning ($ret); + if ( ($_[3]||{})->{returning} ) { + my $s; + ($s, @bind) = $_[0]->_insert_returning ($_[3]); + $sql .= $s; } - return $sql; + return ($sql, @bind); } next::method(@_); diff --git a/lib/DBIx/Class/SQLMaker/Oracle.pm b/lib/DBIx/Class/SQLMaker/Oracle.pm index 0a773e7..b2a2c1f 100644 --- a/lib/DBIx/Class/SQLMaker/Oracle.pm +++ b/lib/DBIx/Class/SQLMaker/Oracle.pm @@ -183,4 +183,48 @@ sub _unqualify_colname { return $self->_shorten_identifier($self->next::method($fqcn)); } +# +# Oracle has a different INSERT...RETURNING syntax +# + +sub _insert_returning { + my ($self, $options) = @_; + + my $f = $options->{returning}; + + my ($f_list, @f_names) = $self->_SWITCH_refkind($f, { + ARRAYREF => sub { + (join ', ', map { $self->_quote($_) } @$f), + @$f + }, + SCALAR => sub { + $self->_quote($f), + $f, + }, + SCALARREF => sub { + $$f, + $$f, + }, + }); + + my $rc_ref = $options->{returning_container} + or croak ('No returning container supplied for IR values'); + + @$rc_ref = (undef) x @f_names; + + return ( + ( join (' ', + $self->_sqlcase(' returning'), + $f_list, + $self->_sqlcase('into'), + join (', ', ('?') x @f_names ), + )), + map { + $self->{bindtype} eq 'columns' + ? [ $f_names[$_] => \$rc_ref->[$_] ] + : \$rc_ref->[$_] + } (0 .. $#f_names), + ); +} + 1; diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 3bd9fab..494161d 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -16,6 +16,7 @@ use Data::Dumper::Concise 'Dumper'; use Sub::Name 'subname'; use Try::Tiny; use File::Path 'make_path'; +use overload (); use namespace::clean; @@ -54,7 +55,13 @@ __PACKAGE__->mk_group_accessors('simple' => @storage_options); # will get the same rdbms version). _determine_supports_X does not need to # exist on a driver, as we ->can for it before calling. -my @capabilities = (qw/insert_returning placeholders typeless_placeholders join_optimizer/); +my @capabilities = (qw/ + insert_returning + insert_returning_bound + placeholders + typeless_placeholders + join_optimizer +/); __PACKAGE__->mk_group_accessors( dbms_capability => map { "_supports_$_" } @capabilities ); __PACKAGE__->mk_group_accessors( use_dbms_capability => map { "_use_$_" } (@capabilities ) ); @@ -1554,10 +1561,21 @@ sub _dbh_execute { foreach my $data (@data) { my $ref = ref $data; - $data = $ref && $ref ne 'ARRAY' ? ''.$data : $data; # stringify args (except arrayrefs) - $sth->bind_param($placeholder_index, $data, $attributes); - $placeholder_index++; + if ($ref and overload::Method($data, '""') ) { + $data = "$data"; + } + elsif ($ref eq 'SCALAR') { # any scalarrefs are assumed to be bind_inouts + $sth->bind_param_inout( + $placeholder_index++, + $data, + $self->_max_column_bytesize($ident, $column_name), + $attributes + ); + next; + } + + $sth->bind_param($placeholder_index++, $data, $attributes); } } @@ -1616,19 +1634,19 @@ sub insert { # list of primary keys we try to fetch from the database # both not-exsists and scalarrefs are considered my %fetch_pks; - %fetch_pks = ( map - { $_ => scalar keys %fetch_pks } # so we can preserve order for prettyness - grep - { ! exists $to_insert->{$_} or ref $to_insert->{$_} eq 'SCALAR' } - $source->primary_columns - ); + for ($source->primary_columns) { + $fetch_pks{$_} = scalar keys %fetch_pks # so we can preserve order for prettyness + if ! exists $to_insert->{$_} or ref $to_insert->{$_} eq 'SCALAR'; + } - my $sqla_opts; + my ($sqla_opts, @ir_container); if ($self->_use_insert_returning) { # retain order as declared in the resultsource for (sort { $fetch_pks{$a} <=> $fetch_pks{$b} } keys %fetch_pks ) { push @{$sqla_opts->{returning}}, $_; + $sqla_opts->{returning_container} = \@ir_container + if $self->_use_insert_returning_bound; } } @@ -1639,14 +1657,14 @@ sub insert { my %returned_cols; if (my $retlist = $sqla_opts->{returning}) { - my @ret_vals = try { + @ir_container = try { local $SIG{__WARN__} = sub {}; my @r = $sth->fetchrow_array; $sth->finish; @r; - }; + } unless @ir_container; - @returned_cols{@$retlist} = @ret_vals if @ret_vals; + @returned_cols{@$retlist} = @ir_container if @ir_container; } return { %$prefetched_values, %returned_cols }; @@ -2776,6 +2794,50 @@ sub relname_to_table_alias { return $alias; } +# The size in bytes to use for DBI's ->bind_param_inout, this is the generic +# version and it may be necessary to amend or override it for a specific storage +# if such binds are necessary. +sub _max_column_bytesize { + my ($self, $source, $col) = @_; + + my $inf = $source->column_info($col); + return $inf->{_max_bytesize} ||= do { + + my $max_size; + + if (my $data_type = $inf->{data_type}) { + $data_type = lc($data_type); + + # String/sized-binary types + if ($data_type =~ /^(?:l?(?:var)?char(?:acter)?(?:\s*varying)? + |(?:var)?binary(?:\s*varying)?|raw)\b/x + ) { + $max_size = $inf->{size}; + } + # Other charset/unicode types, assume scale of 4 + elsif ($data_type =~ /^(?:national\s*character(?:\s*varying)?|nchar + |univarchar + |nvarchar)\b/x + ) { + $max_size = $inf->{size} * 4 if $inf->{size}; + } + # Blob types + elsif ($data_type =~ /(?:blob|clob|bfile|text|image|bytea)/ + || $data_type =~ /^long(?:\s*(?:raw|bit\s*varying|varbit|binary + |varchar|character\s*varying|nvarchar + |national\s*character\s*varying))?$/ + ) { + # default to longreadlen + } + else { + $max_size = 100; # for all other (numeric?) datatypes + } + } + + $max_size ||= $self->_get_dbh->{LongReadLen} || 8000; + }; +} + 1; =head1 USAGE NOTES diff --git a/lib/DBIx/Class/Storage/DBI/Oracle.pm b/lib/DBIx/Class/Storage/DBI/Oracle.pm index bf50bcc..722c624 100644 --- a/lib/DBIx/Class/Storage/DBI/Oracle.pm +++ b/lib/DBIx/Class/Storage/DBI/Oracle.pm @@ -9,21 +9,15 @@ use Try::Tiny; use namespace::clean; sub _rebless { - my ($self) = @_; + my ($self) = @_; - try { - my $version = $self->_get_dbh->get_info(18); + # Default driver + my $class = $self->_server_info->{normalized_dbms_version} <= 8 + ? 'DBIx::Class::Storage::DBI::Oracle::WhereJoins' + : 'DBIx::Class::Storage::DBI::Oracle::Generic'; - my ($major, $minor, $patchlevel) = split(/\./, $version); - - # Default driver - my $class = $major <= 8 - ? 'DBIx::Class::Storage::DBI::Oracle::WhereJoins' - : 'DBIx::Class::Storage::DBI::Oracle::Generic'; - - $self->ensure_class_loaded ($class); - bless $self, $class; - }; + $self->ensure_class_loaded ($class); + bless $self, $class; } 1; diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm index be1faf8..d9d230a 100644 --- a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm +++ b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm @@ -80,6 +80,20 @@ use mro 'c3'; __PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::Oracle'); +sub _determine_supports_insert_returning { + my $self = shift; + +# TODO find out which version supports the RETURNING syntax +# 8i has it and earlier docs are a 404 on oracle.com + + return 1 + if $self->_server_info->{normalized_dbms_version} >= 8.001; + + return 0; +} + +__PACKAGE__->_use_insert_returning_bound (1); + sub deployment_statements { my $self = shift;; my ($schema, $type, $version, $dir, $sqltargs, @rest) = @_; diff --git a/lib/DBIx/Class/Storage/DBI/Replicated.pm b/lib/DBIx/Class/Storage/DBI/Replicated.pm index 01de0de..04b94f2 100644 --- a/lib/DBIx/Class/Storage/DBI/Replicated.pm +++ b/lib/DBIx/Class/Storage/DBI/Replicated.pm @@ -379,6 +379,7 @@ my @unimplemented = qw( _group_over_selection _prefetch_autovalues _extract_order_criteria + _max_column_bytesize ); # the capability framework diff --git a/t/73oracle.t b/t/73oracle.t index 4231127..cf49459 100644 --- a/t/73oracle.t +++ b/t/73oracle.t @@ -24,7 +24,7 @@ is_auto_increment => 1, }, ); - __PACKAGE__->set_primary_key('artistid'); + __PACKAGE__->set_primary_key(qw/ artistid autoinc_col /); 1; } @@ -34,6 +34,7 @@ use warnings; use Test::Exception; use Test::More; +use Sub::Name; use lib qw(t/lib); use DBICTest; @@ -69,34 +70,82 @@ my @tryopt = ( # keep a database handle open for cleanup my $dbh; -for my $opt (@tryopt) { - # clean all cached sequences from previous run - for (map { values %{DBICTest::Schema->source($_)->columns_info} } (qw/Artist CD Track/) ) { - delete $_->{sequence}; - } +# test insert returning + +# check if we indeed do support stuff +my $test_server_supports_insert_returning = do { + my $v = DBICTest::Schema->connect($dsn, $user, $pass) + ->storage + ->_get_dbh + ->get_info(18); + $v =~ /^(\d+)\.(\d+)/ + or die "Unparseable Oracle server version: $v\n"; + +# TODO find out which version supports the RETURNING syntax +# 8i has it and earlier docs are a 404 on oracle.com + ( $1 > 8 || ($1 == 8 && $2 >= 1) ) ? 1 : 0; +}; +is ( + DBICTest::Schema->connect($dsn, $user, $pass)->storage->_use_insert_returning, + $test_server_supports_insert_returning, + 'insert returning capability guessed correctly' +); + +my $schema; +for my $use_insert_returning ($test_server_supports_insert_returning + ? (1,0) + : (0) +) { + + no warnings qw/once/; + local *DBICTest::Schema::connection = subname 'DBICTest::Schema::connection' => sub { + my $s = shift->next::method (@_); + $s->storage->_use_insert_returning ($use_insert_returning); + $s; + }; + + for my $opt (@tryopt) { + # clean all cached sequences from previous run + for (map { values %{DBICTest::Schema->source($_)->columns_info} } (qw/Artist CD Track/) ) { + delete $_->{sequence}; + } + + my $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opt); - my $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opt); - my $q = $schema -> storage -> sql_maker -> quote_char || ''; + $dbh = $schema->storage->dbh; + my $q = $schema->storage->sql_maker->quote_char || ''; + + do_creates($dbh, $q); + + _run_tests($schema, $opt); + } +} - $dbh = $schema->storage->dbh; +sub _run_tests { + my ($schema, $opt) = @_; - do_creates($dbh, $q); + my $q = $schema->storage->sql_maker->quote_char || ''; # test primary key handling with multiple triggers my ($new, $seq); - $new = $schema->resultset('Artist')->create({ name => 'foo' }); - is($new->artistid, 1, "Oracle Auto-PK worked for standard sqlt-like trigger"); - $seq = $new->result_source->column_info('artistid')->{sequence}; - $seq = $$seq if ref $seq; - like ($seq, qr/\.${q}artist_pk_seq${q}$/, 'Correct PK sequence selected for sqlt-like trigger'); - - $new = $schema->resultset('CD')->create({ artist => 1, title => 'EP C', year => '2003' }); - is($new->cdid, 1, 'Oracle Auto-PK worked - using scalar ref as table name/custom weird trigger'); - $seq = $new->result_source->column_info('cdid')->{sequence}; - $seq = $$seq if ref $seq; - like ($seq, qr/\.${q}cd_seq${q}$/, 'Correct PK sequence selected for custom trigger'); + my $new_artist = $schema->resultset('Artist')->create({ name => 'foo' }); + my $new_cd = $schema->resultset('CD')->create({ artist => 1, title => 'EP C', year => '2003' }); + SKIP: { + skip 'not detecting sequences when using INSERT ... RETURNING', 4 + if $schema->storage->_use_insert_returning; + + is($new_artist->artistid, 1, "Oracle Auto-PK worked for standard sqlt-like trigger"); + $seq = $new_artist->result_source->column_info('artistid')->{sequence}; + $seq = $$seq if ref $seq; + like ($seq, qr/\.${q}artist_pk_seq${q}$/, 'Correct PK sequence selected for sqlt-like trigger'); + + is($new_cd->cdid, 1, 'Oracle Auto-PK worked - using scalar ref as table name/custom weird trigger'); + $seq = $new_cd->result_source->column_info('cdid')->{sequence}; + $seq = $$seq if ref $seq; + like ($seq, qr/\.${q}cd_seq${q}$/, 'Correct PK sequence selected for custom trigger'); + } # test PKs again with fully-qualified table name my $artistfqn_rs = $schema->resultset('ArtistFQN'); @@ -105,7 +154,9 @@ for my $opt (@tryopt) { delete $artist_rsrc->column_info('artistid')->{sequence}; $new = $artistfqn_rs->create( { name => 'bar' } ); - is( $new->artistid, 2, "Oracle Auto-PK worked with fully-qualified tablename" ); + is_deeply( {map { $_ => $new->$_ } $artist_rsrc->primary_columns}, + { artistid => 2, autoinc_col => 2}, + "Oracle Multi-Auto-PK worked with fully-qualified tablename" ); delete $artist_rsrc->column_info('artistid')->{sequence}; @@ -113,9 +164,15 @@ for my $opt (@tryopt) { is( $new->artistid, 3, "Oracle Auto-PK worked with fully-qualified tablename" ); is( $new->autoinc_col, 1000, "Oracle Auto-Inc overruled with fully-qualified tablename"); - $seq = $new->result_source->column_info('artistid')->{sequence}; - $seq = $$seq if ref $seq; - like ($seq, qr/\.${q}artist_pk_seq${q}$/, 'Correct PK sequence selected for sqlt-like trigger'); + + SKIP: { + skip 'not detecting sequences when using INSERT ... RETURNING', 1 + if $schema->storage->_use_insert_returning; + + $seq = $new->result_source->column_info('artistid')->{sequence}; + $seq = $$seq if ref $seq; + like ($seq, qr/\.${q}artist_pk_seq${q}$/, 'Correct PK sequence selected for sqlt-like trigger'); + } # test LIMIT support @@ -301,9 +358,12 @@ for my $opt (@tryopt) { TODO: { skip ((join '', 'Set DBICTEST_ORA_EXTRAUSER_DSN, _USER and _PASS to a *DIFFERENT* Oracle user', - ' to run the cross-schema autoincrement test.'), + ' to run the cross-schema sequence detection test.'), 1) unless $dsn2 && $user2 && $user2 ne $user; + skip 'not detecting cross-schema sequence name when using INSERT ... RETURNING', 1 + if $schema->storage->_use_insert_returning; + # Oracle8i Reference Release 2 (8.1.6) # http://download.oracle.com/docs/cd/A87860_01/doc/server.817/a76961/ch294.htm#993 # Oracle Database Reference 10g Release 2 (10.2) @@ -311,18 +371,17 @@ for my $opt (@tryopt) { local $TODO = "On Oracle8i all_triggers view is empty, i don't yet know why..." if $schema->storage->_server_info->{normalized_dbms_version} < 9; - my $schema2 = DBICTest::Schema->connect($dsn2, $user2, $pass2, $opt); - + my $schema2 = $schema->connect($dsn2, $user2, $pass2, $opt); my $schema1_dbh = $schema->storage->dbh; $schema1_dbh->do("GRANT INSERT ON ${q}artist${q} TO " . uc $user2); $schema1_dbh->do("GRANT SELECT ON ${q}artist_pk_seq${q} TO " . uc $user2); + $schema1_dbh->do("GRANT SELECT ON ${q}artist_autoinc_seq${q} TO " . uc $user2); my $rs = $schema2->resultset('ArtistFQN'); delete $rs->result_source->column_info('artistid')->{sequence}; - # first test with unquoted (default) sequence name in trigger body lives_and { my $row = $rs->create({ name => 'From Different Schema' }); ok $row->artistid; diff --git a/t/sqlmaker/oracle.t b/t/sqlmaker/oracle.t index 8a2573c..9491d6e 100644 --- a/t/sqlmaker/oracle.t +++ b/t/sqlmaker/oracle.t @@ -1,4 +1,3 @@ - use strict; use warnings; use Test::More; @@ -8,10 +7,10 @@ use lib qw(t/lib); use DBIC::SqlMakerTest; use DBIx::Class::SQLMaker::Oracle; -# +# # Offline test for connect_by # ( without acitve database connection) -# +# my @handle_tests = ( { connect_by => { 'parentid' => { '-prior' => \'artistid' } }, @@ -105,4 +104,69 @@ is ( '_shorten_identifier with keywords ok', ); +# test SQL generation for INSERT ... RETURNING + +sub UREF { \do { my $x } }; + +$sqla_oracle->{bindtype} = 'columns'; + +for my $q ('', '"') { + local $sqla_oracle->{quote_char} = $q; + + my ($sql, @bind) = $sqla_oracle->insert( + 'artist', + { + 'name' => 'Testartist', + }, + { + 'returning' => 'artistid', + 'returning_container' => [], + }, + ); + + is_same_sql_bind( + $sql, \@bind, + "INSERT INTO ${q}artist${q} (${q}name${q}) VALUES (?) RETURNING ${q}artistid${q} INTO ?", + [ [ name => 'Testartist' ], [ artistid => UREF ] ], + 'sql_maker generates insert returning for one column' + ); + + ($sql, @bind) = $sqla_oracle->insert( + 'artist', + { + 'name' => 'Testartist', + }, + { + 'returning' => \'artistid', + 'returning_container' => [], + }, + ); + + is_same_sql_bind( + $sql, \@bind, + "INSERT INTO ${q}artist${q} (${q}name${q}) VALUES (?) RETURNING artistid INTO ?", + [ [ name => 'Testartist' ], [ artistid => UREF ] ], + 'sql_maker generates insert returning for one column' + ); + + + ($sql, @bind) = $sqla_oracle->insert( + 'computed_column_test', + { + 'a_timestamp' => '2010-05-26 18:22:00', + }, + { + 'returning' => [ 'id', 'a_computed_column', 'charfield' ], + 'returning_container' => [], + }, + ); + + is_same_sql_bind( + $sql, \@bind, + "INSERT INTO ${q}computed_column_test${q} (${q}a_timestamp${q}) VALUES (?) RETURNING ${q}id${q}, ${q}a_computed_column${q}, ${q}charfield${q} INTO ?, ?, ?", + [ [ a_timestamp => '2010-05-26 18:22:00' ], [ id => UREF ], [ a_computed_column => UREF ], [ charfield => UREF ] ], + 'sql_maker generates insert returning for multiple columns' + ); +} + done_testing;