-package DBIx::Class::Version::Table;
+package # Hide from PAUSE
+ DBIx::Class::Version::Table;
use base 'DBIx::Class';
use strict;
use warnings;
);
__PACKAGE__->set_primary_key('version');
-package DBIx::Class::Version::TableCompat;
+package # Hide from PAUSE
+ DBIx::Class::Version::TableCompat;
use base 'DBIx::Class';
__PACKAGE__->load_components(qw/ Core/);
__PACKAGE__->table('SchemaVersions');
);
__PACKAGE__->set_primary_key('Version');
-package DBIx::Class::Version;
+package # Hide from PAUSE
+ DBIx::Class::Version;
use base 'DBIx::Class::Schema';
use strict;
use warnings;
__PACKAGE__->register_class('Table', 'DBIx::Class::Version::Table');
-package DBIx::Class::VersionCompat;
+package # Hide from PAUSE
+ DBIx::Class::VersionCompat;
use base 'DBIx::Class::Schema';
use strict;
use warnings;
spotty behaviour in the SQL::Translator producers, please help us by
them.
+
+=head1 GETTING STARTED
+
+
+=cut
+
=head1 METHODS
=head2 upgrade_directory
__PACKAGE__->mk_classdata('do_backup');
__PACKAGE__->mk_classdata('do_diff_on_init');
-=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.
+=head2 install
-=cut
-
-sub schema_version {
- my ($self) = @_;
- my $class = ref($self)||$self;
- my $version;
- {
- no strict 'refs';
- $version = ${"${class}::VERSION"};
- }
- return $version;
-}
-
-=head2 get_db_version
-
-Returns the version that your database is currently at. This is determined by the values in the
-dbix_class_schema_versions table that $self->upgrade writes to.
-
-=cut
+=over 4
-sub get_db_version
-{
- my ($self, $rs) = @_;
-
- my $vtable = $self->{vschema}->resultset('Table');
- my $version = 0;
- eval {
- my $stamp = $vtable->get_column('installed')->max;
- $version = $vtable->search({ installed => $stamp })->first->version;
- };
- return $version;
-}
-
-sub _source_exists
-{
- my ($self, $rs) = @_;
-
- my $c = eval {
- $rs->search({ 1, 0 })->count;
- };
- return 0 if $@ || !defined $c;
+=item Arguments: $db_version
- return 1;
-}
+=back
-=head2 backup
+Call this to initialise a previously unversioned database. The table 'dbix_class_schema_versions' will be created which will be used to store the database version.
-This is an overwritable method which is called just before the upgrade, to
-allow you to make a backup of the database. Per default this method attempts
-to call C<< $self->storage->backup >>, to run the standard backup on each
-database type.
+Takes one argument which should be the version that the database is currently at. Defaults to the return value of L</schema_version>.
-This method should return the name of the backup file, if appropriate..
+See L</getting_started> for more details.
=cut
-sub backup
+sub install
{
- my ($self) = @_;
- ## Make each ::DBI::Foo do this
- $self->storage->backup($self->backup_directory());
-}
+ my ($self, $new_version) = @_;
-# is this just a waste of time? if not then merge with DBI.pm
-sub _create_db_to_schema_diff {
- my $self = shift;
-
- my %driver_to_db_map = (
- 'mysql' => 'MySQL'
- );
-
- my $db = $driver_to_db_map{$self->storage->dbh->{Driver}->{Name}};
- unless ($db) {
- print "Sorry, this is an unsupported DB\n";
- return;
+ # must be called on a fresh database
+ if ($self->get_db_version()) {
+ warn 'Install not possible as versions table already exists in database';
}
- eval 'require SQL::Translator "0.09"';
- if ($@) {
- $self->throw_exception("SQL::Translator 0.09 required");
- }
-
- 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);
+ # default to current version if none passed
+ $new_version ||= $self->schema_version();
- $db_tr->schema->name('db_schema');
- $dbic_tr->schema->name('dbic_schema');
-
- # is this really necessary?
- foreach my $tr ($db_tr, $dbic_tr) {
- my $data = $tr->data;
- $tr->parser->($tr, $$data);
+ unless ($new_version) {
+ # create versions table and version row
+ $self->{vschema}->deploy;
+ $self->_set_db_version;
}
-
- my $diff = SQL::Translator::Diff::schema_diff($db_tr->schema, $db,
- $dbic_tr->schema, $db,
- { ignore_constraint_names => 1, ignore_index_names => 1, caseopt => 1 });
-
- my $filename = $self->ddl_filename(
- $db,
- $self->upgrade_directory,
- $self->schema_version,
- 'PRE',
- );
- my $file;
- if(!open($file, ">$filename"))
- {
- $self->throw_exception("Can't open $filename for writing ($!)");
- next;
- }
- 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";
}
=head2 upgrade
# db unversioned
unless ($db_version) {
- # set version in dbix_class_schema_versions table, can't actually upgrade as we don 't know what version the DB is at
- $self->_create_db_to_schema_diff() if ($self->do_diff_on_init);
-
- # create versions table and version row
- $self->{vschema}->deploy;
- $self->_set_db_version;
+ warn 'Upgrade not possible as database is unversioned. Please call install first.';
return;
}
my $upgrade_file = $self->ddl_filename(
$self->storage->sqlt_type,
- $self->upgrade_directory,
$self->schema_version,
+ $self->upgrade_directory,
$db_version,
);
$self->_set_db_version;
}
-sub _set_db_version {
- my $self = shift;
-
- my $vtable = $self->{vschema}->resultset('Table');
- $vtable->create({ version => $self->schema_version,
- installed => strftime("%Y-%m-%d %H:%M:%S", gmtime())
- });
-
-}
-
-sub _read_sql_file {
- my $self = shift;
- my $file = shift || return;
-
- my $fh;
- open $fh, "<$file" or warn("Can't open upgrade file, $file ($!)");
- my @data = split(/\n/, join('', <$fh>));
- @data = grep(!/^--/, @data);
- @data = split(/;/, join('', @data));
- close($fh);
- @data = grep { $_ && $_ !~ /^-- / } @data;
- @data = grep { $_ !~ /^(BEGIN TRANACTION|COMMIT)/m } @data;
- return \@data;
-}
-
=head2 do_upgrade
This is an overwritable method used to run your upgrade. The freeform method
any number of times to run the actual SQL commands, and in between you can
sandwich your data upgrading. For example, first run all the B<CREATE>
commands, then migrate your data from old to new tables/formats, then
-issue the DROP commands when you are finished.
-
-Will run the whole file as it is by default.
+issue the DROP commands when you are finished. Will run the whole file as it is by default.
=cut
sub do_upgrade
{
- my ($self) = @_;
+ my ($self) = @_;
- ## overridable sub, per default just run 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);
+ # just run all the commands (including inserts) in order
+ $self->run_upgrade(qr/.*?/);
}
=head2 run_upgrade
return 1;
}
+=head2 get_db_version
+
+Returns the version that your database is currently at. This is determined by the values in the
+dbix_class_schema_versions table that $self->upgrade writes to.
+
+=cut
+
+sub get_db_version
+{
+ my ($self, $rs) = @_;
+
+ my $vtable = $self->{vschema}->resultset('Table');
+ my $version = 0;
+ eval {
+ my $stamp = $vtable->get_column('installed')->max;
+ $version = $vtable->search({ installed => $stamp })->first->version;
+ };
+ return $version;
+}
+
+=head2 schema_version
+
+Returns the current schema class' $VERSION
+
+=cut
+
+=head2 backup
+
+This is an overwritable method which is called just before the upgrade, to
+allow you to make a backup of the database. Per default this method attempts
+to call C<< $self->storage->backup >>, to run the standard backup on each
+database type.
+
+This method should return the name of the backup file, if appropriate..
+
+This method is disabled by default. Set $schema->do_backup(1) to enable it.
+
+=cut
+
+sub backup
+{
+ my ($self) = @_;
+ ## Make each ::DBI::Foo do this
+ $self->storage->backup($self->backup_directory());
+}
+
=head2 connection
Overloaded method. This checks the DBIC schema version against the DB version and
compatibility between the old versions table (SchemaVersions) and the new one
(dbix_class_schema_versions).
-To avoid the checks on connect, set the env var DBIC_NO_VERSION_CHECK. This can be
-useful for scripts.
+To avoid the checks on connect, set the env var DBIC_NO_VERSION_CHECK or alternatively you can set the ignore_version attr in the forth arg like so:
+
+ my $schema = MyApp::Schema->connect(
+ $dsn,
+ $user,
+ $password,
+ { ignore_version => 1 },
+ );
=cut
sub connection {
my $self = shift;
$self->next::method(@_);
- $self->_on_connect;
+ $self->_on_connect($_[3]);
return $self;
}
sub _on_connect
{
- my ($self) = @_;
+ my ($self, $args) = @_;
+
+ $args = {} unless $args;
$self->{vschema} = DBIx::Class::Version->connect(@{$self->storage->connect_info()});
my $vtable = $self->{vschema}->resultset('Table');
$self->storage->dbh->do("DROP TABLE " . $vtable_compat->result_source->from);
}
}
-
+
# useful when connecting from scripts etc
- return if ($ENV{DBIC_NO_VERSION_CHECK});
-
+ 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)
", your database contains version $pversion, please call upgrade on your Schema.\n";
}
+# is this just a waste of time? if not then merge with DBI.pm
+sub _create_db_to_schema_diff {
+ my $self = shift;
+
+ my %driver_to_db_map = (
+ 'mysql' => 'MySQL'
+ );
+
+ my $db = $driver_to_db_map{$self->storage->dbh->{Driver}->{Name}};
+ unless ($db) {
+ print "Sorry, this is an unsupported DB\n";
+ return;
+ }
+
+ eval 'require SQL::Translator "0.09"';
+ if ($@) {
+ $self->throw_exception("SQL::Translator 0.09 required");
+ }
+
+ 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);
+
+ $db_tr->schema->name('db_schema');
+ $dbic_tr->schema->name('dbic_schema');
+
+ # is this really necessary?
+ foreach my $tr ($db_tr, $dbic_tr) {
+ my $data = $tr->data;
+ $tr->parser->($tr, $$data);
+ }
+
+ my $diff = SQL::Translator::Diff::schema_diff($db_tr->schema, $db,
+ $dbic_tr->schema, $db,
+ { ignore_constraint_names => 1, ignore_index_names => 1, caseopt => 1 });
+
+ my $filename = $self->ddl_filename(
+ $db,
+ $self->schema_version,
+ $self->upgrade_directory,
+ 'PRE',
+ );
+ my $file;
+ if(!open($file, ">$filename"))
+ {
+ $self->throw_exception("Can't open $filename for writing ($!)");
+ next;
+ }
+ 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";
+}
+
+
+sub _set_db_version {
+ my $self = shift;
+
+ my $vtable = $self->{vschema}->resultset('Table');
+ $vtable->create({ version => $self->schema_version,
+ installed => strftime("%Y-%m-%d %H:%M:%S", gmtime())
+ });
+
+}
+
+sub _read_sql_file {
+ my $self = shift;
+ my $file = shift || return;
+
+ my $fh;
+ open $fh, "<$file" or warn("Can't open upgrade file, $file ($!)");
+ my @data = split(/\n/, join('', <$fh>));
+ @data = grep(!/^--/, @data);
+ @data = split(/;/, join('', @data));
+ close($fh);
+ @data = grep { $_ && $_ !~ /^-- / } @data;
+ @data = grep { $_ !~ /^(BEGIN|BEGIN TRANSACTION|COMMIT)/m } @data;
+ return \@data;
+}
+
+sub _source_exists
+{
+ my ($self, $rs) = @_;
+
+ my $c = eval {
+ $rs->search({ 1, 0 })->count;
+ };
+ return 0 if $@ || !defined $c;
+
+ return 1;
+}
+
1;