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=a7c405c6e2be2d58b16b8bb9d50611453d239dae;hpb=70c288086248e5a4008490df22a56632341f2473;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Schema/Versioned.pm b/lib/DBIx/Class/Schema/Versioned.pm index a7c405c..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'); @@ -109,7 +123,7 @@ Downgrades in addition to upgrades =item * -Multiple sql files files per upgrade/downgrade/install +Multiple sql files per upgrade/downgrade/install =item * @@ -202,15 +216,17 @@ use warnings; use base 'DBIx::Class::Schema'; use DBIx::Class::Carp; -use Time::HiRes qw/gettimeofday/; -use Try::Tiny; +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 @@ -238,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 @@ -298,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 @@ -526,7 +542,7 @@ sub get_db_version my ($self, $rs) = @_; my $vtable = $self->{vschema}->resultset('Table'); - my $version = try { + my $version = dbic_internal_try { $vtable->search({}, { order_by => { -desc => 'installed' }, rows => 1 } ) ->get_column ('version') ->next; @@ -589,9 +605,15 @@ sub _on_connect { my ($self) = @_; - my $conn_info = $self->storage->connect_info; - $self->{vschema} = DBIx::Class::Version->connect(@$conn_info); - my $conn_attrs = $self->{vschema}->storage->_dbic_connect_attributes || {}; + 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 || {}; my $vtable = $self->{vschema}->resultset('Table'); @@ -600,11 +622,11 @@ sub _on_connect # check for legacy versions table and move to new if exists unless ($self->_source_exists($vtable)) { - my $vtable_compat = DBIx::Class::VersionCompat->connect(@$conn_info)->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->_get_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); } } @@ -640,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({ @@ -708,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, @@ -719,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 { @@ -744,24 +768,28 @@ sub _read_sql_file { sub _source_exists { - my ($self, $rs) = @_; - - return try { - $rs->search(\'1=0')->cursor->next; - 1; - } catch { - 0; - }; + 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;