Merge 'prefetch-group_by' into 'trunk'
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Schema / Versioned.pm
index d51cd5d..3e7f517 100644 (file)
@@ -70,12 +70,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/);
@@ -181,8 +181,9 @@ package DBIx::Class::Schema::Versioned;
 use strict;
 use warnings;
 use base 'DBIx::Class';
+
+use Carp::Clan qw/^DBIx::Class/;
 use POSIX 'strftime';
-use Data::Dumper;
 
 __PACKAGE__->mk_classdata('_filedata');
 __PACKAGE__->mk_classdata('upgrade_directory');
@@ -226,7 +227,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
@@ -263,6 +264,9 @@ Virtual method that should be overriden to create an upgrade file.
 This is useful in the case of upgrading across multiple versions 
 to concatenate several files to create one upgrade file.
 
+You'll probably want the db_version retrieved via $self->get_db_version
+and the schema_version which is retrieved via $self->schema_version 
+
 =cut
 
 sub create_upgrade_path {
@@ -289,13 +293,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;
   }
 
@@ -304,7 +308,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,
@@ -315,11 +319,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));
@@ -389,7 +393,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
@@ -488,17 +492,17 @@ sub _on_connect
 
   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";
 }
 
@@ -516,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 }
                                    });
@@ -530,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);
 
@@ -562,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";
 }
 
 
@@ -584,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));
@@ -611,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