From: Ron "Quinn" Straight Date: Sun, 3 May 2009 01:52:29 +0000 (+0000) Subject: Support for saving CLOB and BLOB types in Oracle. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5db2758de644d53e07cd3e05f0e9037bf40116fc;p=dbsrgits%2FDBIx-Class-Historic.git Support for saving CLOB and BLOB types in Oracle. --- diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm index 2e9a8c1..92a920a 100644 --- a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm +++ b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm @@ -26,6 +26,9 @@ This class implements autoincrements for Oracle. use Carp::Clan qw/^DBIx::Class/; +use DBD::Oracle qw( :ora_types ); +#use constant ORA_BLOB => 113; ## ORA_CLOB is 112 + use base qw/DBIx::Class::Storage::DBI::MultiDistinctEmulation/; # __PACKAGE__->load_components(qw/PK::Auto/); @@ -190,6 +193,48 @@ sub _svp_begin { $self->dbh->do("SAVEPOINT $name"); } +=head2 source_bind_attributes + +Handle LOB types in Oracle. Under a certain size (4k?), you can get away +with the driver assuming your input is the deprecated LONG type if you +encode it as a hex string. That ain't gonna fly at larger values, where +you'll discover you have to do what this does. + +This method had to be overridden because we need to set ora_field to the +actual column, and that isn't passed to the call (provided by Storage) to +bind_attribute_by_data_type. + +According to L, the ora_field isn't always necessary, but +adding it doesn't hurt, and will save your bacon if you're modifying a +table with more than one LOB column. + +=cut + +sub source_bind_attributes +{ + my $self = shift; + my($source) = @_; + + my %bind_attributes; + + foreach my $column ($source->columns) { + my $data_type = $source->column_info($column)->{data_type} || ''; + next unless $data_type; + + my %column_bind_attrs = $self->bind_attribute_by_data_type($data_type); + + if ($data_type =~ /^[BC]LOB$/i) { + $column_bind_attrs{'ora_type'} + = uc($data_type) eq 'CLOB' ? ORA_CLOB : ORA_BLOB; + $column_bind_attrs{'ora_field'} = $column; + } + + $bind_attributes{$column} = \%column_bind_attrs; + } + + return \%bind_attributes; +} + # Oracle automatically releases a savepoint when you start another one with the # same name. sub _svp_release { 1 } diff --git a/t/73oracle.t b/t/73oracle.t index 51cc932..3df588b 100644 --- a/t/73oracle.t +++ b/t/73oracle.t @@ -28,6 +28,7 @@ use strict; use warnings; +use Test::Exception; use Test::More; use lib qw(t/lib); use DBICTest; @@ -39,7 +40,7 @@ plan skip_all => 'Set $ENV{DBICTEST_ORA_DSN}, _USER and _PASS to run this test. ' as well as following sequences: \'pkid1_seq\', \'pkid2_seq\' and \'nonpkid_seq\'' unless ($dsn && $user && $pass); -plan tests => 24; +plan tests => 32; DBICTest::Schema->load_classes('ArtistFQN'); my $schema = DBICTest::Schema->connect($dsn, $user, $pass); @@ -80,6 +81,23 @@ $dbh->do(qq{ END; }); +{ + # Swiped from t/bindtype_columns.t to avoid creating my own Resultset. + + local $SIG{__WARN__} = sub {}; + eval { $dbh->do('DROP TABLE bindtype_test') }; + + $dbh->do(qq[ + CREATE TABLE bindtype_test + ( + id integer NOT NULL PRIMARY KEY, + bytea integer NULL, + blob blob NULL, + clob clob NULL + ) + ],{ RaiseError => 1, PrintError => 1 }); +} + # This is in Core now, but it's here just to test that it doesn't break $schema->class('Artist')->load_components('PK::Auto'); # These are compat shims for PK::Auto... @@ -147,6 +165,29 @@ for (1..5) { my $st = $schema->resultset('SequenceTest')->create({ name => 'foo', pkid1 => 55 }); is($st->pkid1, 55, "Oracle Auto-PK without trigger: First primary key set manually"); +{ + my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) ); + $binstr{'large'} = $binstr{'small'} x 1024; + + my $maxloblen = length $binstr{'large'}; + note "Localizing LongReadLen to $maxloblen to avoid truncation of test data"; + local $dbh->{'LongReadLen'} = $maxloblen; + + my $rs = $schema->resultset('BindType'); + my $id = 0; + + foreach my $type (qw( blob clob )) { + foreach my $size (qw( small large )) { + $id++; + + lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$type} } ) } + "inserted $size $type without dying"; + + is( $rs->find($id)->$type, $binstr{$type}, "verified inserted $size $type" ); + } + } +} + # clean up our mess END { if($schema && ($dbh = $schema->storage->dbh)) { @@ -158,6 +199,7 @@ END { $dbh->do("DROP TABLE sequence_test"); $dbh->do("DROP TABLE cd"); $dbh->do("DROP TABLE track"); + $dbh->do("DROP TABLE bindtype_test"); } }