fixed broken regex when reading sql files
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Schema / Versioned.pm
index ea662b3..e5493ce 100644 (file)
@@ -48,6 +48,7 @@ use Data::Dumper;
 __PACKAGE__->mk_classdata('_filedata');
 __PACKAGE__->mk_classdata('upgrade_directory');
 __PACKAGE__->mk_classdata('backup_directory');
+__PACKAGE__->mk_classdata('do_backup');
 
 sub schema_version {
   my ($self) = @_;
@@ -60,49 +61,29 @@ sub schema_version {
   return $version;
 }
 
+sub connection {
+  my $self = shift;
+  $self->next::method(@_);
+  $self->_on_connect;
+  return $self;
+}
+
 sub _on_connect
 {
     my ($self) = @_;
-    my $vschema = DBIx::Class::Version->connect(@{$self->storage->connect_info()});
-    my $vtable = $vschema->resultset('Table');
-    my $pversion;
+    $self->{vschema} = DBIx::Class::Version->connect(@{$self->storage->connect_info()});
+
+    my $pversion = $self->get_db_version();
 
-    if(!$self->exists($vtable))
-    {
-#        $vschema->storage->debug(1);
-        $vschema->storage->ensure_connected();
-        $vschema->deploy();
-        $pversion = 0;
-    }
-    else
-    {
-        my $psearch = $vtable->search(undef, 
-                                      { select => [
-                                                   { 'max' => 'Installed' },
-                                                   ],
-                                            as => ['maxinstall'],
-                                        })->first;
-        $pversion = $vtable->search({ Installed => $psearch->get_column('maxinstall'),
-                                  })->first;
-        $pversion = $pversion->Version if($pversion);
-    }
-#    warn("Previous version: $pversion\n");
     if($pversion eq $self->schema_version)
     {
         warn "This version is already installed\n";
         return 1;
     }
 
-## use IC::DT?    
-
     if(!$pversion)
     {
-        $vtable->create({ Version => $self->schema_version,
-                          Installed => strftime("%Y-%m-%d %H:%M:%S", gmtime())
-                          });
-        ## If we let the user do this, where does the Version table get updated?
-        warn "No previous version found, calling deploy to install this version.\n";
-        $self->deploy();
+        warn "Your DB is currently unversioned. Please call upgrade on your schema to sync the DB.\n";
         return 1;
     }
 
@@ -117,36 +98,33 @@ sub _on_connect
         return 1;
     }
 
-     $file = $self->ddl_filename(
-                                 $self->storage->sqlt_type,
-                                 $self->upgrade_directory,
-                                 $self->schema_version,
-                                 $pversion,
-                                 );
-#    $file =~ s/@{[ $self->schema_version ]}/"${pversion}-" . $self->schema_version/e;
-    if(!-f $file)
-    {
-        warn "Upgrade not possible, no upgrade file found ($file)\n";
-        return;
-    }
-
-    my $fh;
-    open $fh, "<$file" or warn("Can't open upgrade file, $file ($!)");
-    my @data = split(/;\n/, join('', <$fh>));
-    close($fh);
-    @data = grep { $_ && $_ !~ /^-- / } @data;
-    @data = grep { $_ !~ /^(BEGIN TRANACTION|COMMIT)/m } @data;
-
-    $self->_filedata(\@data);
 
     ## Don't do this yet, do only on command?
     ## If we do this later, where does the Version table get updated??
     warn "Versions out of sync. This is " . $self->schema_version . 
         ", your database contains version $pversion, please call upgrade on your Schema.\n";
-#    $self->upgrade($pversion, $self->schema_version);
 }
 
