Fix versioning test so it works with SQLT 0.09.
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Schema / Versioned.pm
index 6ab73e4..ebfe9ac 100644 (file)
@@ -47,15 +47,34 @@ use Data::Dumper;
 
 __PACKAGE__->mk_classdata('_filedata');
 __PACKAGE__->mk_classdata('upgrade_directory');
+__PACKAGE__->mk_classdata('backup_directory');
 
-sub on_connect
+sub schema_version {
+  my ($self) = @_;
+  my $class = ref($self)||$self;
+  my $version;
+  {
+    no strict 'refs';
+    $version = ${"${class}::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;
 
-    if(!$self->exists($vtable))
+    if(!$self->_source_exists($vtable))
     {
 #        $vschema->storage->debug(1);
         $vschema->storage->ensure_connected();
@@ -75,7 +94,7 @@ sub on_connect
         $pversion = $pversion->Version if($pversion);
     }
 #    warn("Previous version: $pversion\n");
-    if($pversion eq $self->VERSION)
+    if($pversion eq $self->schema_version)
     {
         warn "This version is already installed\n";
         return 1;
@@ -85,7 +104,7 @@ sub on_connect
 
     if(!$pversion)
     {
-        $vtable->create({ Version => $self->VERSION,
+        $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?
@@ -97,7 +116,7 @@ sub on_connect
     my $file = $self->ddl_filename(
                                    $self->storage->sqlt_type,
                                    $self->upgrade_directory,
-                                   $self->VERSION
+                                   $self->schema_version
                                    );
     if(!$file)
     {
@@ -108,10 +127,10 @@ sub on_connect
      $file = $self->ddl_filename(
                                  $self->storage->sqlt_type,
                                  $self->upgrade_directory,
-                                 $self->VERSION,
+                                 $self->schema_version,
                                  $pversion,
                                  );
-#    $file =~ s/@{[ $self->VERSION ]}/"${pversion}-" . $self->VERSION/e;
+#    $file =~ s/@{[ $self->schema_version ]}/"${pversion}-" . $self->schema_version/e;
     if(!-f $file)
     {
         warn "Upgrade not possible, no upgrade file found ($file)\n";
@@ -129,12 +148,12 @@ sub on_connect
 
     ## 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->VERSION . 
+    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->VERSION);
+#    $self->upgrade($pversion, $self->schema_version);
 }
 
-sub exists
+sub _source_exists
 {
     my ($self, $rs) = @_;
 
@@ -150,7 +169,7 @@ sub backup
 {
     my ($self) = @_;
     ## Make each ::DBI::Foo do this
-    $self->storage->backup();
+    $self->storage->backup($self->backup_directory());
 }
 
 sub upgrade
@@ -161,16 +180,11 @@ sub upgrade
 
     $self->backup();
 
-    $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);
+    $self->run_upgrade();
 
     my $vschema = DBIx::Class::Version->connect(@{$self->storage->connect_info()});
     my $vtable = $vschema->resultset('Table');
-    $vtable->create({ Version => $self->VERSION,
+    $vtable->create({ Version => $self->schema_version,
                       Installed => strftime("%Y-%m-%d %H:%M:%S", gmtime())
                       });
 }
@@ -179,6 +193,7 @@ sub upgrade
 sub run_upgrade
 {
     my ($self, $stm) = @_;
+    $stm ||= qr//;
 #    print "Reg: $stm\n";
     my @statements = grep { $_ =~ $stm } @{$self->_filedata};
 #    print "Statements: ", join("\n", @statements), "\n";
@@ -186,9 +201,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;
@@ -198,7 +213,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
 
@@ -209,6 +224,7 @@ DBIx::Class::Versioning - DBIx::Class::Schema plugin for Schema upgrades
 
   __PACKAGE__->load_components(qw/+DBIx::Class::Schema::Versioned/);
   __PACKAGE__->upgrade_directory('/path/to/upgrades/');
+  __PACKAGE__->backup_directory('/path/to/backups/');
 
   sub backup
   {
@@ -216,20 +232,6 @@ DBIx::Class::Versioning - DBIx::Class::Schema plugin for Schema upgrades
     # my special backup process
   }
 
-  sub upgrade
-  {
-    my ($self) = @_;
-
-    ## overridable sub, per default just runs 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);   
-  }
-
 =head1 DESCRIPTION
 
 This module is a component designed to extend L<DBIx::Class::Schema>
@@ -247,6 +249,11 @@ in L<DBIx::Class::Schema>. Return a false value if there is no upgrade
 path between the two versions supplied. By default, every change in
 your VERSION is regarded as needing an upgrade.
 
+The actual upgrade is called manually by calling C<upgrade> on your
+schema object. Code is run at connect time to determine whether an
+upgrade is needed, if so, a warning "Versions out of sync" is
+produced.
+
 NB: At the moment, SQLite upgrading is rather spotty, as SQL::Translator::Diff
 returns SQL statements that SQLite does not support.
 
@@ -283,6 +290,24 @@ idea is that this method can be called any number of times from your
 C<upgrade> method, running whichever commands you specify via the
 regex in the parameter.
 
+B<NOTE:> Since SQL::Translator 0.09000 it is better to just run all statmets
+in the order given, since the SQL produced is of better quality.
+
+=head2 upgrade_directory
+
+Use this to set the directory your upgrade files are stored in.
+
+=head2 backup_directory
+
+Use this to set the directory you want your backups stored in.
+
+=head2 schema_version
+
+Returns the current schema class' $VERSION; does -not- use $schema->VERSION
+since that varies in results depending on if version.pm is installed, and if
+so the perl or XS versions. If you want this to change, bug the version.pm
+author to make vpp and vxs behave the same.
+
 =head1 AUTHOR
 
 Jess Robinson <castaway@desert-island.demon.co.uk>