From: Jess Robinson Date: Mon, 8 May 2006 22:34:36 +0000 (+0000) Subject: Much POD added X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c29f52399832128ebabb5647ded583940df42c27;p=dbsrgits%2FDBIx-Class-Historic.git Much POD added --- diff --git a/lib/DBIx/Class/Versioning.pm b/lib/DBIx/Class/Versioning.pm index 864f06f..7e892d7 100644 --- a/lib/DBIx/Class/Versioning.pm +++ b/lib/DBIx/Class/Versioning.pm @@ -52,32 +52,34 @@ __PACKAGE__->mk_classdata('upgrade_directory'); sub on_connect { my ($self) = @_; - print "on_connect\n"; +# 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)) { - print "deploying.. \n"; +# print "deploying.. \n"; $vschema->storage->debug(1); - print "Debugging is: ", $vschema->storage->debug, "\n"; +# print "Debugging is: ", $vschema->storage->debug, "\n"; $vschema->deploy(); $pversion = 0; } else { - $pversion = $vtable->search(undef, - { select => [ - 'Version', - { 'max' => 'Installed' }, - ], - group_by => [ 'Version' ], - })->first; + my $psearch = $vtable->search(undef, + { select => [ + { 'max' => 'Installed' }, + ], + as => ['maxinstall'], + })->first; + $pversion = $vtable->search({ Installed => $psearch->get_column('maxinstall'), + })->first; $pversion = $pversion->Version if($pversion); } +# warn("Previous version: $pversion\n"); if($pversion eq $self->VERSION) { - print "This version is already installed\n"; + warn "This version is already installed\n"; return 1; } @@ -88,28 +90,36 @@ sub on_connect if(!$pversion) { - print "No previous version found, skipping upgrade\n"; + warn "No previous version found, skipping upgrade\n"; return 1; } +# $self->create_upgrades($self->upgrade_directoy, $pversion, $self->VERSION); + my $file = $self->ddl_filename($self->upgrade_directory, $self->storage->sqlt_type, $self->VERSION ); + if(!$file) + { + # No upgrade path between these two versions + return 1; + } + $file =~ s/@{[ $self->VERSION ]}/"${pversion}-" . $self->VERSION/e; if(!-f $file) { warn "Upgrade not possible, no upgrade file found ($file)\n"; return; } - print "Found Upgrade file: $file\n"; +# 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"; +# print "Commands: ", join("\n", @data), "\n"; $self->_filedata(\@data); $self->backup(); @@ -139,6 +149,8 @@ sub exists sub backup { my ($self) = @_; + ## Make each ::DBI::Foo do this +# $self->storage->backup(); } sub upgrade @@ -159,7 +171,7 @@ sub upgrade sub run_upgrade { my ($self, $stm) = @_; - print "Reg: $stm\n"; +# print "Reg: $stm\n"; my @statements = grep { $_ =~ $stm } @{$self->_filedata}; # print "Statements: ", join("\n", @statements), "\n"; $self->_filedata([ grep { $_ !~ /$stm/i } @{$self->_filedata} ]); @@ -167,9 +179,92 @@ sub run_upgrade for (@statements) { $self->storage->debugfh->print("$_\n") if $self->storage->debug; - print "Running \n>>$_<<\n"; +# print "Running \n>>$_<<\n"; $self->storage->dbh->do($_) or warn "SQL was:\n $_"; } return 1; } + +=head1 NAME + +DBIx::Class::Versioning - DBIx::Class::Schema plugin for Schema upgrades + +=head1 SYNOPSIS + + package Library::Schema; + use base qw/DBIx::Class::Schema/; + # load Library::Schema::CD, Library::Schema::Book, Library::Schema::DVD + __PACKAGE__->load_classes(qw/CD Book DVD/); + + __PACKAGE__->load_components(qw/Versioning/); + __PACKAGE__->upgrade_directory('/path/to/upgrades/'); + + sub backup + { + my ($self) = @_; + # 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 +classes, to enable them to upgrade to newer schema layouts. To use this +module, you need to have called C on your Schema to +create your upgrade files to include with your delivery. + +A table called I is created and maintained by the +module. This contains two fields, 'Version' and 'Installed', which +contain each VERSION of your Schema, and the date+time it was installed. + +If you would like to influence which levels of version change need +upgrades in your Schema, you can override the method C +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. + + +=head1 METHODS + +=head2 backup + +This is an overwritable method which is called just before the upgrade, to +allow you to make a backup of the database. Per default this method attempts +to call C<< $self->storage->backup >>, to run the standard backup on each +database type. + +=head2 upgrade + +This is an overwritable method used to run your upgrade. The freeform method +allows you to run your upgrade any way you please, you can call C +any number of times to run the actual SQL commands, and in between you can +sandwich your data upgrading. For example, first run all the B +commands, then migrate your data from old to new tables/formats, then +issue the DROP commands when you are finished. + +=head2 run_upgrade + + $self->run_upgrade(qr/create/i); + +Runs a set of SQL statements matching a passed in regular expression. The +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. + +=head1 AUTHOR + +Jess Robinson