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
'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
# 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(@_);
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;
use Sub::Name 'subname';
use Try::Tiny;
use File::Path 'make_path';
+use overload ();
use namespace::clean;
# 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 ) );
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);
}
}
# 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;
}
}
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 };
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
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;
__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) = @_;
_group_over_selection
_prefetch_autovalues
_extract_order_criteria
+ _max_column_bytesize
);
# the capability framework
is_auto_increment => 1,
},
);
- __PACKAGE__->set_primary_key('artistid');
+ __PACKAGE__->set_primary_key(qw/ artistid autoinc_col /);
1;
}
use Test::Exception;
use Test::More;
+use Sub::Name;
use lib qw(t/lib);
use DBICTest;
# 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');
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};
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
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)
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;
-
use strict;
use warnings;
use Test::More;
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' } },
'_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;
projects / dbsrgits/DBIx-Class.git / commitdiff