'size' => '20'
},
);
-__PACKAGE__->set_primary_key('version');
+__PACKAGE__->result_source_instance->set_primary_key('version');
package # Hide from PAUSE
DBIx::Class::Version::TableCompat;
'data_type' => 'VARCHAR',
},
);
-__PACKAGE__->set_primary_key('Version');
+__PACKAGE__->result_source_instance->set_primary_key('Version');
package # Hide from PAUSE
DBIx::Class::Version;
schema version using a diff from your I<upgrade_directory>. If a suitable diff is
not found then no upgrade is possible.
-NB: At the moment, only SQLite and MySQL are supported. This is due to
-spotty behaviour in the SQL::Translator producers, please help us by
-enhancing them. Ask on the mailing list or IRC channel for details (community details
-in L<DBIx::Class>).
+=head1 SEE ALSO
+
+L<DBIx::Class::DeploymentHandler> is a much more powerful alternative to this
+module. Examples of things it can do that this module cannot do include
+
+=over
+
+=item *
+
+Downgrades in addition to upgrades
+
+=item *
+
+Multiple sql files per upgrade/downgrade/install
+
+=item *
+
+Perl scripts allowed for upgrade/downgrade/install
+
+=item *
+
+Just one set of files needed for upgrade, unlike this module where one might
+need to generate C<factorial(scalar @versions)>
+
+=back
=head1 GETTING STARTED
use warnings;
use base 'DBIx::Class::Schema';
-use Carp::Clan qw/^DBIx::Class/;
-use Time::HiRes qw/gettimeofday/;
+use DBIx::Class::Carp;
+use DBIx::Class::_Util 'dbic_internal_try';
+use Scalar::Util 'weaken';
+use namespace::clean;
-__PACKAGE__->mk_classdata('_filedata');
-__PACKAGE__->mk_classdata('upgrade_directory');
-__PACKAGE__->mk_classdata('backup_directory');
-__PACKAGE__->mk_classdata('do_backup');
-__PACKAGE__->mk_classdata('do_diff_on_init');
+__PACKAGE__->mk_group_accessors( inherited => qw(
+ _filedata
+ upgrade_directory
+ backup_directory
+ do_backup
+ do_diff_on_init
+) );
=head1 METHODS
Takes one argument which should be the version that the database is currently at. Defaults to the return value of L</schema_version>.
-See L</getting_started> for more details.
+See L</GETTING STARTED> for more details.
=cut
# must be called on a fresh database
if ($self->get_db_version()) {
- carp 'Install not possible as versions table already exists in database';
+ $self->throw_exception("A versioned schema has already been deployed, try upgrade instead.\n");
}
# default to current version if none passed
=back
-Virtual method that should be overriden to create an upgrade file.
+Virtual method that should be overridden 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.
=over 4
-=item Returns: a list of version numbers, ordered from lowest to highest
+=item Return Value: a list of version numbers, ordered from lowest to highest
=back
-Virtual method that should be overriden to return an ordered list
+Virtual method that should be overridden to return an ordered list
of schema versions. This is then used to produce a set of steps to
upgrade through to achieve the required schema version.
then it is assumed you can do the upgrade as a single step). It
then iterates through the list of versions between the current db
version and the schema version applying one update at a time until
-all relvant updates are applied.
+all relevant updates are applied.
The individual update steps are performed by using
L</upgrade_single_step>, which will apply the update and also
# db and schema at same version. do nothing
if ( $db_version eq $self->schema_version ) {
- carp "Upgrade not necessary\n";
+ carp 'Upgrade not necessary';
return;
}
# db and schema at same version. do nothing
if ($db_version eq $target_version) {
- carp "Upgrade not necessary\n";
+ carp 'Upgrade not necessary';
return;
}
$self->create_upgrade_path({ upgrade_file => $upgrade_file });
unless (-f $upgrade_file) {
- carp "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";
return;
}
my ($self, $rs) = @_;
my $vtable = $self->{vschema}->resultset('Table');
- my $version = eval {
+ my $version = dbic_internal_try {
$vtable->search({}, { order_by => { -desc => 'installed' }, rows => 1 } )
->get_column ('version')
->next;
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 or alternatively you can set the ignore_version attr in the forth argument like so:
+To avoid the checks on connect, set the environment var DBIC_NO_VERSION_CHECK or alternatively you can set the ignore_version attr in the forth argument like so:
my $schema = MyApp::Schema->connect(
$dsn,
sub connection {
my $self = shift;
$self->next::method(@_);
- $self->_on_connect($_[3]);
+ $self->_on_connect();
return $self;
}
sub _on_connect
{
- my ($self, $args) = @_;
+ my ($self) = @_;
- $args = {} unless $args;
+ weaken (my $w_storage = $self->storage );
+
+ $self->{vschema} = DBIx::Class::Version->clone->connection(
+ sub { $w_storage->dbh },
+
+ # proxy some flags from the main storage
+ { map { $_ => $w_storage->$_ } qw( unsafe ) },
+ );
+ my $conn_attrs = $w_storage->_dbic_connect_attributes || {};
- $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}));
+ return if ($conn_attrs->{ignore_version} || ($ENV{DBIC_NO_VERSION_CHECK} && !exists $conn_attrs->{ignore_version}));
# check for legacy versions table and move to new if exists
- my $vschema_compat = DBIx::Class::VersionCompat->connect(@{$self->storage->connect_info()});
unless ($self->_source_exists($vtable)) {
- my $vtable_compat = $vschema_compat->resultset('TableCompat');
+ my $vtable_compat = DBIx::Class::VersionCompat->clone->connection(sub { $w_storage->dbh })->resultset('TableCompat');
if ($self->_source_exists($vtable_compat)) {
$self->{vschema}->deploy;
- map { $vtable->create({ installed => $_->Installed, version => $_->Version }) } $vtable_compat->all;
- $self->storage->dbh->do("DROP TABLE " . $vtable_compat->result_source->from);
+ map { $vtable->new_result({ installed => $_->Installed, version => $_->Version })->insert } $vtable_compat->all;
+ $w_storage->_get_dbh->do("DROP TABLE " . $vtable_compat->result_source->from);
}
}
if($pversion eq $self->schema_version)
{
-# carp "This version is already installed\n";
+ #carp "This version is already installed";
return 1;
}
if(!$pversion)
{
- carp "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.";
return 1;
}
carp "Versions out of sync. This is " . $self->schema_version .
- ", your database contains version $pversion, please call upgrade on your Schema.\n";
+ ", your database contains version $pversion, please call upgrade on your Schema.";
}
# is this just a waste of time? if not then merge with DBI.pm
return;
}
- $self->throw_exception($self->storage->_sqlt_version_error)
- if (not $self->storage->_sqlt_version_ok);
+ require DBIx::Class::Optional::Dependencies;
+ if ( my $missing = DBIx::Class::Optional::Dependencies->req_missing_for('deploy') ) {
+ $self->throw_exception("Unable to proceed without $missing");
+ }
my $db_tr = SQL::Translator->new({
add_drop_table => 1,
print $file $diff;
close($file);
- 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";
+ 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.";
}
# This is necessary since there are legitimate cases when upgrades can happen
# back to back within the same second. This breaks things since we relay on the
# ability to sort by the 'installed' value. The logical choice of an autoinc
- # is not possible, as it will break multiple legacy installations. Also it is
+ # is not possible, as it will break multiple legacy installations. Also it is
# not possible to format the string sanely, as the column is a varchar(20).
# The 'v' character is added to the front of the string, so that any version
# formatted by this new function will sort _after_ any existing 200... strings.
- my @tm = gettimeofday();
+ require Time::HiRes;
+ my @tm = Time::HiRes::gettimeofday();
my @dt = gmtime ($tm[0]);
- my $o = $vtable->create({
+ my $o = $vtable->new_result({
version => $version,
installed => sprintf("v%04d%02d%02d_%02d%02d%02d.%03.0f",
$dt[5] + 1900,
$dt[2],
$dt[1],
$dt[0],
- $tm[1] / 1000, # convert to millisecs, format as up/down rounded int above
+ int($tm[1] / 1000), # convert to millisecs
),
- });
+ })->insert;
}
sub _read_sql_file {
my @data = split /\n/, join '', <$fh>;
close $fh;
- @data = grep {
- $_ &&
- !/^--/ &&
- !/^(BEGIN|BEGIN TRANSACTION|COMMIT)/m
- } split /;/,
- join '', @data;
+ @data = split /;/,
+ join '',
+ grep { $_ &&
+ !/^--/ &&
+ !/^(BEGIN|BEGIN TRANSACTION|COMMIT)/mi }
+ @data;
return \@data;
}
sub _source_exists
{
- my ($self, $rs) = @_;
-
- my $c = eval {
- $rs->search({ 1, 0 })->count;
- };
- return 0 if $@ || !defined $c;
-
- return 1;
+ my ($self, $rs) = @_;
+
+ ( dbic_internal_try {
+ $rs->search(\'1=0')->cursor->next;
+ 1;
+ } )
+ ? 1
+ : 0
+ ;
}
-1;
+=head1 FURTHER QUESTIONS?
+Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
-=head1 AUTHORS
+=head1 COPYRIGHT AND LICENSE
-Jess Robinson <castaway@desert-island.me.uk>
-Luke Saunders <luke@shadowcatsystems.co.uk>
+This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
+by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
+redistribute it and/or modify it under the same terms as the
+L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
-=head1 LICENSE
+=cut
-You may distribute this code under the same terms as Perl itself.
+1;