Merge 'no_duplicate_indexes_for_pk_cols' into 'trunk'

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Schema / Versioned.pm

diff --git a/lib/DBIx/Class/Schema/Versioned.pm b/lib/DBIx/Class/Schema/Versioned.pm
index 47230f7..e6af6e0 100644 (file)
--- a/lib/DBIx/Class/Schema/Versioned.pm
+++ b/lib/DBIx/Class/Schema/Versioned.pm
@@ -1,10 +1,9 @@
 package # Hide from PAUSE
   DBIx::Class::Version::Table;
-use base 'DBIx::Class';
+use base 'DBIx::Class::Core';
 use strict;
 use warnings;
 
-__PACKAGE__->load_components(qw/ Core/);
 __PACKAGE__->table('dbix_class_schema_versions');
 
 __PACKAGE__->add_columns
@@ -31,8 +30,7 @@ __PACKAGE__->set_primary_key('version');
 
 package # Hide from PAUSE
   DBIx::Class::Version::TableCompat;
-use base 'DBIx::Class';
-__PACKAGE__->load_components(qw/ Core/);
+use base 'DBIx::Class::Core';
 __PACKAGE__->table('SchemaVersions');
 
 __PACKAGE__->add_columns
@@ -70,12 +68,12 @@ DBIx::Class::Schema::Versioned - DBIx::Class::Schema plugin for Schema upgrades
 
 =head1 SYNOPSIS
 
-  package Library::Schema;
+  package MyApp::Schema;
   use base qw/DBIx::Class::Schema/;
 
   our $VERSION = 0.001;
 
-  # load Library::Schema::CD, Library::Schema::Book, Library::Schema::DVD
+  # load MyApp::Schema::CD, MyApp::Schema::Book, MyApp::Schema::DVD
   __PACKAGE__->load_classes(qw/CD Book DVD/);
 
   __PACKAGE__->load_components(qw/Schema::Versioned/);
@@ -180,9 +178,10 @@ package DBIx::Class::Schema::Versioned;
 
 use strict;
 use warnings;
-use base 'DBIx::Class';
+use base 'DBIx::Class::Schema';
+
+use Carp::Clan qw/^DBIx::Class/;
 use POSIX 'strftime';
-use Data::Dumper;
 
 __PACKAGE__->mk_classdata('_filedata');
 __PACKAGE__->mk_classdata('upgrade_directory');
@@ -226,7 +225,7 @@ sub install
 
   # must be called on a fresh database
   if ($self->get_db_version()) {
-    warn 'Install not possible as versions table already exists in database';
+    carp 'Install not possible as versions table already exists in database';
   }
 
   # default to current version if none passed
@@ -292,13 +291,13 @@ sub upgrade
 
   # db unversioned
   unless ($db_version) {
-    warn 'Upgrade not possible as database is unversioned. Please call install first.';
+    carp 'Upgrade not possible as database is unversioned. Please call install first.';
     return;
   }
 
   # db and schema at same version. do nothing
   if ($db_version eq $self->schema_version) {
-    print "Upgrade not necessary\n";
+    carp "Upgrade not necessary\n";
     return;
   }
 
@@ -307,7 +306,7 @@ sub upgrade
   # here to be sure.
   # XXX - just fix it
   $self->storage->sqlt_type;
