X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FVersioned.pm;h=6966e5bf37b869a08cfb814315bdf66641dc1747;hb=a28009914a3e447af53737d503b1953160d146c9;hp=d98b024c6422247aa21e229c6b1aa6b6e4286c33;hpb=0d6f11f10031c112775076275f53fbcad1ed67ff;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Schema/Versioned.pm b/lib/DBIx/Class/Schema/Versioned.pm index d98b024..6966e5b 100644 --- a/lib/DBIx/Class/Schema/Versioned.pm +++ b/lib/DBIx/Class/Schema/Versioned.pm @@ -44,23 +44,40 @@ use warnings; use base 'DBIx::Class'; use POSIX 'strftime'; use Data::Dumper; -# use DBIx::Class::Version; __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) = @_; -# print "on_connect\n"; 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)) { -# print "deploying.. \n"; - $vschema->storage->debug(1); -# print "Debugging is: ", $vschema->storage->debug, "\n"; +# $vschema->storage->debug(1); + $vschema->storage->ensure_connected(); $vschema->deploy(); $pversion = 0; } @@ -77,28 +94,29 @@ 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; } - - $vtable->create({ Version => $self->VERSION, - Installed => strftime("%Y-%m-%d %H:%M:%S", gmtime()) - }); +## use IC::DT? if(!$pversion) { - warn "No previous version found, skipping upgrade\n"; + $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? + warn "No previous version found, calling deploy to install this version.\n"; + $self->deploy(); return 1; } -# $self->create_upgrades($self->upgrade_directoy, $pversion, $self->VERSION); - - my $file = $self->ddl_filename($self->upgrade_directory, + my $file = $self->ddl_filename( $self->storage->sqlt_type, - $self->VERSION + $self->upgrade_directory, + $self->schema_version ); if(!$file) { @@ -106,35 +124,43 @@ sub on_connect return 1; } - $file =~ s/@{[ $self->VERSION ]}/"${pversion}-" . $self->VERSION/e; + $file = $self->ddl_filename( + $self->storage->sqlt_type, + $self->upgrade_directory, + $self->schema_version, + $pversion, + ); +# $file =~ s/@{[ $self->schema_version ]}/"${pversion}-" . $self->schema_version/e; if(!-f $file) { warn "Upgrade not possible, no upgrade file found ($file)\n"; return; } -# print "Found Upgrade file: $file\n"; + my $fh; open $fh, "<$file" or warn("Can't open upgrade file, $file ($!)"); my @data = split(/;\n/, join('', <$fh>)); close($fh); @data = grep { $_ && $_ !~ /^-- / } @data; @data = grep { $_ !~ /^(BEGIN TRANACTION|COMMIT)/m } @data; -# print "Commands: ", join("\n", @data), "\n"; - $self->_filedata(\@data); - $self->backup(); - $self->upgrade($pversion, $self->VERSION); + $self->_filedata(\@data); + ## 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->schema_version . + ", your database contains version $pversion, please call upgrade on your Schema.\n"; +# $self->upgrade($pversion, $self->schema_version); } -sub exists +sub _source_exists { my ($self, $rs) = @_; - eval { + my $c = eval { $rs->search({ 1, 0 })->count; }; - return 0 if $@; + return 0 if $@ || !defined $c; return 1; } @@ -143,7 +169,7 @@ sub backup { my ($self) = @_; ## Make each ::DBI::Foo do this - $self->storage->backup(); + $self->storage->backup($self->backup_directory()); } sub upgrade @@ -152,12 +178,20 @@ sub upgrade ## overridable sub, per default just run all the commands. + $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(qr//i); + + my $vschema = DBIx::Class::Version->connect(@{$self->storage->connect_info()}); + my $vtable = $vschema->resultset('Table'); + $vtable->create({ Version => $self->schema_version, + Installed => strftime("%Y-%m-%d %H:%M:%S", gmtime()) + }); } @@ -179,6 +213,8 @@ sub run_upgrade return 1; } +1; + =head1 NAME DBIx::Class::Versioning - DBIx::Class::Schema plugin for Schema upgrades @@ -192,6 +228,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 { @@ -230,6 +267,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. @@ -245,6 +287,9 @@ database type. This method should return the name of the backup file, if appropriate. +C is called from C, make sure you call it, if you write your +own method. + =head2 upgrade This is an overwritable method used to run your upgrade. The freeform method @@ -263,6 +308,21 @@ 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. +=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