'Hash::Merge', => 0.11,
# t/96_is_deteministic_value.t
+ # t/746sybase.t
'DateTime::Format::Strptime' => 0,
);
} @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 ) = @_;
return @args;
}
-sub count {
+sub _trim_attributes_for_count {
my ($self, $source, $attrs) = @_;
-
- my $tmp_attrs = { %$attrs };
+ my %attrs = %$attrs;
# take off any column specs, any pagers, record_filter is cdbi, and no point of ordering a count
- delete $tmp_attrs->{$_} for (qw/columns +columns select +select as +as rows offset page pager order_by record_filter/);
+ delete @attrs{qw/
+ columns +columns select +select as +as rows offset page pager order_by
+ record_filter/};
+
+ return \%attrs;
+}
+
+sub count {
+ my ($self, $source, $attrs) = @_;
+
+ my $new_attrs = $self->_trim_attributes_for_count($source, $attrs);
- $tmp_attrs->{select} = { count => '*' };
- $tmp_attrs->{as} = [qw/count/];
+ $new_attrs->{select} = { count => '*' };
+ $new_attrs->{as} = [qw/count/];
- my $tmp_rs = $source->resultset_class->new($source, $tmp_attrs);
+ 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
return ($new_sql, []);
}
-=head2 should_quote_data_type
-
+=head2 should_quote_data_type
+
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
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!!!
-
+
+ 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
-
+
+=cut
+
sub should_quote_data_type { 1 }
=head1 AUTHORS
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/;
sub _rebless {
- my $self = shift;
+ my $self = shift;
- 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 (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;
+ }
+ $self->_init_date_fmt;
}
+ }
}
-sub _dbh_last_insert_id {
- my ($self, $dbh, $source, $col) = @_;
- return ($dbh->selectrow_array('select @@identity'))[0];
+sub _populate_dbh {
+ my $self = shift;
+ $self->next::method(@_);
+ $self->_init_date_fmt;
+ 1;
}
-my $noquote = {
- int => qr/^ \-? \d+ $/x,
- integer => qr/^ \-? \d+ $/x,
+{
+ my $old_dbd_warned = 0;
- # TODO maybe need to add float/real/etc
-};
+ sub _init_date_fmt {
+ my $self = shift;
+ my $dbh = $self->_dbh;
+
+ 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;
+ }
-sub should_quote_data_type {
- my $self = shift;
- my ($type, $value) = @_;
+ $dbh->do('set dateformat mdy');
+
+ 1;
+ }
+}
+
+sub _dbh_last_insert_id {
+ 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];
+}
- return $self->next::method(@_) if not defined $value;
+sub count {
+ my $self = shift;
+ my ($source, $attrs) = @_;
- if (my $re = $noquote->{$type}) {
- return 0 if $value =~ $re;
+ if (not exists $attrs->{rows}) {
+ return $self->next::method(@_);
}
- return $self->next::method(@_);
+ my $offset = $attrs->{offset} || 0;
+ my $total = $attrs->{rows} + $offset;
+
+ my $new_attrs = $self->_trim_attributes_for_count($source, $attrs);
+ $new_attrs->{select} = '1';
+ $new_attrs->{as} = ['dummy'];
+
+ 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;
}
+sub datetime_parser_type { "DBIx::Class::Storage::DBI::Sybase::DateTime" }
+
1;
=head1 NAME
=head1 SYNOPSIS
-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>.
+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 CAVEATS
+=head1 DESCRIPTION
-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.
+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.
-More importantly this means that caching of prepared statements is explicitly
-disabled, as the interpolation renders it useless.
+With this driver there is unfortunately no way to get the C<last_insert_id>
+without doing a C<select max(col)>.
-=head1 AUTHORS
+But your queries will be cached.
+
+=head1 DATES
+
+On connection C<syb_date_fmt> is set to C<ISO_strict>, e.g.:
+C<2004-08-21T14:36:48.080Z> and C<dateformat> is set to C<mdy>, e.g.:
+C<08/13/1979 18:08:55.080>.
-Brandon L Black <blblack@gmail.com>
+This works for both C<DATETIME> and C<SMALLDATETIME> columns, although
+C<SMALLDATETIME> columns only have minute precision.
+
+You will need the L<DateTime::Format::Strptime> module if you are going to use
+L<DBIx::Class::InflateColumn::DateTime>.
+
+=head1 AUTHORS
-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:
--- /dev/null
+package # hide from PAUSE
+ DBIx::Class::Storage::DBI::Sybase::DateTime;
+
+use strict;
+use warnings;
+use DateTime::Format::Strptime;
+
+my $inflate_format = DateTime::Format::Strptime->new(
+ pattern => '%Y-%m-%dT%H:%M:%S.%3NZ'
+);
+
+my $deflate_format = DateTime::Format::Strptime->new(
+ pattern => '%m/%d/%Y %H:%M:%S.%3N'
+);
+
+sub parse_datetime { shift; $inflate_format->parse_datetime(@_) }
+
+sub format_datetime { shift; $deflate_format->format_datetime(@_) }
+
+1;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Sybase::DateTime - DateTime inflation/deflation
+support for Sybase in L<DBIx::Class>.
+
+=head1 DESCRIPTION
+
+This needs to become L<DateTime::Format::Sybase>.
+
+=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 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
+/;
+
+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 $noquote = {
+ int => qr/^ \-? \d+ $/x,
+ integer => qr/^ \-? \d+ $/x,
+ # TODO maybe need to add float/real/etc
+};
+
+sub should_quote_data_type {
+ my $self = shift;
+ my ($type, $value) = @_;
+
+ return $self->next::method(@_) if not defined $value;
+
+ if (my $re = $noquote->{$type}) {
+ return 0 if $value =~ $re;
+ }
+
+ 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 Test::More;
use lib qw(t/lib);
use DBICTest;
+use DBIx::Class::Storage::DBI::Sybase::DateTime;
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 => (18 + 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});
+ $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( {}, {
- rows => 3,
- order_by => 'artistid',
-});
+# test LIMIT support
-TODO: {
- local $TODO = 'Sybase is very very fucked in the limit department';
+## avoid quoting bug with NoBindVars for now
+# my $it = $schema->resultset('Artist')->search({artistid => { '>' => 0 }}, {
- is( $it->count, 3, "LIMIT count ok" );
-}
+ my $it = $schema->resultset('Artist')->search({}, {
+ rows => 3,
+ order_by => 'artistid',
+ });
-# 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' );
+
+ SKIP: {
+ skip 'quoting bug with NoBindVars', 4*2
+ if $storage_type eq 'DBI::Sybase::NoBindVars';
+
+# 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 = DBIx::Class::Storage::DBI::Sybase::DateTime
+ ->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' );
+ }
+ }
+}
# 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');
+ }
}
-
projects / dbsrgits/DBIx-Class.git / commitdiff