X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI.pm;h=cee1c17da542e70bcbc8ff1324f000b9faab3c14;hb=d23f094eba0891a2afcc699c6de3be88202d9751;hp=6e277256900d8adfc3cf0ad9f257a63adc57de51;hpb=fed966517e558cfc9ee505d44add2d04e77a7d3d;p=dbsrgits%2FDBIx-Class-Historic.git

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index 6e27725..cee1c17 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -1,4 +1,5 @@
 package DBIx::Class::Storage::DBI;
+# -*- mode: cperl; cperl-indent-level: 2 -*-
 
 use base 'DBIx::Class::Storage';
 
@@ -364,6 +365,12 @@ sub ensure_connected {
   }
 }
 
+=head2 dbh
+
+Returns the dbh - a data base handle of class L<DBI>.
+
+=cut
+
 sub dbh {
   my ($self) = @_;
 
@@ -470,10 +477,13 @@ an entire code block to be executed transactionally.
 
 sub txn_begin {
   my $self = shift;
-  if (($self->{transaction_depth}++ == 0) and ($self->dbh->{AutoCommit})) {
-    $self->debugfh->print("BEGIN WORK\n")
-      if ($self->debug);
-    $self->dbh->begin_work;
+  if ($self->{transaction_depth}++ == 0) {
+    my $dbh = $self->dbh;
+    if ($dbh->{AutoCommit}) {
+      $self->debugfh->print("BEGIN WORK\n")
+        if ($self->debug);
+      $dbh->begin_work;
+    }
   }
 }
 
@@ -486,10 +496,11 @@ Issues a commit against the current dbh.
 sub txn_commit {
   my $self = shift;
   if ($self->{transaction_depth} == 0) {
-    unless ($self->dbh->{AutoCommit}) {
+    my $dbh = $self->dbh;
+    unless ($dbh->{AutoCommit}) {
       $self->debugfh->print("COMMIT\n")
         if ($self->debug);
-      $self->dbh->commit;
+      $dbh->commit;
     }
   }
   else {
@@ -514,10 +525,11 @@ sub txn_rollback {
 
   eval {
     if ($self->{transaction_depth} == 0) {
-      unless ($self->dbh->{AutoCommit}) {
+      my $dbh = $self->dbh;
+      unless ($dbh->{AutoCommit}) {
         $self->debugfh->print("ROLLBACK\n")
           if ($self->debug);
-        $self->dbh->rollback;
+        $dbh->rollback;
       }
     }
     else {
@@ -546,7 +558,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) };
@@ -641,14 +653,16 @@ Returns database type info for a given table columns.
 sub columns_info_for {
   my ($self, $table) = @_;
 
-  if ($self->dbh->can('column_info')) {
+  my $dbh = $self->dbh;
+
+  if ($dbh->can('column_info')) {
     my %result;
-    my $old_raise_err = $self->dbh->{RaiseError};
-    my $old_print_err = $self->dbh->{PrintError};
-    $self->dbh->{RaiseError} = 1;
-    $self->dbh->{PrintError} = 0;
+    my $old_raise_err = $dbh->{RaiseError};
+    my $old_print_err = $dbh->{PrintError};
+    $dbh->{RaiseError} = 1;
+    $dbh->{PrintError} = 0;
     eval {
-      my $sth = $self->dbh->column_info( undef, undef, $table, '%' );
+      my $sth = $dbh->column_info( undef, undef, $table, '%' );
       $sth->execute();
       while ( my $info = $sth->fetchrow_hashref() ){
         my %column_info;
@@ -660,21 +674,21 @@ sub columns_info_for {
         $result{$info->{COLUMN_NAME}} = \%column_info;
       }
     };
-    $self->dbh->{RaiseError} = $old_raise_err;
-    $self->dbh->{PrintError} = $old_print_err;
+    $dbh->{RaiseError} = $old_raise_err;
+    $dbh->{PrintError} = $old_print_err;
     return \%result if !$@;
   }
 
   my %result;
-  my $sth = $self->dbh->prepare("SELECT * FROM $table WHERE 1=0");
+  my $sth = $dbh->prepare("SELECT * FROM $table WHERE 1=0");
   $sth->execute;
   my @columns = @{$sth->{NAME_lc}};
   for my $i ( 0 .. $#columns ){
     my %column_info;
     my $type_num = $sth->{TYPE}->[$i];
     my $type_name;
-    if(defined $type_num && $self->dbh->can('type_info')) {
-      my $type_info = $self->dbh->type_info($type_num);
+    if(defined $type_num && $dbh->can('type_info')) {
+      my $type_info = $dbh->type_info($type_num);
       $type_name = $type_info->{TYPE_NAME} if $type_info;
     }
     $column_info{data_type} = $type_name ? $type_name : $type_num;
@@ -701,24 +715,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 $_";
     }