From: Rafael Kitover <rkitover@cpan.org>
Date: Sat, 23 May 2009 19:46:11 +0000 (+0000)
Subject: Sybase bindvar and IC::DT support
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0814e8043fb4dbad52bab9d77f5c9891feaa77d9;p=dbsrgits%2FDBIx-Class-Historic.git

Sybase bindvar and IC::DT support
---

diff --git a/Makefile.PL b/Makefile.PL
index 8b730ca..7d8175f 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -87,6 +87,7 @@ my %force_requires_if_author = (
   'Hash::Merge',                  => 0.11,
 
   # t/96_is_deteministic_value.t
+  # t/746sybase.t
   'DateTime::Format::Strptime' => 0,
 );
 
diff --git a/lib/DBIx/Class/Storage/DBI/Sybase.pm b/lib/DBIx/Class/Storage/DBI/Sybase.pm
index 1a63bc8..28b4059 100644
--- a/lib/DBIx/Class/Storage/DBI/Sybase.pm
+++ b/lib/DBIx/Class/Storage/DBI/Sybase.pm
@@ -3,28 +3,51 @@ package DBIx::Class::Storage::DBI::Sybase;
 use strict;
 use warnings;
 
-use base qw/DBIx::Class::Storage::DBI::NoBindVars/;
+use base qw/DBIx::Class::Storage::DBI/;
 
 sub _rebless {
-    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;
-        }
+  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 { # probably real Sybase
+      if (not $self->dbh->{syb_dynamic_supported}) {
+        bless $self, 'DBIx::Class::Storage:DBI::Sybase::NoBindVars';
+        $self->_rebless;
+      }
+
+      $self->dbh->syb_date_fmt('ISO_strict');
+      $self->dbh->do('set dateformat mdy');
     }
+  }
 }
 
 sub _dbh_last_insert_id {
-    my $self = shift;
-    my $sth = $self->_dbh->prepare_cached('select @@identity');
-    ($self->_dbh->selectrow_array($sth))[0];
+  my ($self, $dbh, $source, $col) = @_;
+
+  if (not $self->dbh->{syb_dynamic_supported}) {
+    # @@identity works only if not using placeholders
+    # Should this query be cached?
+    return ($dbh->selectrow_array('select @@identity'))[0];
+  }
+
+  # sorry, there's no other way!
+  my $sth = $dbh->prepare_cached("select max($col) from ".$source->from);
+  return ($dbh->selectrow_array($sth))[0];
 }
 
+sub datetime_parser_type { "DBIx::Class::Storage::DBI::Sybase::DateTime" }
+
 1;
 
 =head1 NAME
@@ -39,21 +62,41 @@ L<DBIx::Class::Storage::DBI::Sybase::MSSQL>.
 
 =head1 CAVEATS
 
-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)
+If your version of Sybase does not support placeholders, then this storage
+driver uses L<DBIx::Class::Storage::DBI::NoBindVars> as a base,
+
+In which case, bind variables will be interpolated (properly quoted of course)
 into the SQL query itself, without using bind placeholders.
 
 More importantly this means that caching of prepared statements is explicitly
 disabled, as the interpolation renders it useless.
 
