__PACKAGE__->mk_classdata('_filedata');
__PACKAGE__->mk_classdata('upgrade_directory');
+__PACKAGE__->mk_classdata('backup_directory');
-sub on_connect
+sub schema_version {
+ my ($self) = @_;
+ my $class = ref($self)||$self;
+ my $version;
+ {
+ no strict 'refs';
+ $version = ${"${class}::VERSION"};
+ }
+ return $version;
+}
+
+sub connection {
+ my $self = shift;
+ $self->next::method(@_);
+ $self->_on_connect;
+ return $self;
+}
+
+sub _on_connect
{
my ($self) = @_;
my $vschema = DBIx::Class::Version->connect(@{$self->storage->connect_info()});
my $vtable = $vschema->resultset('Table');
my $pversion;
- if(!$self->exists($vtable))
+
+ if(!$self->_source_exists($vtable))
{
# $vschema->storage->debug(1);
$vschema->storage->ensure_connected();
$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;
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?
my $file = $self->ddl_filename(
$self->storage->sqlt_type,
$self->upgrade_directory,
- $self->VERSION
+ $self->schema_version
);
if(!$file)
{
$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";
## 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
+sub _source_exists
{
my ($self, $rs) = @_;
{
my ($self) = @_;
## Make each ::DBI::Foo do this
- $self->storage->backup();
+ $self->storage->backup($self->backup_directory());
}
sub upgrade
$self->backup();
- $self->run_upgrade(qr/create/i);
- $self->run_upgrade(qr/alter table .*? add/i);
- $self->run_upgrade(qr/alter table .*? (?!drop)/i);
- $self->run_upgrade(qr/alter table .*? drop/i);
- $self->run_upgrade(qr/drop/i);
-# $self->run_upgrade(qr//i);
+ $self->run_upgrade();
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())
});
}
sub run_upgrade
{
my ($self, $stm) = @_;
+ $stm ||= qr//;
# print "Reg: $stm\n";
my @statements = grep { $_ =~ $stm } @{$self->_filedata};
# print "Statements: ", join("\n", @statements), "\n";
for (@statements)
{
- $self->storage->debugfh->print("$_\n") if $self->storage->debug;
-# print "Running \n>>$_<<\n";
+ $self->storage->debugobj->query_start($_) if $self->storage->debug;
$self->storage->dbh->do($_) or warn "SQL was:\n $_";
+ $self->storage->debugobj->query_end($_) if $self->storage->debug;
}
return 1;
}
+1;
+
=head1 NAME
-DBIx::Class::Versioning - DBIx::Class::Schema plugin for Schema upgrades
+DBIx::Class::Schema::Versioned - DBIx::Class::Schema plugin for Schema upgrades
=head1 SYNOPSIS
__PACKAGE__->load_components(qw/+DBIx::Class::Schema::Versioned/);
__PACKAGE__->upgrade_directory('/path/to/upgrades/');
+ __PACKAGE__->backup_directory('/path/to/backups/');
sub backup
{
# my special backup process
}
- sub upgrade
- {
- my ($self) = @_;
-
- ## overridable sub, per default just runs all the commands.
-
- $self->run_upgrade(qr/create/i);
- $self->run_upgrade(qr/alter table .*? add/i);
- $self->run_upgrade(qr/alter table .*? (?!drop)/i);
- $self->run_upgrade(qr/alter table .*? drop/i);
- $self->run_upgrade(qr/drop/i);
- $self->run_upgrade(qr//i);
- }
-
=head1 DESCRIPTION
This module is a component designed to extend L<DBIx::Class::Schema>
path between the two versions supplied. By default, every change in
your VERSION is regarded as needing an upgrade.
+The actual upgrade is called manually by calling C<upgrade> on your
+schema object. Code is run at connect time to determine whether an
+upgrade is needed, if so, a warning "Versions out of sync" is
+produced.
+
NB: At the moment, SQLite upgrading is rather spotty, as SQL::Translator::Diff
returns SQL statements that SQLite does not support.
C<upgrade> method, running whichever commands you specify via the
regex in the parameter.
+B<NOTE:> Since SQL::Translator 0.09000 it is better to just run all statmets
+in the order given, since the SQL produced is of better quality.
+
+=head2 upgrade_directory
+
+Use this to set the directory your upgrade files are stored in.
+
+=head2 backup_directory
+
+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@desert-island.demon.co.uk>