X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FVersioned.pm;h=ebfe9ac1cf64fff7043af3beae98a125f72f5e4a;hb=dd018f09328dbfb2c28a199bbb271d8323cb9a77;hp=6ab73e42959a617dd83084ead945139ae50e709e;hpb=e2c0df8e0b707050eb005ac6f68548f857a36acf;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Schema/Versioned.pm b/lib/DBIx/Class/Schema/Versioned.pm index 6ab73e4..ebfe9ac 100644 --- a/lib/DBIx/Class/Schema/Versioned.pm +++ b/lib/DBIx/Class/Schema/Versioned.pm @@ -47,15 +47,34 @@ use Data::Dumper; __PACKAGE__->mk_classdata('_filedata'); __PACKAGE__->mk_classdata('upgrade_directory'); +__PACKAGE__->mk_classdata('backup_directory'); -sub on_connect +sub schema_version { + my ($self) = @_; + my $class = ref($self)||$self; + my $version; + { + no strict 'refs'; + $version = ${"${class}::VERSION"}; + } + return $version; +} + +sub connection { + my $self = shift; + $self->next::method(@_); + $self->_on_connect; + return $self; +} + +sub _on_connect { my ($self) = @_; my $vschema = DBIx::Class::Version->connect(@{$self->storage->connect_info()}); my $vtable = $vschema->resultset('Table'); my $pversion; - if(!$self->exists($vtable)) + if(!$self->_source_exists($vtable)) { # $vschema->storage->debug(1); $vschema->storage->ensure_connected(); @@ -75,7 +94,7 @@ sub on_connect $pversion = $pversion->Version if($pversion); } # warn("Previous version: $pversion\n"); - if($pversion eq $self->VERSION) + if($pversion eq $self->schema_version) { warn "This version is already installed\n"; return 1; @@ -85,7 +104,7 @@ sub on_connect if(!$pversion) { - $vtable->create({ Version => $self->VERSION, + $vtable->create({ Version => $self->schema_version, Installed => strftime("%Y-%m-%d %H:%M:%S", gmtime()) }); ## If we let the user do this, where does the Version table get updated? @@ -97,7 +116,7 @@ sub on_connect my $file = $self->ddl_filename( $self->storage->sqlt_type, $self->upgrade_directory, - $self->VERSION + $self->schema_version ); if(!$file) { @@ -108,10 +127,10 @@ sub on_connect $file = $self->ddl_filename( $self->storage->sqlt_type, $self->upgrade_directory, - $self->VERSION, + $self->schema_version, $pversion, ); -# $file =~ s/@{[ $self->VERSION ]}/"${pversion}-" . $self->VERSION/e; +# $file =~ s/@{[ $self->schema_version ]}/"${pversion}-" . $self->schema_version/e; if(!-f $file) { warn "Upgrade not possible, no upgrade file found ($file)\n"; @@ -129,12 +148,12 @@ sub on_connect ## Don't do this yet, do only on command? ## If we do this later, where does the Version table get updated?? - warn "Versions out of sync. This is " . $self->VERSION . + warn "Versions out of sync. This is " . $self->schema_version . ", your database contains version $pversion, please call upgrade on your Schema.\n"; -# $self->upgrade($pversion, $self->VERSION); +# $self->upgrade($pversion, $self->schema_version); } -sub exists +sub _source_exists { my ($self, $rs) = @_; @@ -150,7 +169,7 @@ sub backup { my ($self) = @_; ## Make each ::DBI::Foo do this - $self->storage->backup(); + $self->storage->backup($self->backup_directory()); } sub upgrade @@ -161,16 +180,11 @@ sub upgrade $self->backup(); - $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); -# $self->run_upgrade(qr//i); + $self->run_upgrade(); my $vschema = DBIx::Class::Version->connect(@{$self->storage->connect_info()}); my $vtable = $vschema->resultset('Table'); - $vtable->create({ Version => $self->VERSION, + $vtable->create({ Version => $self->schema_version, Installed => strftime("%Y-%m-%d %H:%M:%S", gmtime()) }); } @@ -179,6 +193,7 @@ sub upgrade sub run_upgrade { my ($self, $stm) = @_; + $stm ||= qr//; # print "Reg: $stm\n"; my @statements = grep { $_ =~ $stm } @{$self->_filedata}; # print "Statements: ", join("\n", @statements), "\n"; @@ -186,9 +201,9 @@ sub run_upgrade for (@statements) { - $self->storage->debugfh->print("$_\n") if $self->storage->debug; -# print "Running \n>>$_<<\n"; + $self->storage->debugobj->query_start($_) if $self->storage->debug; $self->storage->dbh->do($_) or warn "SQL was:\n $_"; + $self->storage->debugobj->query_end($_) if $self->storage->debug; } return 1; @@ -198,7 +213,7 @@ sub run_upgrade =head1 NAME -DBIx::Class::Versioning - DBIx::Class::Schema plugin for Schema upgrades +DBIx::Class::Schema::Versioned - DBIx::Class::Schema plugin for Schema upgrades =head1 SYNOPSIS @@ -209,6 +224,7 @@ DBIx::Class::Versioning - DBIx::Class::Schema plugin for Schema upgrades __PACKAGE__->load_components(qw/+DBIx::Class::Schema::Versioned/); __PACKAGE__->upgrade_directory('/path/to/upgrades/'); + __PACKAGE__->backup_directory('/path/to/backups/'); sub backup { @@ -216,20 +232,6 @@ DBIx::Class::Versioning - DBIx::Class::Schema plugin for Schema upgrades # my special backup process } - sub upgrade - { - my ($self) = @_; - - ## overridable sub, per default just runs 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); - $self->run_upgrade(qr//i); - } - =head1 DESCRIPTION This module is a component designed to extend L @@ -247,6 +249,11 @@ in L. Return a false value if there is no upgrade path between the two versions supplied. By default, every change in your VERSION is regarded as needing an upgrade. +The actual upgrade is called manually by calling C on your +schema object. Code is run at connect time to determine whether an +upgrade is needed, if so, a warning "Versions out of sync" is +produced. + NB: At the moment, SQLite upgrading is rather spotty, as SQL::Translator::Diff returns SQL statements that SQLite does not support. @@ -283,6 +290,24 @@ idea is that this method can be called any number of times from your C method, running whichever commands you specify via the regex in the parameter. +B Since SQL::Translator 0.09000 it is better to just run all statmets +in the order given, since the SQL produced is of better quality. + +=head2 upgrade_directory + +Use this to set the directory your upgrade files are stored in. + +=head2 backup_directory + +Use this to set the directory you want your backups stored in. + +=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. + =head1 AUTHOR Jess Robinson