+If your version of Sybase B<DOES> support placeholders (check
+C<<$dbh->{syb_dynamic_supported}>> then unfortunately there's no way to get the
+C<last_insert_id> without doing a C<select max(col)>.
+
+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>.
+
+You will need the L<DateTime::Format::Strptime> module if you are going to use
+L<DBIx::Class::InflateColumn::DateTime>.
+
 =head1 AUTHORS
 
 Brandon L Black <blblack@gmail.com>
 
 Justin Hunter <justin.d.hunter@gmail.com>
 
+Rafael Kitover <rkitover@cpan.org>
+
 =head1 LICENSE
 
 You may distribute this code under the same terms as Perl itself.
 
 =cut
+# vim:sts=2 sw=2:
diff --git a/lib/DBIx/Class/Storage/DBI/Sybase/DateTime.pm b/lib/DBIx/Class/Storage/DBI/Sybase/DateTime.pm
new file mode 100644
index 0000000..310d828
--- /dev/null
+++ b/lib/DBIx/Class/Storage/DBI/Sybase/DateTime.pm
@@ -0,0 +1,19 @@
+package 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;
diff --git a/lib/DBIx/Class/Storage/DBI/Sybase/MSSQL.pm b/lib/DBIx/Class/Storage/DBI/Sybase/MSSQL.pm
index f4eee43..cc3ad12 100644
--- a/lib/DBIx/Class/Storage/DBI/Sybase/MSSQL.pm
+++ b/lib/DBIx/Class/Storage/DBI/Sybase/MSSQL.pm
@@ -3,7 +3,11 @@ package DBIx::Class::Storage::DBI::Sybase::MSSQL;
 use strict;
 use warnings;
 
-use base qw/DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server DBIx::Class::Storage::DBI::Sybase/;
+use base qw/
+  DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server
+  DBIx::Class::Storage::DBI::NoBindVars
+  DBIx::Class::Storage::DBI::Sybase
+/;
 
 1;
 
diff --git a/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm b/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
index 1c8e36d..63f45ee 100644
--- a/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
+++ b/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
@@ -5,6 +5,7 @@ use warnings;
 
 use base qw/
   DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server
+  DBIx::Class::Storage::DBI::NoBindVars
   DBIx::Class::Storage::DBI::Sybase
 /;
 
diff --git a/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm b/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm
new file mode 100644
index 0000000..bb30d7a
--- /dev/null
+++ b/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm
@@ -0,0 +1,8 @@
+package DBIx::Class::Storage::DBI::Sybase::NoBindVars;
+
+use base qw/
+  DBIx::Class::Storage::DBI::NoBindVars
+  DBIx::Class::Storage::DBI::Sybase
+/;
+
+1;
diff --git a/t/746sybase.t b/t/746sybase.t
index f09862f..035091f 100644
--- a/t/746sybase.t
+++ b/t/746sybase.t
@@ -4,13 +4,14 @@ use warnings;
 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 => 15;
 
 my $schema = DBICTest::Schema->connect($dsn, $user, $pass, {AutoCommit => 1});
 
@@ -20,16 +21,24 @@ isa_ok( $schema->storage, 'DBIx::Class::Storage::DBI::Sybase' );
 $schema->storage->dbh_do (sub {
     my ($storage, $dbh) = @_;
     eval { $dbh->do("DROP TABLE artist") };
+    eval { $dbh->do("DROP TABLE track") };
     $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
 
+# we only need the DT
+    $dbh->do(<<'SQL');
+CREATE TABLE track (
+   trackid INT IDENTITY PRIMARY KEY,
+   cd INT,
+   position INT,
+   last_updated_on DATETIME,
+)
 SQL
 
 });
@@ -52,9 +61,7 @@ for (1..6) {
     $seen_id{$new->artistid}++;
 }
 
-my $it;
-
-$it = $schema->resultset('Artist')->search( {}, {
+my $it = $schema->resultset('Artist')->search( {}, {
     rows => 3,
     order_by => 'artistid',
 });
@@ -73,10 +80,26 @@ $it->next;
 is( $it->next->name, "Artist 2", "iterator->next ok" );
 is( $it->next, undef, "next past end of resultset ok" );
 
+# Test DateTime inflation
+
+my $dt = DBIx::Class::Storage::DBI::Sybase::DateTime
+    ->parse_datetime('2004-08-21T14:36:48.080Z');
+
+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');
+    }
 }
-
diff --git a/t/count/distinct.t b/t/count/distinct.t
index b5f8ba7..04900d2 100644
--- a/t/count/distinct.t
+++ b/t/count/distinct.t
@@ -13,7 +13,7 @@ my $schema = DBICTest->init_schema();
 
 eval "use DBD::SQLite";
 plan skip_all => 'needs DBD::SQLite for testing' if $@;
-plan tests => 21;
+plan tests => 22;
 
 # The tag Blue is assigned to cds 1 2 3 and 5
 # The tag Cheesy is assigned to cds 2 4 and 5
@@ -74,6 +74,9 @@ is($rs->count, 7, 'Count with literal SQL and multiple group_by');
 $rs = $schema->resultset('Tag')->search({ tag => 'Blue' }, { '+select' => { max => 'tagid' }, distinct => 1 });
 is($rs->count, 4, 'Count with +select aggreggate');
 
+$rs = $schema->resultset('Tag')->search({}, { select => 'length(me.tag)', distinct => 1 });
+is($rs->count, 3, 'Count by distinct function result as select literal');
+
 my @warnings;
 {
   local $SIG{__WARN__} = sub { push @warnings, shift };