Merge 'trunk' into 'sybase'
Rafael Kitover [Sat, 23 May 2009 20:48:06 +0000 (20:48 +0000)]
1  2 
Makefile.PL
lib/DBIx/Class/Storage/DBI/Sybase.pm
lib/DBIx/Class/Storage/DBI/Sybase/MSSQL.pm
lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm
t/746sybase.t

diff --cc Makefile.PL
@@@ -60,9 -70,24 +70,25 @@@ my %force_requires_if_author = 
    # t/52cycle.t
    'Test::Memory::Cycle'       => 0,
  
+   # t/60core.t
+   'DateTime::Format::MySQL'   => 0,
+   # t/72pg.t
+   $ENV{DBICTEST_PG_DSN}
+     ? ('Sys::SigAction'=> 0)
+     : ()
+   ,
    # t/93storage_replication.t
-   'Moose',                    => 0,
-   'MooseX::AttributeHelpers'  => 0.12,
+   'Moose',                        => 0.77,
+   'MooseX::AttributeHelpers'      => 0.12,
+   'MooseX::Types',                => 0.10,
+   'namespace::clean'              => 0.11,
+   'Hash::Merge',                  => 0.11,
+   # t/96_is_deteministic_value.t
++  # t/746sybase.t
+   'DateTime::Format::Strptime' => 0,
  );
  
  if ($Module::Install::AUTHOR) {
@@@ -3,17 -3,27 +3,51 @@@ package DBIx::Class::Storage::DBI::Syba
  use strict;
  use warnings;
  
--use base qw/DBIx::Class::Storage::DBI::NoBindVars/;
++use base qw/DBIx::Class::Storage::DBI/;
  
- my %noquote = map ($_ => 1), qw(int integer);
- sub should_quote_data_type {
+ 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;
-   my ($type) = @_;
-   return 0 if $noquote{$type};
-   return $self->next::method(@_);
++
++  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;
 -    ($self->_dbh->selectrow_array('select @@identity'))[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
@@@ -26,12 -36,23 +60,43 @@@ This subclass supports L<DBD::Sybase> f
  you are using an MSSQL database via L<DBD::Sybase>, see
  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:
@@@ -3,8 -3,7 +3,11 @@@ package DBIx::Class::Storage::DBI::Syba
  use strict;
  use warnings;
  
- use Class::C3;
- use base qw/DBIx::Class::Storage::DBI::MSSQL DBIx::Class::Storage::DBI::Sybase/;
 -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;
  
index 0000000,1c8e36d..63f45ee
mode 000000,100644..100644
--- /dev/null
@@@ -1,0 -1,44 +1,45 @@@
+ package DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server;
+ use strict;
+ use warnings;
+ use base qw/
+   DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server
++  DBIx::Class::Storage::DBI::NoBindVars
+   DBIx::Class::Storage::DBI::Sybase
+ /;
+ 1;
+ =head1 NAME
+ DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server - Storage::DBI subclass for MSSQL via
+ DBD::Sybase
+ =head1 SYNOPSIS
+ This subclass supports MSSQL connected via L<DBD::Sybase>.
+   $schema->storage_type('::DBI::Sybase::Microsoft_SQL_Server');
+   $schema->connect_info('dbi:Sybase:....', ...);
+ =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)
+ 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.
+ =head1 AUTHORS
+ Brandon L Black <blblack@gmail.com>
+ Justin Hunter <justin.d.hunter@gmail.com>
+ =head1 LICENSE
+ You may distribute this code under the same terms as Perl itself.
+ =cut
diff --cc t/746sybase.t
index 0000000,f09862f..035091f
mode 000000,100644..100644
--- /dev/null
@@@ -1,0 -1,82 +1,105 @@@
+ use strict;
+ 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});
+ $schema->storage->ensure_connected;
+ 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
+ });
+ my %seen_id;
+ # fresh $schema so we start unconnected
+ $schema = DBICTest::Schema->connect($dsn, $user, $pass, {AutoCommit => 1});
+ # test primary key handling
+ my $new = $schema->resultset('Artist')->create({ name => 'foo' });
+ ok($new->artistid > 0, "Auto-PK worked");
+ $seen_id{$new->artistid}++;
+ # test LIMIT support
+ 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;
 -
 -$it = $schema->resultset('Artist')->search( {}, {
++my $it = $schema->resultset('Artist')->search( {}, {
+     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->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" );
++# 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');
++    }
+ }
 -