ningu: David Kamholz <dkamholz@cpan.org>
+Nniuq: Ron "Quinn" Straight" <quinnfazigu@gmail.org>
+
norbi: Norbert Buchmuller <norbi@nix.hu>
Numa: Dan Sully <daniel@cpan.org>
my $type;
- for (qw/date datetime/) {
+ for (qw/date datetime timestamp/) {
my $key = "inflate_${_}";
next unless exists $info->{$key};
unless ($type) {
$type = lc($info->{data_type});
- $type = 'datetime' if ($type =~ /^timestamp/);
}
my $timezone;
my $undef_if_invalid = $info->{datetime_undef_if_invalid};
- if ($type eq 'datetime' || $type eq 'date') {
- my ($parse, $format) = ("parse_${type}", "format_${type}");
-
- # This assignment must happen here, otherwise Devel::Cycle treats
- # the resulting deflator as a circular reference (go figure):
- #
- # Cycle #1
- # DBICTest::Schema A->{source_registrations} => %B
- # %B->{Event} => DBIx::Class::ResultSource::Table C
- # DBIx::Class::ResultSource::Table C->{_columns} => %D
- # %D->{created_on} => %E
- # %E->{_inflate_info} => %F
- # %F->{deflate} => &G
- # closure &G, $info => $H
- # $H => %E
- #
- my $floating_tz_ok;
+ if ($type eq 'datetime' || $type eq 'date' || $type eq 'timestamp') {
+ # This shallow copy of %info avoids t/52_cycle.t treating
+ # the resulting deflator as a circular reference.
+ my %info = ( '_ic_dt_method' => $type , %{ $info } );
+
if (defined $info->{extra}{floating_tz_ok}) {
warn "Putting floating_tz_ok into extra => { floating_tz_ok => 1 } has been deprecated, ".
"please put it directly into the columns definition.";
- $floating_tz_ok = $info->{extra}{floating_tz_ok};
+ $info{floating_tz_ok} = $info->{extra}{floating_tz_ok};
}
- $floating_tz_ok = $info->{floating_tz_ok} if defined $info->{floating_tz_ok};
$self->inflate_column(
$column =>
{
inflate => sub {
my ($value, $obj) = @_;
- my $dt = eval { $obj->_datetime_parser->$parse($value); };
+ my $dt = eval { $obj->_inflate_to_datetime( $value, \%info ) };
die "Error while inflating ${value} for ${column} on ${self}: $@"
if $@ and not $undef_if_invalid;
$dt->set_time_zone($timezone) if $timezone;
warn "You're using a floating timezone, please see the documentation of"
. " DBIx::Class::InflateColumn::DateTime for an explanation"
if ref( $value->time_zone ) eq 'DateTime::TimeZone::Floating'
- and not $floating_tz_ok
+ and not $info{floating_tz_ok}
and not $ENV{DBIC_FLOATING_TZ_OK};
$value->set_time_zone($timezone);
$value->set_locale($locale) if $locale;
}
- $obj->_datetime_parser->$format($value);
+ $obj->_deflate_from_datetime( $value, \%info );
},
}
);
}
}
+sub _flate_or_fallback
+{
+ my( $self, $value, $info, $method_fmt ) = @_;
+
+ my $parser = $self->_datetime_parser;
+ my $preferred_method = sprintf($method_fmt, $info->{ _ic_dt_method });
+ my $method = $parser->can($preferred_method) ? $preferred_method : sprintf($method_fmt, 'datetime');
+ return $parser->$method($value);
+}
+
+sub _inflate_to_datetime {
+ my( $self, $value, $info ) = @_;
+ return $self->_flate_or_fallback( $value, $info, 'parse_%s' );
+}
+
+sub _deflate_from_datetime {
+ my( $self, $value, $info ) = @_;
+ return $self->_flate_or_fallback( $value, $info, 'format_%s' );
+}
+
sub _datetime_parser {
my $self = shift;
if (my $parser = $self->__datetime_parser) {
use Carp::Clan qw/^DBIx::Class/;
+# For ORA_BLOB => 113, ORA_CLOB => 112
+use DBD::Oracle qw( :ora_types );
+
use base qw/DBIx::Class::Storage::DBI::MultiDistinctEmulation/;
# __PACKAGE__->load_components(qw/PK::Auto/);
$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<DBD::Oracle>, 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 }
use strict;
use warnings;
+use Test::Exception;
use Test::More;
use lib qw(t/lib);
use DBICTest;
' 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);
$dbh->do("CREATE TABLE artist (artistid NUMBER(12), name VARCHAR(255), rank NUMBER(38), charfield VARCHAR2(10))");
$dbh->do("CREATE TABLE sequence_test (pkid1 NUMBER(12), pkid2 NUMBER(12), nonpkid NUMBER(12), name VARCHAR(255))");
$dbh->do("CREATE TABLE cd (cdid NUMBER(12), artist NUMBER(12), title VARCHAR(255), year VARCHAR(4))");
-$dbh->do("CREATE TABLE track (trackid NUMBER(12), cd NUMBER(12), position NUMBER(12), title VARCHAR(255), last_updated_on DATE)");
+$dbh->do("CREATE TABLE track (trackid NUMBER(12), cd NUMBER(12), position NUMBER(12), title VARCHAR(255), last_updated_on DATE, last_updated_at DATE)");
$dbh->do("ALTER TABLE artist ADD (CONSTRAINT artist_pk PRIMARY KEY (artistid))");
$dbh->do("ALTER TABLE sequence_test ADD (CONSTRAINT sequence_test_constraint PRIMARY KEY (pkid1, pkid2))");
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...
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)) {
$dbh->do("DROP TABLE sequence_test");
$dbh->do("DROP TABLE cd");
$dbh->do("DROP TABLE track");
+ $dbh->do("DROP TABLE bindtype_test");
}
}
plan skip_all => 'needs DateTime and DateTime::Format::Oracle for testing';
}
else {
- plan tests => 4;
+ plan tests => 7;
}
}
# DateTime::Format::Oracle needs this set
$ENV{NLS_DATE_FORMAT} = 'DD-MON-YY';
+$ENV{NLS_TIMESTAMP_FORMAT} = 'YYYY-MM-DD HH24:MI:SSXFF';
$ENV{NLS_LANG} = 'AMERICAN_AMERICA.WE8ISO8859P1';
my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
my $col_metadata = $schema->class('Track')->column_info('last_updated_on');
$schema->class('Track')->add_column( 'last_updated_on' => {
data_type => 'date' });
+$schema->class('Track')->add_column( 'last_updated_at' => {
+ data_type => 'timestamp' });
my $dbh = $schema->storage->dbh;
+#$dbh->do("alter session set nls_timestamp_format = 'YYYY-MM-DD HH24:MI:SSXFF'");
+
eval {
$dbh->do("DROP TABLE track");
};
-$dbh->do("CREATE TABLE track (trackid NUMBER(12), cd NUMBER(12), position NUMBER(12), title VARCHAR(255), last_updated_on DATE)");
+$dbh->do("CREATE TABLE track (trackid NUMBER(12), cd NUMBER(12), position NUMBER(12), title VARCHAR(255), last_updated_on DATE, last_updated_at TIMESTAMP)");
# insert a row to play with
-my $new = $schema->resultset('Track')->create({ trackid => 1, cd => 1, position => 1, title => 'Track1', last_updated_on => '06-MAY-07' });
+my $new = $schema->resultset('Track')->create({ trackid => 1, cd => 1, position => 1, title => 'Track1', last_updated_on => '06-MAY-07', last_updated_at => '2009-05-03 21:17:18.5' });
is($new->trackid, 1, "insert sucessful");
my $track = $schema->resultset('Track')->find( 1 );
is( $track->last_updated_on->month, 5, "DateTime methods work on inflated column");
+#note '$track->last_updated_at => ', $track->last_updated_at;
+is( ref($track->last_updated_at), 'DateTime', "last_updated_at inflated ok");
+
+is( $track->last_updated_at->nanosecond, 500_000_000, "DateTime methods work with nanosecond precision");
+
my $dt = DateTime->now();
$track->last_updated_on($dt);
+$track->last_updated_at($dt);
$track->update;
is( $track->last_updated_on->month, $dt->month, "deflate ok");
+is( int $track->last_updated_at->nanosecond, int $dt->nanosecond, "deflate ok with nanosecond precision");
# clean up our mess
END {
accessor => 'updated_date',
is_nullable => 1
},
+ last_updated_at => {
+ data_type => 'datetime',
+ is_nullable => 1
+ },
);
__PACKAGE__->set_primary_key('trackid');
cd integer NOT NULL,
position integer NOT NULL,
title varchar(100) NOT NULL,
- last_updated_on datetime
+ last_updated_on datetime,
+ last_updated_at datetime
);
CREATE INDEX track_idx_cd_track ON track (cd);
projects / dbsrgits/DBIx-Class.git / commitdiff