-  
+
   my $upgrade_file = $self->ddl_filename(
                                          $self->storage->sqlt_type,
                                          $self->schema_version,
@@ -318,11 +317,11 @@ sub upgrade
   $self->create_upgrade_path({ upgrade_file => $upgrade_file });
 
   unless (-f $upgrade_file) {
-    warn "Upgrade not possible, no upgrade file found ($upgrade_file), please create one\n";
+    carp "Upgrade not possible, no upgrade file found ($upgrade_file), please create one\n";
     return;
   }
 
-  warn "\nDB version ($db_version) is lower than the schema version (".$self->schema_version."). Attempting upgrade.\n";
+  carp "\nDB version ($db_version) is lower than the schema version (".$self->schema_version."). Attempting upgrade.\n";
 
   # backup if necessary then apply upgrade
   $self->_filedata($self->_read_sql_file($upgrade_file));
@@ -392,7 +391,7 @@ differently.
 sub apply_statement {
     my ($self, $statement) = @_;
 
-    $self->storage->dbh->do($_) or warn "SQL was:\n $_";
+    $self->storage->dbh->do($_) or carp "SQL was:\n $_";
 }
 
 =head2 get_db_version
@@ -471,9 +470,13 @@ sub _on_connect
   my ($self, $args) = @_;
 
   $args = {} unless $args;
+
   $self->{vschema} = DBIx::Class::Version->connect(@{$self->storage->connect_info()});
   my $vtable = $self->{vschema}->resultset('Table');
 
+  # useful when connecting from scripts etc
+  return if ($args->{ignore_version} || ($ENV{DBIC_NO_VERSION_CHECK} && !exists $args->{ignore_version}));
+
   # check for legacy versions table and move to new if exists
   my $vschema_compat = DBIx::Class::VersionCompat->connect(@{$self->storage->connect_info()});
   unless ($self->_source_exists($vtable)) {
@@ -485,23 +488,21 @@ sub _on_connect
     }
   }
 
-  # useful when connecting from scripts etc
-  return if ($args->{ignore_version} || ($ENV{DBIC_NO_VERSION_CHECK} && !exists $args->{ignore_version}));
   my $pversion = $self->get_db_version();
 
   if($pversion eq $self->schema_version)
     {
-#         warn "This version is already installed\n";
+#         carp "This version is already installed\n";
         return 1;
     }
 
   if(!$pversion)
     {
-        warn "Your DB is currently unversioned. Please call upgrade on your schema to sync the DB.\n";
+        carp "Your DB is currently unversioned. Please call upgrade on your schema to sync the DB.\n";
         return 1;
     }
 
-  warn "Versions out of sync. This is " . $self->schema_version . 
+  carp "Versions out of sync. This is " . $self->schema_version . 
     ", your database contains version $pversion, please call upgrade on your Schema.\n";
 }
 
@@ -519,13 +520,11 @@ sub _create_db_to_schema_diff {
     return;
   }
 
-  eval 'require SQL::Translator "0.09"';
-  if ($@) {
-    $self->throw_exception("SQL::Translator 0.09 required");
-  }
+  $self->throw_exception($self->storage->_sqlt_version_error)
+    if (not $self->storage->_sqlt_version_ok);
 
-  my $db_tr = SQL::Translator->new({ 
-                                    add_drop_table => 1, 
+  my $db_tr = SQL::Translator->new({
+                                    add_drop_table => 1,
                                     parser => 'DBI',
                                     parser_args => { dbh => $self->storage->dbh }
                                    });
@@ -533,7 +532,6 @@ sub _create_db_to_schema_diff {
   $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);
 
@@ -565,7 +563,7 @@ sub _create_db_to_schema_diff {
   print $file $diff;
   close($file);
 
-  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";
+  carp "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";
 }
 
 
@@ -587,7 +585,7 @@ sub _read_sql_file {
   my $file = shift || return;
 
   my $fh;
-  open $fh, "<$file" or warn("Can't open upgrade file, $file ($!)");
+  open $fh, "<$file" or carp("Can't open upgrade file, $file ($!)");
   my @data = split(/\n/, join('', <$fh>));
   @data = grep(!/^--/, @data);
   @data = split(/;/, join('', @data));
@@ -614,7 +612,7 @@ sub _source_exists
 
 =head1 AUTHORS
 
-Jess Robinson <castaway@desert-island.demon.co.uk>
+Jess Robinson <castaway@desert-island.me.uk>
 Luke Saunders <luke@shadowcatsystems.co.uk>
 
 =head1 LICENSE