-sub exists
+sub get_db_version
+{
+    my ($self, $rs) = @_;
+
+    my $vtable = $self->{vschema}->resultset('Table');
+    return 0 unless ($self->_source_exists($vtable));
+
+    my $psearch = $vtable->search(undef, 
+                                    { select => [
+                                                 { 'max' => 'Installed' },
+                                                 ],
+                                          as => ['maxinstall'],
+                                      })->first;
+    my $pversion = $vtable->search({ Installed => $psearch->get_column('maxinstall'),
+                                })->first;
+    $pversion = $pversion->Version if($pversion);
+    return $pversion;
+}
+
+sub _source_exists
 {
     my ($self, $rs) = @_;
 
@@ -168,26 +146,120 @@ sub backup
 sub upgrade
 {
     my ($self) = @_;
+    my $db_version = $self->get_db_version();
+
+    my %driver_to_db_map = (
+                            'mysql' => 'MySQL'
+                           );
+    if (!$db_version) {
+      my $db = $driver_to_db_map{$self->storage->dbh->{Driver}->{Name}};
+      unless ($db) {
+        print "Sorry, this is an unsupported DB\n";
+        return;
+      }
+
+      require SQL::Translator;
+      require SQL::Translator::Diff;
+      my $db_tr = SQL::Translator->new({ 
+        add_drop_table => 1, 
+        parser => 'DBI',
+        parser_args => { dbh => $self->storage->dbh }
+      });
+
+      $db_tr->producer($db);
+      my $dbic_tr = SQL::Translator->new;
+      $dbic_tr->parser('SQL::Translator::Parser::DBIx::Class');
+      $dbic_tr = $self->storage->configure_sqlt($dbic_tr, $db);
+      $dbic_tr->data($self);
+      $dbic_tr->producer($db);
+
+      $db_tr->schema->name('db_schema');
+      $dbic_tr->schema->name('dbic_schema');
+
+      # is this really necessary?
+      foreach my $tr ($db_tr, $dbic_tr) {
+        my $data = $tr->data;
+        $tr->parser->($tr, $$data);
+      }
+
+      my $diff = SQL::Translator::Diff::schema_diff($db_tr->schema, $db, 
+                                                    $dbic_tr->schema, $db,
+                                                    { caseopt => 1 });
+
+      my $filename = $self->ddl_filename(
+                                 $db,
+                                 $self->upgrade_directory,
+                                 $self->schema_version,
+                                 'PRE',
+                                 );
+      my $file;
+      if(!open($file, ">$filename"))
+      {
+          $self->throw_exception("Can't open $filename for writing ($!)");
+          next;
+      }
+      print $file $diff;
+      close($file);
+
+      # create versions table
+      $self->{vschema}->deploy;
+
+      print "WARNING: There may be differences between your DB and your DBIC schema. Please review and if necessary run the SQL in $filename to sync your DB.\n";
+    } else {
+      if ($db_version eq $self->schema_version) {
+        print "Upgrade not necessary\n";
+        return;
+      }
 
-    ## overridable sub, per default just run all the commands.
+      my $file = $self->ddl_filename(
+                                 $self->storage->sqlt_type,
+                                 $self->upgrade_directory,
+                                 $self->schema_version,
+                                 $db_version,
+                                 );
 
-    $self->backup();
+      if(!-f $file)
+      {
+         warn "Upgrade not possible, no upgrade file found ($file)\n";
+         return;
+      }
+
+      my $fh;
+      open $fh, "<$file" or warn("Can't open upgrade file, $file ($!)");
+      my @data = split(/\n/, join('', <$fh>));
+      @data = grep(!/^--/, @data);
+      @data = split(/;/, join('', @data));
+      close($fh);
+      @data = grep { $_ && $_ !~ /^-- / } @data;
+      @data = grep { $_ !~ /^(BEGIN TRANACTION|COMMIT)/m } @data;
+      
+      $self->_filedata(\@data);
+      $self->backup() if($self->do_backup);
+
+      $self->txn_do(sub {
+        $self->do_upgrade();
+      });
+    }
+
+    my $vtable = $self->{vschema}->resultset('Table');
+    $vtable->create({ Version => $self->schema_version,
+                      Installed => strftime("%Y-%m-%d %H:%M:%S", gmtime())
+                      });
+
+}
 
+sub do_upgrade
+{
+    my ($self) = @_;
+
+    ## overridable sub, per default just run all the commands.
     $self->run_upgrade(qr/create/i);
     $self->run_upgrade(qr/alter table .*? add/i);
     $self->run_upgrade(qr/alter table .*? (?!drop)/i);
     $self->run_upgrade(qr/alter table .*? drop/i);
     $self->run_upgrade(qr/drop/i);
-#    $self->run_upgrade(qr//i);
-
-    my $vschema = DBIx::Class::Version->connect(@{$self->storage->connect_info()});
-    my $vtable = $vschema->resultset('Table');
-    $vtable->create({ Version => $self->schema_version,
-                      Installed => strftime("%Y-%m-%d %H:%M:%S", gmtime())
-                      });
 }
 
-
 sub run_upgrade
 {
     my ($self, $stm) = @_;
@@ -198,9 +270,9 @@ sub run_upgrade
 
     for (@statements)
     {
-        $self->storage->debugfh->print("$_\n") if $self->storage->debug;
-#        print "Running \n>>$_<<\n";
+        $self->storage->debugobj->query_start($_) if $self->storage->debug;
         $self->storage->dbh->do($_) or warn "SQL was:\n $_";
+        $self->storage->debugobj->query_end($_) if $self->storage->debug;
     }
 
     return 1;
@@ -210,7 +282,7 @@ sub run_upgrade
 
 =head1 NAME
 
-DBIx::Class::Versioning - DBIx::Class::Schema plugin for Schema upgrades
+DBIx::Class::Schema::Versioned - DBIx::Class::Schema plugin for Schema upgrades
 
 =head1 SYNOPSIS
 
@@ -278,13 +350,15 @@ allow you to make a backup of the database. Per default this method attempts
 to call C<< $self->storage->backup >>, to run the standard backup on each
 database type. 
 
-This method should return the name of the backup file, if appropriate.
-
-C<backup> is called from C<upgrade>, make sure you call it, if you write your
-own <upgrade> method.
+This method should return the name of the backup file, if appropriate..
 
 =head2 upgrade
 
+This is the main upgrade method which calls the overridable do_upgrade and
+also handles the backups and updating of the SchemaVersion table.
+
+=head2 do_upgrade
+
 This is an overwritable method used to run your upgrade. The freeform method
 allows you to run your upgrade any way you please, you can call C<run_upgrade>
 any number of times to run the actual SQL commands, and in between you can