[Bast-commits] r3443 - in branches/DBIx-Class-current: . lib/DBIx/Class/Schema

[matthewt at dev.catalyst.perl.org]

Author: matthewt
Date: 2007-05-31 00:51:55 +0100 (Thu, 31 May 2007)
New Revision: 3443

Modified:
   branches/DBIx-Class-current/Changes
   branches/DBIx-Class-current/lib/DBIx/Class/Schema/Versioned.pm
Log:
added schema_version method to bypass version.pm

Modified: branches/DBIx-Class-current/Changes
===================================================================
--- branches/DBIx-Class-current/Changes	2007-05-30 15:58:21 UTC (rev 3442)
+++ branches/DBIx-Class-current/Changes	2007-05-30 23:51:55 UTC (rev 3443)
@@ -1,5 +1,6 @@
 Revision history for DBIx::Class
 
+        - versioning support via DBIx::Class::Schema::Versioned
         - rewritten collapse_result to fix prefetch
         - moved populate to resultset
         - added support for creation of related rows via insert and populate

Modified: branches/DBIx-Class-current/lib/DBIx/Class/Schema/Versioned.pm
===================================================================
--- branches/DBIx-Class-current/lib/DBIx/Class/Schema/Versioned.pm	2007-05-30 15:58:21 UTC (rev 3442)
+++ branches/DBIx-Class-current/lib/DBIx/Class/Schema/Versioned.pm	2007-05-30 23:51:55 UTC (rev 3443)
@@ -49,6 +49,17 @@
 __PACKAGE__->mk_classdata('upgrade_directory');
 __PACKAGE__->mk_classdata('backup_directory');
 
+sub schema_version {
+  my ($self) = @_;
+  my $class = ref($self)||$self;
+  my $version;
+  {
+    no strict 'refs';
+    $version = ${"${class}::VERSION"};
+  }
+  return $version;
+}
+
 sub on_connect
 {
     my ($self) = @_;
@@ -76,7 +87,7 @@
         $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;
@@ -86,7 +97,7 @@
 
     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?
@@ -98,7 +109,7 @@
     my $file = $self->ddl_filename(
                                    $self->storage->sqlt_type,
                                    $self->upgrade_directory,
-                                   $self->VERSION
+                                   $self->schema_version
                                    );
     if(!$file)
     {
@@ -109,10 +120,10 @@
      $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";
@@ -130,9 +141,9 @@
 
     ## 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
@@ -171,7 +182,7 @@
 
     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())
                       });
 }
@@ -298,6 +309,13 @@
 
 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 at desert-island.demon.co.uk>