X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FVersioned.pm;h=3e7f5170a907e6daaa416eecbc4bc31510cbc3db;hb=41df629c7a94f2731404ec11d224e968c16e6e94;hp=2c29e0ebfb61c6ceef5dbedd7021b365d19b28e2;hpb=1a9251f7b99bdc102f60819eb89a8d059b86a1c5;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Schema/Versioned.pm b/lib/DBIx/Class/Schema/Versioned.pm index 2c29e0e..3e7f517 100644 --- a/lib/DBIx/Class/Schema/Versioned.pm +++ b/lib/DBIx/Class/Schema/Versioned.pm @@ -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 @@ -292,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; } @@ -307,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, @@ -318,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)); @@ -392,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 @@ -491,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"; } @@ -519,13 +520,11 @@ sub _create_db_to_schema_diff { return; } - eval 'require SQL::Translator "0.09003"'; - if ($@) { - $self->throw_exception("SQL::Translator 0.09003 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 } }); @@ -564,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"; } @@ -586,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));