X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI.pm;h=806cef8aadce3cfde9908c7313ce6be6fdef8084;hb=2eebd801e7300ecc24a68c0062f35aa72775908f;hp=fbf0c8b1174d89db9fb52e8200c3025cc23b5c4a;hpb=d4d46d1913b15af0536c4135a652ebcec967fde0;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index fbf0c8b..806cef8 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -600,7 +600,7 @@ sub dbh_do {
 
   eval {
     $self->_verify_pid if $dbh;
-    if( !$dbh ) {
+    if(!$self->_dbh) {
         $self->_populate_dbh;
         $dbh = $self->_dbh;
     }
@@ -709,6 +709,28 @@ sub disconnect {
   }
 }
 
+=head2 with_deferred_fk_checks
+
+=over 4
+
+=item Arguments: C<$coderef>
+
+=item Return Value: The return value of $coderef
+
+=back
+
+Storage specific method to run the code ref with FK checks deferred or
+in MySQL's case disabled entirely.
+
+=cut
+
+# Storage subclasses should override this
+sub with_deferred_fk_checks {
+  my ($self, $sub) = @_;
+
+  $sub->();
+}
+
 sub connected {
   my ($self) = @_;
 
@@ -1063,6 +1085,7 @@ sub _query_start {
 
     if ( $self->debug ) {
         @bind = $self->_fix_bind_params(@bind);
+        
         $self->debugobj->query_start( $sql, @bind );
     }
 }
@@ -1128,12 +1151,12 @@ sub insert {
   my $ident = $source->from; 
   my $bind_attributes = $self->source_bind_attributes($source);
 
+  $self->ensure_connected;
   foreach my $col ( $source->columns ) {
     if ( !defined $to_insert->{$col} ) {
       my $col_info = $source->column_info($col);
 
       if ( $col_info->{auto_nextval} ) {
-        $self->ensure_connected; 
         $to_insert->{$col} = $self->_sequence_fetch( 'nextval', $col_info->{sequence} || $self->_dbh_get_autoinc_seq($self->dbh, $source) );
       }
     }
@@ -1432,21 +1455,28 @@ sub bind_attribute_by_data_type {
 
 =over 4
 
-=item Arguments: $schema \@databases, $version, $directory, $preversion, $sqlt_args
+=item Arguments: $schema \@databases, $version, $directory, $preversion, \%sqlt_args
 
 =back
 
 Creates a SQL file based on the Schema, for each of the specified
 database types, in the given directory.
 
+By default, C<\%sqlt_args> will have
+
+ { add_drop_table => 1, ignore_constraint_names => 1, ignore_index_names => 1 }
+
+merged with the hash passed in. To disable any of those features, pass in a 
+hashref like the following
+
+ { ignore_constraint_names => 0, # ... other options }
+
 =cut
 
-sub create_ddl_dir
-{
+sub create_ddl_dir {
   my ($self, $schema, $databases, $version, $dir, $preversion, $sqltargs) = @_;
 
-  if(!$dir || !-d $dir)
-  {
+  if(!$dir || !-d $dir) {
     warn "No directory given, using ./\n";
     $dir = "./";
   }
@@ -1469,97 +1499,89 @@ sub create_ddl_dir
   $sqlt->parser('SQL::Translator::Parser::DBIx::Class');
   my $sqlt_schema = $sqlt->translate({ data => $schema }) or die $sqlt->error;
 
-  foreach my $db (@$databases)
-  {
+  foreach my $db (@$databases) {
     $sqlt->reset();
     $sqlt = $self->configure_sqlt($sqlt, $db);
     $sqlt->{schema} = $sqlt_schema;
     $sqlt->producer($db);
 
     my $file;
-    my $filename = $schema->ddl_filename($db, $dir, $version);
-    if(-e $filename)
-    {
-      warn("$filename already exists, skipping $db");
-      next unless ($preversion);
-    } else {
-      my $output = $sqlt->translate;
-      if(!$output)
-      {
-        warn("Failed to translate to $db, skipping. (" . $sqlt->error . ")");
-        next;
-      }
-      if(!open($file, ">$filename"))
-      {
-          $self->throw_exception("Can't open $filename for writing ($!)");
-          next;
-      }
-      print $file $output;
-      close($file);
-    } 
-    if($preversion)
-    {
-      require SQL::Translator::Diff;
+    my $filename = $schema->ddl_filename($db, $version, $dir);
+    if (-e $filename && (!$version || ($version == $schema->schema_version()))) {
+      # if we are dumping the current version, overwrite the DDL
+      warn "Overwriting existing DDL file - $filename";
+      unlink($filename);
+    }
 
-      my $prefilename = $schema->ddl_filename($db, $dir, $preversion);
-#      print "Previous version $prefilename\n";
-      if(!-e $prefilename)
-      {
-        warn("No previous schema file found ($prefilename)");
-        next;
-      }
+    my $output = $sqlt->translate;
+    if(!$output) {
+      warn("Failed to translate to $db, skipping. (" . $sqlt->error . ")");
+      next;
+    }
+    if(!open($file, ">$filename")) {
+      $self->throw_exception("Can't open $filename for writing ($!)");
+      next;
+    }
+    print $file $output;
+    close($file);
+  
+    next unless ($preversion);
 
-      my $difffile = $schema->ddl_filename($db, $dir, $version, $preversion);
-      print STDERR "Diff: $difffile: $db, $dir, $version, $preversion \n";
-      if(-e $difffile)
-      {
-        warn("$difffile already exists, skipping");
-        next;
-      }
+    require SQL::Translator::Diff;
 
-      my $source_schema;
-      {
-        my $t = SQL::Translator->new($sqltargs);
-        $t->debug( 0 );
-        $t->trace( 0 );
-        $t->parser( $db )                       or die $t->error;
-        $t = $self->configure_sqlt($t, $db);
-        my $out = $t->translate( $prefilename ) or die $t->error;
-        $source_schema = $t->schema;
-        unless ( $source_schema->name ) {
-          $source_schema->name( $prefilename );
-        }
-      }
+    my $prefilename = $schema->ddl_filename($db, $preversion, $dir);
+    if(!-e $prefilename) {
+      warn("No previous schema file found ($prefilename)");
+      next;
+    }
 
-      # The "new" style of producers have sane normalization and can support 
-      # diffing a SQL file against a DBIC->SQLT schema. Old style ones don't
-      # And we have to diff parsed SQL against parsed SQL.
-      my $dest_schema = $sqlt_schema;
-
-      unless ( "SQL::Translator::Producer::$db"->can('preprocess_schema') ) {
-        my $t = SQL::Translator->new($sqltargs);
-        $t->debug( 0 );
-        $t->trace( 0 );
-        $t->parser( $db )                    or die $t->error;
-        $t = $self->configure_sqlt($t, $db);
-        my $out = $t->translate( $filename ) or die $t->error;
-        $dest_schema = $t->schema;
-        $dest_schema->name( $filename )
-          unless $dest_schema->name;
+    my $difffile = $schema->ddl_filename($db, $version, $dir, $preversion);
+    if(-e $difffile) {
+      warn("Overwriting existing diff file - $difffile");
+      unlink($difffile);
+    }
+    
+    my $source_schema;
+    {
+      my $t = SQL::Translator->new($sqltargs);
+      $t->debug( 0 );
+      $t->trace( 0 );
+      $t->parser( $db )                       or die $t->error;
+      $t = $self->configure_sqlt($t, $db);
+      my $out = $t->translate( $prefilename ) or die $t->error;
+      $source_schema = $t->schema;
+      unless ( $source_schema->name ) {
+        $source_schema->name( $prefilename );
       }
+    }
 
-      my $diff = SQL::Translator::Diff::schema_diff($source_schema, $db,
-                                                    $dest_schema,   $db,
-                                                    $sqltargs
-                                                   );
-      if(!open $file, ">$difffile")
-      { 
-        $self->throw_exception("Can't write to $difffile ($!)");
-        next;
-      }
-      print $file $diff;
-      close($file);
+    # The "new" style of producers have sane normalization and can support 
+    # diffing a SQL file against a DBIC->SQLT schema. Old style ones don't
+    # And we have to diff parsed SQL against parsed SQL.
+    my $dest_schema = $sqlt_schema;
+    
+    unless ( "SQL::Translator::Producer::$db"->can('preprocess_schema') ) {
+      my $t = SQL::Translator->new($sqltargs);
+      $t->debug( 0 );
+      $t->trace( 0 );
+      $t->parser( $db )                    or die $t->error;
+      $t = $self->configure_sqlt($t, $db);
+      my $out = $t->translate( $filename ) or die $t->error;
+      $dest_schema = $t->schema;
+      $dest_schema->name( $filename )
+        unless $dest_schema->name;
     }
+    
+    my $diff = SQL::Translator::Diff::schema_diff($source_schema, $db,
+                                                  $dest_schema,   $db,
+                                                  $sqltargs
+                                                 );
+    if(!open $file, ">$difffile") { 
+      $self->throw_exception("Can't write to $difffile ($!)");
+      next;
+    }
+    print $file $diff;
+    close($file);
   }
 }
 
@@ -1631,9 +1653,6 @@ sub deployment_statements {
   my $tr = SQL::Translator->new(%$sqltargs);
   SQL::Translator::Parser::DBIx::Class::parse( $tr, $schema );
   return "SQL::Translator::Producer::${type}"->can('produce')->($tr);
-
-  return;
-
 }
 
 sub deploy {
@@ -1711,6 +1730,31 @@ sub build_datetime_parser {
     }
 }
 
+=head2 is_replicating
+
+A boolean that reports if a particular L<DBIx::Class::Storage::DBI> is set to
+replicate from a master database.  Default is undef, which is the result
+returned by databases that don't support replication.
+
+=cut
+
+sub is_replicating {
+    return;
+    
+}
+
+=head2 lag_behind_master
+
+Returns a number that represents a certain amount of lag behind a master db
+when a given storage is replicating.  The number is database dependent, but
+starts at zero and increases with the amount of lag. Default in undef
+
+=cut
+
+sub lag_behind_master {
+    return;
+}
+
 sub DESTROY {
   my $self = shift;
   return if !$self->_dbh;