new_related works again
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI.pm
index 212be1e..4d52630 100644 (file)
@@ -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) = @_;
 
@@ -1129,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) );
       }
     }
@@ -1221,7 +1243,11 @@ sub _select {
   my $order = $attrs->{order_by};
 
   if (ref $condition eq 'SCALAR') {
-    $order = $1 if $$condition =~ s/ORDER BY (.*)$//i;
+    my $unwrap = ${$condition};
+    if ($unwrap =~ s/ORDER BY (.*)$//i) {
+      $order = $1;
+      $condition = \$unwrap;
+    }
   }
 
   my $for = delete $attrs->{for};
@@ -1433,28 +1459,40 @@ 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 = "./";
   }
   $databases ||= ['MySQL', 'SQLite', 'PostgreSQL'];
   $databases = [ $databases ] if(ref($databases) ne 'ARRAY');
   $version ||= $schema->VERSION || '1.x';
-  $sqltargs = { ( add_drop_table => 1 ), %{$sqltargs || {}} };
+  $sqltargs = {
+    add_drop_table => 1, 
+    ignore_constraint_names => 1,
+    ignore_index_names => 1,
+    %{$sqltargs || {}}
+  };
 
   $self->throw_exception(q{Can't create a ddl file without SQL::Translator 0.09: '}
       . $self->_check_sqlt_message . q{'})
@@ -1465,98 +1503,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 );
       }
+    }
 
-      $DB::single = 1;
-      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);
   }
 }
 
@@ -1628,9 +1657,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 {