NoBindVars + Sybase + MSSQL stuff
Brandon L. Black [Fri, 9 Jun 2006 19:45:28 +0000 (19:45 +0000)]
lib/DBIx/Class/Storage/DBI/MSSQL.pm
lib/DBIx/Class/Storage/DBI/NoBindVars.pm [new file with mode: 0644]
lib/DBIx/Class/Storage/DBI/Sybase.pm [new file with mode: 0644]
t/74mssql.t

index a303d25..38653f6 100644 (file)
@@ -1,12 +1,10 @@
 package DBIx::Class::Storage::DBI::MSSQL;
-\r
+
 use strict;
 use warnings;
-\r
-use base qw/DBIx::Class::Storage::DBI/;
-\r
-# __PACKAGE__->load_components(qw/PK::Auto/);
-\r
+
+use base qw/DBIx::Class::Storage::DBI::Sybase/;
+
 sub last_insert_id {
   my( $id ) = $_[0]->_dbh->selectrow_array('SELECT @@IDENTITY' );
   return $id;
@@ -19,29 +17,29 @@ sub build_datetime_parser {
   $self->throw_exception("Couldn't load ${type}: $@") if $@;
   return $type->new( pattern => '%m/%d/%Y %H:%M:%S' );
 }
-\r
+
 1;
-\r
+
 =head1 NAME
-\r
-DBIx::Class::Storage::DBI::MSSQL - Automatic primary key class for MSSQL
-\r
+
+DBIx::Class::Storage::DBI::MSSQL - Storage::DBI subclass for MSSQL
+
 =head1 SYNOPSIS
-\r
-  # In your table classes
-  __PACKAGE__->load_components(qw/PK::Auto Core/);
-  __PACKAGE__->set_primary_key('id');
-\r
-=head1 DESCRIPTION
-\r
-This class implements autoincrements for MSSQL.
-\r
+
+This subclass supports MSSQL.  As MSSQL is usually used via a
+differently-named DBD such as L<DBD::Sybase>, it does not get
+autodetected by DBD-type like the other drivers, and you will need to
+specify this storage driver manually, as in:
+
+  $schema->storage_type('::DBI::MSSQL');
+  $schema->connect_info('dbi:Sybase:....', ...);
+
 =head1 AUTHORS
-\r
+
 Brian Cassidy <bricas@cpan.org>
-\r
+
 =head1 LICENSE
-\r
+
 You may distribute this code under the same terms as Perl itself.
-\r
+
 =cut
diff --git a/lib/DBIx/Class/Storage/DBI/NoBindVars.pm b/lib/DBIx/Class/Storage/DBI/NoBindVars.pm
new file mode 100644 (file)
index 0000000..f119013
--- /dev/null
@@ -0,0 +1,71 @@
+package DBIx::Class::Storage::DBI::NoBindVars;
+
+use strict;
+use warnings;
+
+use base 'DBIx::Class::Storage::DBI';
+
+sub _execute {
+  my ($self, $op, $extra_bind, $ident, @args) = @_;
+  my ($sql, @bind) = $self->sql_maker->$op($ident, @args);
+  unshift(@bind, @$extra_bind) if $extra_bind;
+  if ($self->debug) {
+    my @debug_bind = map { defined $_ ? qq{'$_'} : q{'NULL'} } @bind;
+    $self->debugobj->query_start($sql, @debug_bind);
+  }
+
+  while(my $bvar = shift @bind) {
+    $bvar = $self->dbh->quote($bvar);
+    $sql =~ s/\?/$bvar/;
+  }
+
+  my $sth = eval { $self->sth($sql,$op) };
+
+  if (!$sth || $@) {
+    $self->throw_exception(
+      'no sth generated via sql (' . ($@ || $self->_dbh->errstr) . "): $sql"
+    );
+  }
+
+  my $rv;
+  if ($sth) {
+    my $time = time();
+    $rv = eval { $sth->execute };
+
+    if ($@ || !$rv) {
+      $self->throw_exception("Error executing '$sql': ".($@ || $sth->errstr));
+    }
+  } else {
+    $self->throw_exception("'$sql' did not generate a statement.");
+  }
+  if ($self->debug) {
+    my @debug_bind = map { defined $_ ? qq{`$_'} : q{`NULL'} } @bind;
+    $self->debugobj->query_end($sql, @debug_bind);
+  }
+  return (wantarray ? ($rv, $sth, @bind) : $rv);
+}
+
+1;
+
+=head1 NAME 
+
+DBIx::Class::Storage::DBI::NoBindVars - Sometime DBDs have poor to no support for bind variables
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+This class allows queries to work when the DBD or underlying library does not
+support the usual C<?> placeholders, or at least doesn't support them very
+well, as is the case with L<DBD::Sybase>
+
+=head1 AUTHORS
+
+Brandon Black <blblack@gmail.com>
+trym
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
diff --git a/lib/DBIx/Class/Storage/DBI/Sybase.pm b/lib/DBIx/Class/Storage/DBI/Sybase.pm
new file mode 100644 (file)
index 0000000..3a20a1c
--- /dev/null
@@ -0,0 +1,26 @@
+package DBIx::Class::Storage::DBI::Sybase;
+
+use strict;
+use warnings;
+
+use base qw/DBIx::Class::Storage::DBI::NoBindVars/;
+
+1;
+
+=head1 NAME
+
+DBIx::Class::Storage::DBI::Sybase - Storage::DBI subclass for Sybase
+
+=head1 SYNOPSIS
+
+This subclass supports L<DBD::Sybase>.
+
+=head1 AUTHORS
+
+Brandon L Black <blblack@gmail.com>
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
index c879ca6..8061ba1 100644 (file)
@@ -14,6 +14,7 @@ plan skip_all => 'Set $ENV{DBICTEST_MSSQL_DSN}, _USER and _PASS to run this test
 
 plan tests => 4;
 
+DBICTest::Schema->storage_type('::DBI::MSSQL');
 DBICTest::Schema->compose_connection( 'MSSQLTest' => $dsn, $user, $pass );
 
 my $dbh = MSSQLTest->schema->storage->dbh;