=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/);
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');
# 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
# 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;
}
# 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,
$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));
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
my ($self, $args) = @_;
$args = {} unless $args;
+
+ # useful when connecting from scripts etc
+ return if ($args->{ignore_version} || ($ENV{DBIC_NO_VERSION_CHECK} && !exists $args->{ignore_version}));
+
$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}));
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";
}
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 }
});
$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);
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";
}
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));
=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