'DateTime::Format::Oracle' => 0,
) : ()
,
+
+ $ENV{DBICTEST_SYBASE_DSN}
+ ? (
+ 'DateTime::Format::Sybase' => 0,
+ ) : ()
+ ,
);
if ($Module::Install::AUTHOR) {
=cut
+use overload
+ '""' => \&from;
+
sub from { shift->name; }
1;
} @bind;
}
+sub _flatten_bind_params {
+ my ($self, @bind) = @_;
+
+ ### Turn @bind from something like this:
+ ### ( [ "artist", 1 ], [ "cdid", 1, 3 ] )
+ ### to this:
+ ### ( 1, 1, 3 )
+ return
+ map {
+ if ( defined( $_ && $_->[1] ) ) {
+ @{$_}[ 1 .. $#$_ ];
+ }
+ else { undef; }
+ } @bind;
+}
+
sub _query_start {
my ( $self, $sql, @bind ) = @_;
use warnings;
use base 'DBIx::Class::Storage::DBI';
+use Scalar::Util ();
+use Carp::Clan qw/^DBIx::Class/;
=head1 NAME
sub _prep_for_execute {
my $self = shift;
- my ($op, $extra_bind, $ident) = @_;
+ my ($op, $extra_bind, $ident, $args) = @_;
my ($sql, $bind) = $self->next::method(@_);
my @sql_part = split /\?/, $sql;
my $new_sql;
+ my $alias2src = $self->_resolve_ident_sources($ident);
+
foreach my $bound (@$bind) {
my $col = shift @$bound;
- my $datatype = 'FIXME!!!';
+
+ my $name_sep = $self->_sql_maker_opts->{name_sep} || '.';
+
+ $col =~ s/^([^\Q${name_sep}\E]*)\Q${name_sep}\E//;
+ my $alias = $1 || 'me';
+
+ my $rsrc = $alias2src->{$alias};
+
+ my $datatype = $rsrc && $rsrc->column_info($col)->{data_type};
+
foreach my $data (@$bound) {
- if(ref $data) {
- $data = ''.$data;
- }
- $data = $self->_dbh->quote($data);
+ $data = ''.$data if ref $data;
+
+ $data = $self->_dbh->quote($data) if $self->should_quote($datatype, $data);
+
$new_sql .= shift(@sql_part) . $data;
}
}
return ($new_sql, []);
}
+=head2 should_quote
+
+This method is called by L</_prep_for_execute> 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 quote, false - do not quote. You should
+override this in you Storage::DBI::<database> subclass, if your RDBMS
+does not like quotes around certain datatypes (e.g. Sybase and integer
+columns). The default method always returns true (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.
+
+=cut
+
+sub should_quote { 1 }
+
=head1 AUTHORS
Brandon Black <blblack@gmail.com>
use strict;
use warnings;
-use base qw/DBIx::Class::Storage::DBI::NoBindVars/;
+use Class::C3;
+use base qw/DBIx::Class::Storage::DBI/;
+
+use Carp::Clan qw/^DBIx::Class/;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Sybase - Storage::DBI subclass for Sybase
+
+=head1 SYNOPSIS
+
+This subclass supports L<DBD::Sybase> for real Sybase databases. If you are
+using an MSSQL database via L<DBD::Sybase>, your storage will be reblessed to
+L<DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server>.
+
+=head1 DESCRIPTION
+
+If your version of Sybase does not support placeholders, then your storage
+will be reblessed to L<DBIx::Class::Storage::DBI::Sybase::NoBindVars>. 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<last_insert_id>
+without doing a C<select max(col)>.
+
+But your queries will be cached.
+
+A recommended L<DBIx::Class::Storage::DBI/connect_info> settings:
+
+ on_connect_call => [['datetime_setup'], [blob_setup => log_on_update => 0]]
+
+=head1 METHODS
+
+=cut
+
+__PACKAGE__->mk_group_accessors('simple' =>
+ qw/_blob_log_on_update/
+);
sub _rebless {
+ my $self = shift;
+
+ if (ref($self) eq 'DBIx::Class::Storage::DBI::Sybase') {
+ my $dbtype = eval {
+ @{$self->dbh->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})}[2]
+ } || '';
+
+ my $exception = $@;
+ $dbtype =~ s/\W/_/gi;
+ my $subclass = "DBIx::Class::Storage::DBI::Sybase::${dbtype}";
+
+ if (!$exception && $dbtype && $self->load_optional_class($subclass)) {
+ bless $self, $subclass;
+ $self->_rebless;
+ } else {
+ # real Sybase
+ if (not $self->dbh->{syb_dynamic_supported}) {
+ bless $self, 'DBIx::Class::Storage:DBI::Sybase::NoBindVars';
+ $self->_rebless;
+ }
+ }
+ }
+}
+
+=head2 connect_call_blob_setup
+
+Used as:
+
+ on_connect_call => [ [ blob_setup => log_on_update => 0 ] ]
+
+Does C<< $dbh->{syb_binary_images} = 1; >> to return C<IMAGE> data as raw binary
+instead of as a hex string.
+
+Recommended.
+
+Also sets the C<log_on_update> value for blob write operations. The default is
+C<1>, but C<0> is better if your database is configured for it.
+
+See
+L<DBD::Sybase/Handling_IMAGE/TEXT_data_with_syb_ct_get_data()/syb_ct_send_data()>.
+
+=cut
+
+sub connect_call_blob_setup {
+ my $self = shift;
+ my %args = @_;
+ my $dbh = $self->_dbh;
+ $dbh->{syb_binary_images} = 1;
+
+ $self->_blob_log_on_update($args{log_on_update})
+ if exists $args{log_on_update};
+}
+
+sub _is_lob_type {
+ my $self = shift;
+ shift =~ /(?:text|image|lob|bytea|binary)/i;
+}
+
+sub insert {
+ my $self = shift;
+ my ($source, $to_insert) = @_;
+
+ my %blob_cols;
+
+ for my $col (keys %$to_insert) {
+ $blob_cols{$col} = delete $to_insert->{$col}
+ if $self->_is_lob_type($source->column_info($col)->{data_type});
+ }
+
+ my $updated_cols = $self->next::method(@_);
+
+ $self->_update_blobs($source, \%blob_cols, $to_insert) if %blob_cols;
+
+ return $updated_cols;
+}
+
+sub _update_blobs {
+ my ($self, $source, $blob_cols, $inserted) = @_;
+ my $dbh = $self->dbh;
+
+ my $table = $source->from;
+
+ my (@primary_cols) = $source->primary_columns;
+
+ croak "Cannot update TEXT/IMAGE without a primary key!"
+ unless @primary_cols;
+
+ my $search_cond = join ',' => map "$_ = ?", @primary_cols;
+
+ for my $col (keys %$blob_cols) {
+ my $blob = $blob_cols->{$col};
+
+# First update to empty string in case it's NULL, can't update a NULL blob using
+# the API.
+ my $sth = $dbh->prepare_cached(
+ qq{update $table set $col = '' where $search_cond}
+ );
+ $sth->execute(map $inserted->{$_}, @primary_cols) or die $sth->errstr;
+ $sth->finish;
+
+ $sth = $dbh->prepare_cached(
+ "select $col from $table where $search_cond"
+ );
+ $sth->execute(map $inserted->{$_}, @primary_cols);
+
+ eval {
+ while ($sth->fetch) {
+ $sth->func('CS_GET', 1, 'ct_data_info') or die $sth->errstr;
+ }
+ $sth->func('ct_prepare_send') or die $sth->errstr;
+
+ my $log_on_update = $self->_blob_log_on_update;
+ $log_on_update = 1 if not defined $log_on_update;
+
+ $sth->func('CS_SET', 1, {
+ total_txtlen => length($blob),
+ log_on_update => $log_on_update
+ }, 'ct_data_info') or die $sth->errstr;
+
+ $sth->func($blob, length($blob), 'ct_send_data') or die $sth->errstr;
+
+ $sth->func('ct_finish_send') or die $sth->errstr;
+ };
+ my $exception = $@;
+ $sth->finish;
+ croak $exception if $exception;
+ }
+}
+
+=head2 connect_call_datetime_setup
+
+Used as:
+
+ on_connect_call => 'datetime_setup'
+
+In L<DBIx::Class::Storage::DBI/connect_info> to set:
+
+ $dbh->syb_date_fmt('ISO_strict'); # output fmt: 2004-08-21T14:36:48.080Z
+ $dbh->do('set dateformat mdy'); # input fmt: 08/13/1979 18:08:55.080
+
+On connection for use with L<DBIx::Class::InflateColumn::DateTime>, using
+L<DateTime::Format::Sybase>, which you will need to install.
+
+This works for both C<DATETIME> and C<SMALLDATETIME> columns, although
+C<SMALLDATETIME> columns only have minute precision.
+
+=cut
+
+{
+ my $old_dbd_warned = 0;
+
+ sub connect_call_datetime_setup {
my $self = shift;
+ my $dbh = $self->_dbh;
- my $dbtype = eval { @{$self->dbh->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})}[2] };
- unless ( $@ ) {
- $dbtype =~ s/\W/_/gi;
- my $subclass = "DBIx::Class::Storage::DBI::Sybase::${dbtype}";
- if ($self->load_optional_class($subclass) && !$self->isa($subclass)) {
- bless $self, $subclass;
- $self->_rebless;
- }
+ if ($dbh->can('syb_date_fmt')) {
+ $dbh->syb_date_fmt('ISO_strict');
+ } elsif (not $old_dbd_warned) {
+ carp "Your DBD::Sybase is too old to support ".
+ "DBIx::Class::InflateColumn::DateTime, please upgrade!";
+ $old_dbd_warned = 1;
}
+
+ $dbh->do('set dateformat mdy');
+
+ 1;
+ }
}
+sub datetime_parser_type { "DateTime::Format::Sybase" }
+
sub _dbh_last_insert_id {
- my ($self, $dbh, $source, $col) = @_;
- return ($dbh->selectrow_array('select @@identity'))[0];
+ my ($self, $dbh, $source, $col) = @_;
+
+ # sorry, there's no other way!
+ my $sth = $dbh->prepare_cached("select max($col) from ".$source->from);
+ return ($dbh->selectrow_array($sth))[0];
}
-1;
+# previous implementation of limited count for Sybase, does not include
+# count_grouped.
-=head1 NAME
+#sub _copy_attributes_for_count {
+# my ($self, $source, $attrs) = @_;
+# my %attrs = %$attrs;
+#
+# # take off any column specs, any pagers, record_filter is cdbi, and no point of ordering a count
+# delete @attrs{qw/select as rows offset page order_by record_filter/};
+#
+# return \%attrs;
+#}
+#
+#=head2 count
+#
+#Counts for limited queries are emulated by executing select queries and
+#returning the number of successful executions minus the offset.
+#
+#This is necessary due to the limitations of Sybase.
+#
+#=cut
+#
+#sub count {
+# my $self = shift;
+# my ($source, $attrs) = @_;
+#
+# my $new_attrs = $self->_copy_attributes_for_count($source, $attrs);
+#
+# if (exists $attrs->{rows}) {
+# my $offset = $attrs->{offset} || 0;
+# my $total = $attrs->{rows} + $offset;
+#
+# my $first_pk = ($source->primary_columns)[0];
+#
+# $new_attrs->{select} = $first_pk ? "me.$first_pk" : 1;
+#
+# my $tmp_rs = $source->resultset_class->new($source, $new_attrs);
+#
+# $self->dbh->{syb_rowcount} = $total;
+#
+# my $count = 0;
+# $count++ while $tmp_rs->cursor->next;
+#
+# $self->dbh->{syb_rowcount} = 0;
+#
+# return $count - $offset;
+# } else {
+# # overwrite the selector
+# $new_attrs->{select} = { count => '*' };
+#
+# my $tmp_rs = $source->resultset_class->new($source, $new_attrs);
+# my ($count) = $tmp_rs->cursor->next;
+#
+# # if the offset/rows attributes are still present, we did not use
+# # a subquery, so we need to make the calculations in software
+# $count -= $attrs->{offset} if $attrs->{offset};
+# $count = $attrs->{rows} if $attrs->{rows} and $attrs->{rows} < $count;
+# $count = 0 if ($count < 0);
+#
+# return $count;
+# }
+#}
-DBIx::Class::Storage::DBI::Sybase - Storage::DBI subclass for Sybase
+1;
-=head1 SYNOPSIS
+=head1 DATES
-This subclass supports L<DBD::Sybase> for real Sybase databases. If
-you are using an MSSQL database via L<DBD::Sybase>, see
-L<DBIx::Class::Storage::DBI::Sybase::MSSQL>.
+See L</connect_call_datetime_setup> to setup date formats
+for L<DBIx::Class::InflateColumn::DateTime>.
-=head1 CAVEATS
+=head1 IMAGE AND TEXT COLUMNS
-This storage driver uses L<DBIx::Class::Storage::DBI::NoBindVars> as a base.
-This means that bind variables will be interpolated (properly quoted of course)
-into the SQL query itself, without using bind placeholders.
+See L</connect_call_blob_setup> for a L<DBIx::Class::Storage::DBI/connect_info>
+setting you need to work with C<IMAGE> columns.
-More importantly this means that caching of prepared statements is explicitly
-disabled, as the interpolation renders it useless.
+Due to limitations in L<DBD::Sybase> and this driver, it is only possible to
+select one C<TEXT> or C<IMAGE> column at a time.
=head1 AUTHORS
-Brandon L Black <blblack@gmail.com>
-
-Justin Hunter <justin.d.hunter@gmail.com>
+See L<DBIx::Class/CONTRIBUTORS>.
=head1 LICENSE
You may distribute this code under the same terms as Perl itself.
=cut
+# vim:sts=2 sw=2:
use strict;
use warnings;
+use Class::C3;
use base qw/
DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server
- DBIx::Class::Storage::DBI::Sybase
+ DBIx::Class::Storage::DBI::NoBindVars
/;
1;
More importantly this means that caching of prepared statements is explicitly
disabled, as the interpolation renders it useless.
-=head1 AUTHORS
+The actual driver code for MSSQL is in
+L<DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server>.
-Brandon L Black <blblack@gmail.com>
+=head1 AUTHORS
-Justin Hunter <justin.d.hunter@gmail.com>
+See L<DBIx::Class/CONTRIBUTORS>.
=head1 LICENSE
--- /dev/null
+package DBIx::Class::Storage::DBI::Sybase::NoBindVars;
+
+use Class::C3;
+use base qw/
+ DBIx::Class::Storage::DBI::NoBindVars
+ DBIx::Class::Storage::DBI::Sybase
+/;
+use List::Util ();
+use Scalar::Util ();
+
+sub _dbh_last_insert_id {
+ my ($self, $dbh, $source, $col) = @_;
+
+ # @@identity works only if not using placeholders
+ # Should this query be cached?
+ return ($dbh->selectrow_array('select @@identity'))[0];
+}
+
+my $number = sub { Scalar::Util::looks_like_number($_[0]) };
+
+my $decimal = sub { $_[0] =~ /^ [-+]? \d+ (?:\.\d*)? \z/x };
+
+my %noquote = (
+ int => sub { $_[0] =~ /^ [-+]? \d+ \z/x },
+ bit => => sub { $_[0] =~ /^[01]\z/ },
+ money => sub { $_[0] =~ /^\$ \d+ (?:\.\d*)? \z/x },
+ float => $number,
+ real => $number,
+ double => $number,
+ decimal => $decimal,
+ numeric => $decimal,
+);
+
+sub should_quote {
+ my $self = shift;
+ my ($type, $value) = @_;
+
+ return $self->next::method(@_) if not defined $value;
+
+ $type ||= '';
+
+ if (my $key = List::Util::first { $type =~ /$_/i } keys %noquote) {
+ return 0 if $noquote{$key}->($value);
+ } elsif (not $type) {
+# try to guess based on value
+ return 0 if $number->($value) || $noquote->{money}->($value);
+ }
+
+ return $self->next::method(@_);
+}
+
+1;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Sybase::NoBindVars - Storage::DBI subclass for Sybase
+without placeholder support
+
+=head1 DESCRIPTION
+
+If you're using this driver than your version of Sybase does not support
+placeholders. You can check with:
+
+ $dbh->{syb_dynamic_supported}
+
+You can also enable this driver explicitly using:
+
+ my $schema = SchemaClass->clone;
+ $schema->storage_type('::DBI::Sybase::NoBindVars');
+ $schema->connect($dsn, $user, $pass, \%opts);
+
+See the discussion in L<< DBD::Sybase/Using ? Placeholders & bind parameters to
+$sth->execute >> for details on the pros and cons of using placeholders.
+
+One advantage of not using placeholders is that C<select @@identity> will work
+for obtainging the last insert id of an C<IDENTITY> column, instead of having to
+do C<select max(col)> as the base Sybase driver does.
+
+When using this driver, bind variables will be interpolated (properly quoted of
+course) into the SQL query itself, without using placeholders.
+
+The caching of prepared statements is also explicitly disabled, as the
+interpolation renders it useless.
+
+=head1 AUTHORS
+
+See L<DBIx::Class/CONTRIBUTORS>.
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+# vim:sts=2 sw=2:
use warnings;
use Test::More;
+use Test::Exception;
use lib qw(t/lib);
use DBICTest;
+use DateTime::Format::Sybase;
my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SYBASE_${_}" } qw/DSN USER PASS/};
plan skip_all => 'Set $ENV{DBICTEST_SYBASE_DSN}, _USER and _PASS to run this test'
unless ($dsn && $user);
-plan tests => 12;
+plan tests => (26 + 4*2)*2;
-my $schema = DBICTest::Schema->connect($dsn, $user, $pass, {AutoCommit => 1});
+my @storage_types = (
+ 'DBI::Sybase',
+ 'DBI::Sybase::NoBindVars',
+);
+my $schema;
-$schema->storage->ensure_connected;
-isa_ok( $schema->storage, 'DBIx::Class::Storage::DBI::Sybase' );
+for my $storage_type (@storage_types) {
+ $schema = DBICTest::Schema->clone;
-$schema->storage->dbh_do (sub {
- my ($storage, $dbh) = @_;
- eval { $dbh->do("DROP TABLE artist") };
- $dbh->do(<<'SQL');
+ unless ($storage_type eq 'DBI::Sybase') { # autodetect
+ $schema->storage_type("::$storage_type");
+ }
+ $schema->connection($dsn, $user, $pass, {
+ AutoCommit => 1,
+ on_connect_call => [
+ [ 'datetime_setup' ],
+ [ blob_setup => log_on_update => 1 ], # this is a safer option
+ ],
+ });
+ $schema->storage->ensure_connected;
+
+ isa_ok( $schema->storage, "DBIx::Class::Storage::$storage_type" );
+
+ $schema->storage->dbh_do (sub {
+ my ($storage, $dbh) = @_;
+ eval { $dbh->do("DROP TABLE artist") };
+ $dbh->do(<<'SQL');
CREATE TABLE artist (
- artistid INT IDENTITY NOT NULL,
+ artistid INT IDENTITY PRIMARY KEY,
name VARCHAR(100),
rank INT DEFAULT 13 NOT NULL,
- charfield CHAR(10) NULL,
- primary key(artistid)
+ charfield CHAR(10) NULL
)
-
SQL
+ });
-});
-
-my %seen_id;
+ my %seen_id;
-# fresh $schema so we start unconnected
-$schema = DBICTest::Schema->connect($dsn, $user, $pass, {AutoCommit => 1});
+# so we start unconnected
+ $schema->storage->disconnect;
# test primary key handling
-my $new = $schema->resultset('Artist')->create({ name => 'foo' });
-ok($new->artistid > 0, "Auto-PK worked");
+ my $new = $schema->resultset('Artist')->create({ name => 'foo' });
+ ok($new->artistid > 0, "Auto-PK worked");
-$seen_id{$new->artistid}++;
+ $seen_id{$new->artistid}++;
-# test LIMIT support
-for (1..6) {
+ for (1..6) {
$new = $schema->resultset('Artist')->create({ name => 'Artist ' . $_ });
is ( $seen_id{$new->artistid}, undef, "id for Artist $_ is unique" );
$seen_id{$new->artistid}++;
-}
+ }
-my $it;
+# test simple count
+ is ($schema->resultset('Artist')->count, 7, 'count(*) of whole table ok');
-$it = $schema->resultset('Artist')->search( {}, {
+# test LIMIT support
+ my $it = $schema->resultset('Artist')->search({
+ artistid => { '>' => 0 }
+ }, {
rows => 3,
order_by => 'artistid',
-});
-
-TODO: {
- local $TODO = 'Sybase is very very fucked in the limit department';
+ });
- is( $it->count, 3, "LIMIT count ok" );
-}
-
-# The iterator still works correctly with rows => 3, even though the sql is
-# fucked, very interesting.
+ is( $it->count, 3, "LIMIT count ok" );
-is( $it->next->name, "foo", "iterator->next ok" );
-$it->next;
-is( $it->next->name, "Artist 2", "iterator->next ok" );
-is( $it->next, undef, "next past end of resultset ok" );
+ is( $it->next->name, "foo", "iterator->next ok" );
+ $it->next;
+ is( $it->next->name, "Artist 2", "iterator->next ok" );
+ is( $it->next, undef, "next past end of resultset ok" );
+# now try with offset
+ $it = $schema->resultset('Artist')->search({}, {
+ rows => 3,
+ offset => 3,
+ order_by => 'artistid',
+ });
+
+ is( $it->count, 3, "LIMIT with offset count ok" );
+
+ is( $it->next->name, "Artist 3", "iterator->next ok" );
+ $it->next;
+ is( $it->next->name, "Artist 5", "iterator->next ok" );
+ is( $it->next, undef, "next past end of resultset ok" );
+
+# now try a grouped count
+ $schema->resultset('Artist')->create({ name => 'Artist 6' })
+ for (1..6);
+
+ $it = $schema->resultset('Artist')->search({}, {
+ group_by => 'name'
+ });
+
+ is( $it->count, 7, 'COUNT of GROUP_BY ok' );
+
+# Test DateTime inflation with DATETIME
+ my @dt_types = (
+ ['DATETIME', '2004-08-21T14:36:48.080Z'],
+ ['SMALLDATETIME', '2004-08-21T14:36:00.000Z'], # minute precision
+ );
+
+ for my $dt_type (@dt_types) {
+ my ($type, $sample_dt) = @$dt_type;
+
+ eval { $schema->storage->dbh->do("DROP TABLE track") };
+ $schema->storage->dbh->do(<<"SQL");
+CREATE TABLE track (
+ trackid INT IDENTITY PRIMARY KEY,
+ cd INT,
+ position INT,
+ last_updated_on $type,
+)
+SQL
+ ok(my $dt = DateTime::Format::Sybase->parse_datetime($sample_dt));
+
+ my $row;
+ ok( $row = $schema->resultset('Track')->create({
+ last_updated_on => $dt,
+ cd => 1,
+ }));
+ ok( $row = $schema->resultset('Track')
+ ->search({ trackid => $row->trackid }, { select => ['last_updated_on'] })
+ ->first
+ );
+ is( $row->updated_date, $dt, 'DateTime inflation works' );
+ }
+
+# mostly stole the blob stuff Nniuq wrote for t/73oracle.t
+ my $dbh = $schema->storage->dbh;
+ {
+ local $SIG{__WARN__} = sub {};
+ eval { $dbh->do('DROP TABLE bindtype_test') };
+
+ $dbh->do(qq[
+ CREATE TABLE bindtype_test
+ (
+ id INT PRIMARY KEY,
+ bytea INT NULL,
+ blob IMAGE NULL,
+ clob TEXT NULL
+ )
+ ],{ RaiseError => 1, PrintError => 1 });
+ }
+
+ 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)) {
+ no warnings 'uninitialized';
+ $id++;
+
+ eval { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) };
+ ok(!$@, "inserted $size $type without dying");
+ diag $@ if $@;
+
+ ok(eval {
+ $rs->search({ id=> $id }, { select => [$type] })->single->$type
+ } eq $binstr{$size}, "verified inserted $size $type" );
+ }
+ }
+}
# clean up our mess
END {
- my $dbh = eval { $schema->storage->_dbh };
- $dbh->do('DROP TABLE artist') if $dbh;
+ if (my $dbh = eval { $schema->storage->_dbh }) {
+ $dbh->do('DROP TABLE artist');
+ $dbh->do('DROP TABLE track');
+ $dbh->do('DROP TABLE bindtype_test');
+ }
}
-
projects / dbsrgits/DBIx-Class.git / commitdiff