X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FVersioned.pm;h=f6d598bad43958a78bdfc243702cf069e0495a8f;hb=02562a2092543488bba4ccd98c39abca72560555;hp=70f4ffe829cc723a99178f9edb51d54e2f40ca7c;hpb=a03b396bd7cd939f7f70ec42f56761636b8b9f7e;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Schema/Versioned.pm b/lib/DBIx/Class/Schema/Versioned.pm index 70f4ffe..f6d598b 100644 --- a/lib/DBIx/Class/Schema/Versioned.pm +++ b/lib/DBIx/Class/Schema/Versioned.pm @@ -26,7 +26,7 @@ __PACKAGE__->add_columns 'size' => '20' }, ); -__PACKAGE__->set_primary_key('version'); +__PACKAGE__->result_source_instance->set_primary_key('version'); package # Hide from PAUSE DBIx::Class::Version::TableCompat; @@ -41,7 +41,7 @@ __PACKAGE__->add_columns 'data_type' => 'VARCHAR', }, ); -__PACKAGE__->set_primary_key('Version'); +__PACKAGE__->result_source_instance->set_primary_key('Version'); package # Hide from PAUSE DBIx::Class::Version; @@ -49,6 +49,13 @@ use base 'DBIx::Class::Schema'; use strict; use warnings; +# no point sanity checking, unless we are running asserts +__PACKAGE__->schema_sanity_checker( + DBIx::Class::_ENV_::ASSERT_NO_FAILING_SANITY_CHECKS + ? 'DBIx::Class::Schema::SanityChecker' + : '' +); + __PACKAGE__->register_class('Table', 'DBIx::Class::Version::Table'); package # Hide from PAUSE @@ -57,6 +64,13 @@ use base 'DBIx::Class::Schema'; use strict; use warnings; +# no point sanity checking, unless we are running asserts +__PACKAGE__->schema_sanity_checker( + DBIx::Class::_ENV_::ASSERT_NO_FAILING_SANITY_CHECKS + ? 'DBIx::Class::Schema::SanityChecker' + : '' +); + __PACKAGE__->register_class('TableCompat', 'DBIx::Class::Version::TableCompat'); @@ -96,10 +110,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,14 +215,18 @@ use strict; 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 qw( dbic_internal_try UNRESOLVABLE_CONDITION ); +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 @@ -215,7 +254,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 @@ -275,7 +314,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 +362,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 +433,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 +453,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 +542,7 @@ sub get_db_version 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; @@ -558,30 +597,36 @@ To avoid the checks on connect, set the environment var DBIC_NO_VERSION_CHECK or 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); } } @@ -589,18 +634,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 @@ -617,8 +662,9 @@ sub _create_db_to_schema_diff { return; } - unless (DBIx::Class::Optional::Dependencies->req_ok_for ('deploy')) { - $self->throw_exception("Unable to proceed without " . DBIx::Class::Optional::Dependencies->req_missing_for ('deploy') ); + 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({ @@ -661,7 +707,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."; } @@ -685,9 +731,10 @@ sub _set_db_version { # 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, @@ -696,9 +743,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 { @@ -721,24 +768,28 @@ sub _read_sql_file { 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( UNRESOLVABLE_CONDITION )->cursor->next; + 1; + } ) + ? 1 + : 0 + ; } -1; +=head1 FURTHER QUESTIONS? +Check the list of L. -=head1 AUTHORS +=head1 COPYRIGHT AND LICENSE -Jess Robinson -Luke Saunders +This module is free software L +by the L. You can +redistribute it and/or modify it under the same terms as the +L. -=head1 LICENSE +=cut -You may distribute this code under the same terms as Perl itself. +1;