X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FVersioned.pm;h=74fbd8d2d94ca62ae69ffd383d19abf3240b8afd;hb=5529838f7afff91467ef2664087999ab222da48d;hp=d192d21160af36650e6e6668bedcd3f078b9b406;hpb=8012b15cd056286d84a619882301970c6c3cf3bb;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Schema/Versioned.pm b/lib/DBIx/Class/Schema/Versioned.pm index d192d21..74fbd8d 100644 --- a/lib/DBIx/Class/Schema/Versioned.pm +++ b/lib/DBIx/Class/Schema/Versioned.pm @@ -96,10 +96,31 @@ this will attempt to upgrade the database from its current version to the curren schema version using a diff from your I. 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). +=head1 SEE ALSO + +L 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 + +=back =head1 GETTING STARTED @@ -180,8 +201,11 @@ use strict; use warnings; use base 'DBIx::Class::Schema'; -use Carp::Clan qw/^DBIx::Class/; +use DBIx::Class::Carp; use Time::HiRes qw/gettimeofday/; +use Try::Tiny; +use Scalar::Util 'weaken'; +use namespace::clean; __PACKAGE__->mk_classdata('_filedata'); __PACKAGE__->mk_classdata('upgrade_directory'); @@ -215,7 +239,7 @@ Call this to initialise a previously unversioned database. The table 'dbix_class Takes one argument which should be the version that the database is currently at. Defaults to the return value of L. -See L for more details. +See L for more details. =cut @@ -225,7 +249,7 @@ sub install # 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 @@ -275,7 +299,7 @@ sub create_upgrade_path { =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 @@ -323,7 +347,7 @@ sub upgrade { # 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; } @@ -394,7 +418,7 @@ sub upgrade_single_step # db and schema at same version. do nothing if ($db_version eq $target_version) { - carp "Upgrade not necessary\n"; + carp 'Upgrade not necessary'; return; } @@ -414,7 +438,7 @@ sub upgrade_single_step $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; } @@ -503,7 +527,7 @@ sub get_db_version my ($self, $rs) = @_; my $vtable = $self->{vschema}->resultset('Table'); - my $version = eval { + my $version = try { $vtable->search({}, { order_by => { -desc => 'installed' }, rows => 1 } ) ->get_column ('version') ->next; @@ -566,23 +590,23 @@ sub _on_connect { my ($self) = @_; - my $info = $self->storage->connect_info; - my $args = $info->[-1]; + weaken (my $w_self = $self ); + + $self->{vschema} = DBIx::Class::Version->connect(sub { $w_self->storage->dbh }); + my $conn_attrs = $self->storage->_dbic_connect_attributes || {}; - $self->{vschema} = DBIx::Class::Version->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(@$info); unless ($self->_source_exists($vtable)) { - my $vtable_compat = $vschema_compat->resultset('TableCompat'); + my $vtable_compat = DBIx::Class::VersionCompat->connect(sub { $w_self->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; + $self->storage->_get_dbh->do("DROP TABLE " . $vtable_compat->result_source->from); } } @@ -590,18 +614,18 @@ sub _on_connect 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 @@ -662,7 +686,7 @@ sub _create_db_to_schema_diff { 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."; } @@ -682,13 +706,13 @@ sub _set_db_version { # 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(); 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, @@ -697,9 +721,9 @@ sub _set_db_version { $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 { @@ -724,21 +748,20 @@ sub _source_exists { my ($self, $rs) = @_; - my $c = eval { - $rs->search({ 1, 0 })->count; + return try { + $rs->search(\'1=0')->cursor->next; + 1; + } catch { + 0; }; - return 0 if $@ || !defined $c; - - return 1; } 1; -=head1 AUTHORS +=head1 AUTHOR AND CONTRIBUTORS -Jess Robinson -Luke Saunders +See L and L in DBIx::Class =head1 LICENSE