Merge 'DBIx-Class-current' into 'resultset-new-refactor'
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI.pm
index 7752224..364b265 100644 (file)
@@ -1,4 +1,5 @@
 package DBIx::Class::Storage::DBI;
+# -*- mode: cperl; cperl-indent-level: 2 -*-
 
 use base 'DBIx::Class::Storage';
 
@@ -20,8 +21,6 @@ sub select {
   my ($self, $table, $fields, $where, $order, @rest) = @_;
   $table = $self->_quote($table) unless ref($table);
   @rest = (-1) unless defined $rest[0];
-  die "LIMIT 0 Does Not Compute" if $rest[0] == 0;
-    # and anyway, SQL::Abstract::Limit will cause a barf if we don't first
   local $self->{having_bind} = [];
   my ($sql, @ret) = $self->SUPER::select(
     $table, $self->_recurse_fields($fields), $where, $order, @rest
@@ -242,7 +241,7 @@ use base qw/DBIx::Class/;
 __PACKAGE__->load_components(qw/AccessorGroup/);
 
 __PACKAGE__->mk_group_accessors('simple' =>
-  qw/connect_info _dbh _sql_maker _conn_pid _conn_tid debug debugfh
+  qw/_connect_info _dbh _sql_maker _conn_pid _conn_tid debug debugfh
      cursor on_connect_do transaction_depth/);
 
 sub new {
@@ -279,6 +278,25 @@ This class represents the connection to the database
 
 =cut
 
+=head2 connect_info
+
+Connection information arrayref.  Can either be the same arguments
+one would pass to DBI->connect, or a code-reference which returns
+a connected database handle.  In either case, there is an optional
+final element in the arrayref, which can hold a hashref of
+connection-specific Storage::DBI options.  These include
+C<on_connect_do>, and the sql_maker options C<limit_dialect>,
+C<quote_char>, and C<name_sep>.  Examples:
+
+  ->connect_info([ 'dbi:SQLite:./foo.db' ]);
+  ->connect_info(sub { DBI->connect(...) });
+  ->connect_info([ 'dbi:Pg:dbname=foo',
+                   'postgres',
+                   '',
+                   { AutoCommit => 0 },
+                   { quote_char => q{`}, name_sep => q{@} },
+                 ]);
+
 =head2 on_connect_do
 
 Executes the sql statements given as a listref on every db connect.
@@ -368,11 +386,46 @@ sub sql_maker {
   return $self->_sql_maker;
 }
 
+sub connect_info {
+    my ($self, $info_arg) = @_;
+
+    if($info_arg) {
+        my $info = [ @$info_arg ]; # copy because we can alter it
+        my $last_info = $info->[-1];
+        if(ref $last_info eq 'HASH') {
+            my $used;
+            if(my $on_connect_do = $last_info->{on_connect_do}) {
+               $used = 1;
+               $self->on_connect_do($on_connect_do);
+            }
+            for my $sql_maker_opt (qw/limit_dialect quote_char name_sep/) {
+                if(my $opt_val = $last_info->{$sql_maker_opt}) {
+                    $used = 1;
+                    $self->sql_maker->$sql_maker_opt($opt_val);
+                }
+            }
+
+            # remove our options hashref if it was there, to avoid confusing
+            #   DBI in the case the user didn't use all 4 DBI options, as in:
+            #   [ 'dbi:SQLite:foo.db', { quote_char => q{`} } ]
+            pop(@$info) if $used;
+        }
+
+        $self->_connect_info($info);
+    }
+
+    $self->_connect_info;
+}
+
 sub _populate_dbh {
   my ($self) = @_;
-  my @info = @{$self->connect_info || []};
+  my @info = @{$self->_connect_info || []};
   $self->_dbh($self->_connect(@info));
-  my $driver = $self->_dbh->{Driver}->{Name};
+  my $dbh = $self->_dbh;
+  my $driver = $dbh->{Driver}->{Name};
+  if ( $driver eq 'ODBC' and $dbh->get_info(17) =~ m{^DB2/400} ) {
+    $driver = 'ODBC400';
+  }
   eval "require DBIx::Class::Storage::DBI::${driver}";
   unless ($@) {
     bless $self, "DBIx::Class::Storage::DBI::${driver}";
@@ -509,7 +562,7 @@ sub _execute {
   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;
+      my @debug_bind = map { defined $_ ? qq{'$_'} : q{'NULL'} } @bind;
       $self->debugfh->print("$sql: " . join(', ', @debug_bind) . "\n");
   }
   my $sth = eval { $self->sth($sql,$op) };
@@ -568,8 +621,6 @@ sub _select {
       $self->sql_maker->_default_limit_syntax eq "GenericSubQ") {
         $attrs->{software_limit} = 1;
   } else {
-    $self->throw_exception("rows attribute must be positive if present")
-      if (defined($attrs->{rows}) && !($attrs->{rows} > 0));
     push @args, $attrs->{rows}, $attrs->{offset};
   }
   return $self->_execute(@args);
@@ -615,7 +666,8 @@ sub columns_info_for {
     $dbh->{RaiseError} = 1;
     $dbh->{PrintError} = 0;
     eval {
-      my $sth = $dbh->column_info( undef, undef, $table, '%' );
+      my ($schema,$tab) = $table =~ /^(.+?)\.(.+)$/ ? ($1,$2) : (undef,$table);
+      my $sth = $dbh->column_info( undef,$schema, $tab, '%' );
       $sth->execute();
       while ( my $info = $sth->fetchrow_hashref() ){
         my %column_info;
@@ -668,24 +720,101 @@ sub last_insert_id {
 
 sub sqlt_type { shift->dbh->{Driver}->{Name} }
 
+sub create_ddl_dir
+{
+  my ($self, $schema, $databases, $version, $dir, $sqltargs) = @_;
+
+  if(!$dir || !-d $dir)
+  {
+    warn "No directory given, using ./\n";
+    $dir = "./";
+  }
+  $databases ||= ['MySQL', 'SQLite', 'PostgreSQL'];
+  $databases = [ $databases ] if(ref($databases) ne 'ARRAY');
+  $version ||= $schema->VERSION || '1.x';
+
+  eval "use SQL::Translator";
+  $self->throw_exception("Can't deploy without SQL::Translator: $@") if $@;
+
+  my $sqlt = SQL::Translator->new({
+#      debug => 1,
+      add_drop_table => 1,
+  });
+  foreach my $db (@$databases)
+  {
+    $sqlt->reset();
+    $sqlt->parser('SQL::Translator::Parser::DBIx::Class');
+#    $sqlt->parser_args({'DBIx::Class' => $schema);
+    $sqlt->data($schema);
+    $sqlt->producer($db);
+
+    my $file;
+    my $filename = $schema->ddl_filename($db, $dir, $version);
+    if(-e $filename)
+    {
+      $self->throw_exception("$filename already exists, skipping $db");
+      next;
+    }
+    open($file, ">$filename") 
+      or $self->throw_exception("Can't open $filename for writing ($!)");
+    my $output = $sqlt->translate;
+#use Data::Dumper;
+#    print join(":", keys %{$schema->source_registrations});
+#    print Dumper($sqlt->schema);
+    if(!$output)
+    {
+      $self->throw_exception("Failed to translate to $db. (" . $sqlt->error . ")");
+      next;
+    }
+    print $file $output;
+    close($file);
+  }
+
+}
+
 sub deployment_statements {
-  my ($self, $schema, $type, $sqltargs) = @_;
+  my ($self, $schema, $type, $version, $dir, $sqltargs) = @_;
   $type ||= $self->sqlt_type;
+  $version ||= $schema->VERSION || '1.x';
+  $dir ||= './';
   eval "use SQL::Translator";
-  $self->throw_exception("Can't deploy without SQL::Translator: $@") if $@;
-  eval "use SQL::Translator::Parser::DBIx::Class;";
-  $self->throw_exception($@) if $@;
-  eval "use SQL::Translator::Producer::${type};";
-  $self->throw_exception($@) if $@;
-  my $tr = SQL::Translator->new(%$sqltargs);
-  SQL::Translator::Parser::DBIx::Class::parse( $tr, $schema );
-  return "SQL::Translator::Producer::${type}"->can('produce')->($tr);
+  if(!$@)
+  {
+    eval "use SQL::Translator::Parser::DBIx::Class;";
+    $self->throw_exception($@) if $@;
+    eval "use SQL::Translator::Producer::${type};";
+    $self->throw_exception($@) if $@;
+    my $tr = SQL::Translator->new(%$sqltargs);
+    SQL::Translator::Parser::DBIx::Class::parse( $tr, $schema );
+    return "SQL::Translator::Producer::${type}"->can('produce')->($tr);
+  }
+
+  my $filename = $schema->ddl_filename($type, $dir, $version);
+  if(!-f $filename)
+  {
+#      $schema->create_ddl_dir([ $type ], $version, $dir, $sqltargs);
+      $self->throw_exception("No SQL::Translator, and no Schema file found, aborting deploy");
+      return;
+  }
+  my $file;
+  open($file, "<$filename") 
+      or $self->throw_exception("Can't open $filename ($!)");
+  my @rows = <$file>;
+  close($file);
+
+  return join('', @rows);
+  
 }
 
 sub deploy {
   my ($self, $schema, $type, $sqltargs) = @_;
-  foreach my $statement ( $self->deployment_statements($schema, $type, $sqltargs) ) {
+  foreach my $statement ( $self->deployment_statements($schema, $type, undef, undef, $sqltargs) ) {
     for ( split(";\n", $statement)) {
+      next if($_ =~ /^--/);
+      next if(!$_);
+#      next if($_ =~ /^DROP/m);
+      next if($_ =~ /^BEGIN TRANSACTION/m);
+      next if($_ =~ /^COMMIT/m);
       $self->debugfh->print("$_\n") if $self->debug;
       $self->dbh->do($_) or warn "SQL was:\n $_";
     }