'namespace::clean' => 0.11,
'Hash::Merge', => 0.11,
+ # t/746sybase.t
+ 'DateTime::Format::Strptime' => 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 ) = @_;
return $alias2source;
}
-sub count {
+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/};
- my $tmp_attrs = { %$attrs };
+ return \%attrs;
+}
+
+sub count {
+ my ($self, $source, $attrs) = @_;
- # take off any pagers, record_filter is cdbi, and no point of ordering a count
- delete $tmp_attrs->{$_} for (qw/select as rows offset page order_by record_filter/);
+ my $tmp_attrs = $self->_copy_attributes_for_count($source, $attrs);
# overwrite the selector
$tmp_attrs->{select} = { count => '*' };
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 = $self->_dbh->quote($data) if $self->should_quote_data_type($datatype, $data);
$new_sql .= shift(@sql_part) . $data;
}
}
return ($new_sql, []);
}
+=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
+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_data_type { 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/;
sub _rebless {
- my $self = shift;
+ 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;
+ }
+ $self->_init_date_fmt;
+ }
+ }
+}
- 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;
- }
+sub _populate_dbh {
+ my $self = shift;
+ $self->next::method(@_);
+ $self->_init_date_fmt;
+ 1;
+}
+
+{
+ my $old_dbd_warned = 0;
+
+ 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;
}
+
+ $dbh->do('set dateformat mdy');
+
+ 1;
+ }
}
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];
+}
+
+sub count {
+ my $self = shift;
+ my ($source, $attrs) = @_;
+
+ if (not exists $attrs->{rows}) {
+ return $self->next::method(@_);
+ }
+
+ my $offset = $attrs->{offset} || 0;
+ my $total = $attrs->{rows} + $offset;
+
+ my $new_attrs = $self->_copy_attributes_for_count($source, $attrs);
+
+ 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;
}
+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
+/;
+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_data_type {
+ 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 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' );
+
+# 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