X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FSchema%2FVersioned.pm;h=fe6c6940d45207d06bba45ebd421af96fd7491b6;hb=20674fcd94984d0d2be09ecda7f3c22715468936;hp=7e892d7250f57d08727bfc0f3edfc89118905c29;hpb=a6b67aca7181168a16b162f586a1790259fdb098;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Schema/Versioned.pm b/lib/DBIx/Class/Schema/Versioned.pm index 7e892d7..fe6c694 100644 --- a/lib/DBIx/Class/Schema/Versioned.pm +++ b/lib/DBIx/Class/Schema/Versioned.pm @@ -1,270 +1,749 @@ -package DBIx::Class::Version::Table; -use base 'DBIx::Class'; +package # Hide from PAUSE + DBIx::Class::Version::Table; +use base 'DBIx::Class::Core'; use strict; use warnings; -__PACKAGE__->load_components(qw/ Core/); -__PACKAGE__->table('SchemaVersions'); +__PACKAGE__->table('dbix_class_schema_versions'); __PACKAGE__->add_columns - ( 'Version' => { + ( 'version' => { 'data_type' => 'VARCHAR', 'is_auto_increment' => 0, 'default_value' => undef, 'is_foreign_key' => 0, - 'name' => 'Version', + 'name' => 'version', 'is_nullable' => 0, 'size' => '10' }, - 'Installed' => { + 'installed' => { 'data_type' => 'VARCHAR', 'is_auto_increment' => 0, 'default_value' => undef, 'is_foreign_key' => 0, - 'name' => 'Installed', + 'name' => 'installed', 'is_nullable' => 0, 'size' => '20' }, ); +__PACKAGE__->set_primary_key('version'); + +package # Hide from PAUSE + DBIx::Class::Version::TableCompat; +use base 'DBIx::Class::Core'; +__PACKAGE__->table('SchemaVersions'); + +__PACKAGE__->add_columns + ( 'Version' => { + 'data_type' => 'VARCHAR', + }, + 'Installed' => { + 'data_type' => 'VARCHAR', + }, + ); __PACKAGE__->set_primary_key('Version'); -package DBIx::Class::Version; +package # Hide from PAUSE + DBIx::Class::Version; use base 'DBIx::Class::Schema'; use strict; use warnings; __PACKAGE__->register_class('Table', 'DBIx::Class::Version::Table'); +package # Hide from PAUSE + DBIx::Class::VersionCompat; +use base 'DBIx::Class::Schema'; +use strict; +use warnings; + +__PACKAGE__->register_class('TableCompat', 'DBIx::Class::Version::TableCompat'); + # --------------------------------------------------------------------------- -package DBIx::Class::Versioning; + +=head1 NAME + +DBIx::Class::Schema::Versioned - DBIx::Class::Schema plugin for Schema upgrades + +=head1 SYNOPSIS + + package MyApp::Schema; + use base qw/DBIx::Class::Schema/; + + our $VERSION = 0.001; + + # load MyApp::Schema::CD, MyApp::Schema::Book, MyApp::Schema::DVD + __PACKAGE__->load_classes(qw/CD Book DVD/); + + __PACKAGE__->load_components(qw/Schema::Versioned/); + __PACKAGE__->upgrade_directory('/path/to/upgrades/'); + + +=head1 DESCRIPTION + +This module provides methods to apply DDL changes to your database using SQL +diff files. Normally these diff files would be created using +L. + +A table called I is created and maintained by the +module. This is used to determine which version your database is currently at. +Similarly the $VERSION in your DBIC schema class is used to determine the +current DBIC schema version. + +The upgrade is initiated manually by calling C on your schema object, +this will attempt to upgrade the database from its current version to the current +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 GETTING STARTED + +Firstly you need to setup your schema class as per the L, make sure +you have specified an upgrade_directory and an initial $VERSION. + +Then you'll need two scripts, one to create DDL files and diffs and another to perform +upgrades. Your creation script might look like a bit like this: + + use strict; + use Pod::Usage; + use Getopt::Long; + use MyApp::Schema; + + my ( $preversion, $help ); + GetOptions( + 'p|preversion:s' => \$preversion, + ) or die pod2usage; + + my $schema = MyApp::Schema->connect( + $dsn, + $user, + $password, + ); + my $sql_dir = './sql'; + my $version = $schema->schema_version(); + $schema->create_ddl_dir( 'MySQL', $version, $sql_dir, $preversion ); + +Then your upgrade script might look like so: + + use strict; + use MyApp::Schema; + + my $schema = MyApp::Schema->connect( + $dsn, + $user, + $password, + ); + + if (!$schema->get_db_version()) { + # schema is unversioned + $schema->deploy(); + } else { + $schema->upgrade(); + } + +The script above assumes that if the database is unversioned then it is empty +and we can safely deploy the DDL to it. However things are not always so simple. + +if you want to initialise a pre-existing database where the DDL is not the same +as the DDL for your current schema version then you will need a diff which +converts the database's DDL to the current DDL. The best way to do this is +to get a dump of the database schema (without data) and save that in your +SQL directory as version 0.000 (the filename must be as with +L) then create a diff using your create DDL +script given above from version 0.000 to the current version. Then hand check +and if necessary edit the resulting diff to ensure that it will apply. Once you have +done all that you can do this: + + if (!$schema->get_db_version()) { + # schema is unversioned + $schema->install("0.000"); + } + + # this will now apply the 0.000 to current version diff + $schema->upgrade(); + +In the case of an unversioned database the above code will create the +dbix_class_schema_versions table and write version 0.000 to it, then +upgrade will then apply the diff we talked about creating in the previous paragraph +and then you're good to go. + +=cut + +package DBIx::Class::Schema::Versioned; use strict; use warnings; -use base 'DBIx::Class'; -use POSIX 'strftime'; -use Data::Dumper; -# use DBIx::Class::Version; +use base 'DBIx::Class::Schema'; + +use Carp::Clan qw/^DBIx::Class/; +use Time::HiRes qw/gettimeofday/; __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'); + + +=head1 METHODS + +=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 (note that backups +are disabled by default). + +=cut + +=head2 install + +=over 4 -sub on_connect +=item Arguments: $db_version + +=back + +Call this to initialise a previously unversioned database. The table 'dbix_class_schema_versions' will be created which will be used to store the database version. + +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. + +=cut + +sub install { + my ($self, $new_version) = @_; + + # must be called on a fresh database + if ($self->get_db_version()) { + carp 'Install not possible as versions table already exists in database'; + } + + # default to current version if none passed + $new_version ||= $self->schema_version(); + + if ($new_version) { + # create versions table and version row + $self->{vschema}->deploy; + $self->_set_db_version({ version => $new_version }); + } +} + +=head2 deploy + +Same as L but also calls C. + +=cut + +sub deploy { + my $self = shift; + $self->next::method(@_); + $self->install(); +} + +=head2 create_upgrade_path + +=over 4 + +=item Arguments: { upgrade_file => $file } + +=back + +Virtual method that should be overridden to create an upgrade file. +This is useful in the case of upgrading across multiple versions +to concatenate several files to create one upgrade file. + +You'll probably want the db_version retrieved via $self->get_db_version +and the schema_version which is retrieved via $self->schema_version + +=cut + +sub create_upgrade_path { + ## override this method +} + +=head2 ordered_schema_versions + +=over 4 + +=item Returns: a list of version numbers, ordered from lowest to highest + +=back + +Virtual method that should be overridden to return an ordered list +of schema versions. This is then used to produce a set of steps to +upgrade through to achieve the required schema version. + +You may want the db_version retrieved via $self->get_db_version +and the schema_version which is retrieved via $self->schema_version + +=cut + +sub ordered_schema_versions { + ## override this method +} + +=head2 upgrade + +Call this to attempt to upgrade your database from the version it +is at to the version this DBIC schema is at. If they are the same +it does nothing. + +It will call L to retrieve an ordered +list of schema versions (if ordered_schema_versions returns nothing +then it is assumed you can do the upgrade as a single step). It +then iterates through the list of versions between the current db +version and the schema version applying one update at a time until +all relevant updates are applied. + +The individual update steps are performed by using +L, which will apply the update and also +update the dbix_class_schema_versions table. + +=cut + +sub upgrade { 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)) - { -# print "deploying.. \n"; - $vschema->storage->debug(1); -# print "Debugging is: ", $vschema->storage->debug, "\n"; - $vschema->deploy(); - $pversion = 0; - } - else - { - 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); + my $db_version = $self->get_db_version(); + + # db unversioned + unless ($db_version) { + carp 'Upgrade not possible as database is unversioned. Please call install first.'; + return; } -# warn("Previous version: $pversion\n"); - if($pversion eq $self->VERSION) - { - warn "This version is already installed\n"; - return 1; + + # db and schema at same version. do nothing + if ( $db_version eq $self->schema_version ) { + carp "Upgrade not necessary\n"; + return; } - - $vtable->create({ Version => $self->VERSION, - Installed => strftime("%Y-%m-%d %H:%M:%S", gmtime()) - }); + my @version_list = $self->ordered_schema_versions; + + # if nothing returned then we preload with min/max + @version_list = ( $db_version, $self->schema_version ) + unless ( scalar(@version_list) ); - if(!$pversion) + # catch the case of someone returning an arrayref + @version_list = @{ $version_list[0] } + if ( ref( $version_list[0] ) eq 'ARRAY' ); + + # remove all versions in list above the required version + while ( scalar(@version_list) + && ( $version_list[-1] ne $self->schema_version ) ) { - warn "No previous version found, skipping upgrade\n"; - return 1; + pop @version_list; } -# $self->create_upgrades($self->upgrade_directoy, $pversion, $self->VERSION); + # remove all versions in list below the current version + while ( scalar(@version_list) && ( $version_list[0] ne $db_version ) ) { + shift @version_list; + } - 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; + # check we have an appropriate list of versions + if ( scalar(@version_list) < 2 ) { + die; } - $file =~ s/@{[ $self->VERSION ]}/"${pversion}-" . $self->VERSION/e; - if(!-f $file) - { - warn "Upgrade not possible, no upgrade file found ($file)\n"; - return; + # do sets of upgrade + while ( scalar(@version_list) >= 2 ) { + $self->upgrade_single_step( $version_list[0], $version_list[1] ); + shift @version_list; } -# 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(); - -# X Create version table if not exists? -# Make backup -# Run create statements -# Run post-create callback -# Run alter/drop statement -# Run post-alter callback } -sub exists +=head2 upgrade_single_step + +=over 4 + +=item Arguments: db_version - the version currently within the db + +=item Arguments: target_version - the version to upgrade to + +=back + +Call this to attempt to upgrade your database from the +I to the I. If they are the same it +does nothing. + +It requires an SQL diff file to exist in your I, +normally you will have created this using L. + +If successful the dbix_class_schema_versions table is updated with +the I. + +This method may be called repeatedly by the upgrade method to +upgrade through a series of updates. + +=cut + +sub upgrade_single_step { - my ($self, $rs) = @_; + my ($self, + $db_version, + $target_version) = @_; + + # db and schema at same version. do nothing + if ($db_version eq $target_version) { + carp "Upgrade not necessary\n"; + return; + } - eval { - $rs->search({ 1, 0 })->count; - }; + # strangely the first time this is called can + # differ to subsequent times. so we call it + # here to be sure. + # XXX - just fix it + $self->storage->sqlt_type; - return 0 if $@; + my $upgrade_file = $self->ddl_filename( + $self->storage->sqlt_type, + $target_version, + $self->upgrade_directory, + $db_version, + ); - return 1; + $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"; + return; + } + + carp "DB version ($db_version) is lower than the schema version (".$self->schema_version."). Attempting upgrade.\n"; + + # backup if necessary then apply upgrade + $self->_filedata($self->_read_sql_file($upgrade_file)); + $self->backup() if($self->do_backup); + $self->txn_do(sub { $self->do_upgrade() }); + + # set row in dbix_class_schema_versions table + $self->_set_db_version({version => $target_version}); } -sub backup +=head2 do_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. Will run the whole file as it is by default. + +=cut + +sub do_upgrade { - my ($self) = @_; - ## Make each ::DBI::Foo do this -# $self->storage->backup(); + my ($self) = @_; + + # just run all the commands (including inserts) in order + $self->run_upgrade(qr/.*?/); } -sub upgrade -{ - my ($self) = @_; +=head2 run_upgrade - ## overridable sub, per default just run all the commands. + $self->run_upgrade(qr/create/i); - $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); -} +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. Probably won't work unless called from the overridable +do_upgrade method. +=cut sub run_upgrade { my ($self, $stm) = @_; -# print "Reg: $stm\n"; + + return unless ($self->_filedata); my @statements = grep { $_ =~ $stm } @{$self->_filedata}; -# print "Statements: ", join("\n", @statements), "\n"; $self->_filedata([ grep { $_ !~ /$stm/i } @{$self->_filedata} ]); for (@statements) { - $self->storage->debugfh->print("$_\n") if $self->storage->debug; -# print "Running \n>>$_<<\n"; - $self->storage->dbh->do($_) or warn "SQL was:\n $_"; + $self->storage->debugobj->query_start($_) if $self->storage->debug; + $self->apply_statement($_); + $self->storage->debugobj->query_end($_) if $self->storage->debug; } return 1; } -=head1 NAME +=head2 apply_statement -DBIx::Class::Versioning - DBIx::Class::Schema plugin for Schema upgrades +Takes an SQL statement and runs it. Override this if you want to handle errors +differently. -=head1 SYNOPSIS +=cut - 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/); +sub apply_statement { + my ($self, $statement) = @_; - __PACKAGE__->load_components(qw/Versioning/); - __PACKAGE__->upgrade_directory('/path/to/upgrades/'); + $self->storage->dbh->do($_) or carp "SQL was: $_"; +} + +=head2 get_db_version + +Returns the version that your database is currently at. This is determined by the values in the +dbix_class_schema_versions table that C and C write to. + +=cut + +sub get_db_version +{ + my ($self, $rs) = @_; + + my $vtable = $self->{vschema}->resultset('Table'); + my $version; + try { + $version = $vtable->search({}, { order_by => { -desc => 'installed' }, rows => 1 } ) + ->get_column ('version') + ->next; + }; + return $version || 0; +} - sub backup - { +=head2 schema_version + +Returns the current schema class' $VERSION + +=cut + +=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. + +This method should return the name of the backup file, if appropriate.. + +This method is disabled by default. Set $schema->do_backup(1) to enable it. + +=cut + +sub backup +{ my ($self) = @_; - # my special backup process + ## Make each ::DBI::Foo do this + $self->storage->backup($self->backup_directory()); +} + +=head2 connection + +Overloaded method. This checks the DBIC schema version against the DB version and +warns if they are not the same or if the DB is unversioned. It also provides +compatibility between the old versions table (SchemaVersions) and the new one +(dbix_class_schema_versions). + +To avoid the checks on connect, set the environment var DBIC_NO_VERSION_CHECK or alternatively you can set the ignore_version attr in the forth argument like so: + + my $schema = MyApp::Schema->connect( + $dsn, + $user, + $password, + { ignore_version => 1 }, + ); + +=cut + +sub connection { + my $self = shift; + $self->next::method(@_); + $self->_on_connect($_[3]); + return $self; +} + +sub _on_connect +{ + my ($self, $args) = @_; + + $args = {} unless $args; + + $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})); + + # 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'); + 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); + } } - sub upgrade - { - my ($self) = @_; + my $pversion = $self->get_db_version(); - ## overridable sub, per default just runs all the commands. + if($pversion eq $self->schema_version) + { +# carp "This version is already installed\n"; + return 1; + } - $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); + if(!$pversion) + { + carp "Your DB is currently unversioned. Please call upgrade on your schema to sync the DB.\n"; + return 1; + } + + carp "Versions out of sync. This is " . $self->schema_version . + ", your database contains version $pversion, please call upgrade on your Schema.\n"; +} + +# is this just a waste of time? if not then merge with DBI.pm +sub _create_db_to_schema_diff { + my $self = shift; + + my %driver_to_db_map = ( + 'mysql' => 'MySQL' + ); + + my $db = $driver_to_db_map{$self->storage->dbh->{Driver}->{Name}}; + unless ($db) { + print "Sorry, this is an unsupported DB\n"; + return; } -=head1 DESCRIPTION + unless (DBIx::Class::Optional::Dependencies->req_ok_for ('deploy')) { + $self->throw_exception("Unable to proceed without " . DBIx::Class::Optional::Dependencies->req_missing_for ('deploy') ); + } -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. + my $db_tr = SQL::Translator->new({ + add_drop_table => 1, + parser => 'DBI', + parser_args => { dbh => $self->storage->dbh } + }); + + $db_tr->producer($db); + my $dbic_tr = SQL::Translator->new; + $dbic_tr->parser('SQL::Translator::Parser::DBIx::Class'); + $dbic_tr->data($self); + $dbic_tr->producer($db); + + $db_tr->schema->name('db_schema'); + $dbic_tr->schema->name('dbic_schema'); + + # is this really necessary? + foreach my $tr ($db_tr, $dbic_tr) { + my $data = $tr->data; + $tr->parser->($tr, $$data); + } -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. + my $diff = SQL::Translator::Diff::schema_diff($db_tr->schema, $db, + $dbic_tr->schema, $db, + { ignore_constraint_names => 1, ignore_index_names => 1, caseopt => 1 }); + + my $filename = $self->ddl_filename( + $db, + $self->schema_version, + $self->upgrade_directory, + 'PRE', + ); + my $file; + if(!open($file, ">$filename")) + { + $self->throw_exception("Can't open $filename for writing ($!)"); + next; + } + print $file $diff; + close($file); -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. + 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"; +} -=head1 METHODS +sub _set_db_version { + my $self = shift; + my ($params) = @_; + $params ||= {}; + + my $version = $params->{version} ? $params->{version} : $self->schema_version; + my $vtable = $self->{vschema}->resultset('Table'); + + ############################################################################## + # !!! NOTE !!! + ############################################################################## + # + # The travesty below replaces the old nice timestamp format of %Y-%m-%d %H:%M:%S + # This is necessary since there are legitimate cases when upgrades can happen + # back to back within the same second. This breaks things since we relay on the + # ability to sort by the 'installed' value. The logical choice of an autoinc + # is not possible, as it will break multiple legacy installations. Also it is + # 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(); + my @dt = gmtime ($tm[0]); + my $o = $vtable->create({ + version => $version, + installed => sprintf("v%04d%02d%02d_%02d%02d%02d.%03.0f", + $dt[5] + 1900, + $dt[4] + 1, + $dt[3], + $dt[2], + $dt[1], + $dt[0], + $tm[1] / 1000, # convert to millisecs, format as up/down rounded int above + ), + }); +} -=head2 backup +sub _read_sql_file { + my $self = shift; + my $file = shift || return; -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. + open my $fh, '<', $file or carp("Can't open upgrade file, $file ($!)"); + my @data = split /\n/, join '', <$fh>; + close $fh; -=head2 upgrade + @data = split /;/, + join '', + grep { $_ && + !/^--/ && + !/^(BEGIN|BEGIN TRANSACTION|COMMIT)/mi } + @data; -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. + return \@data; +} -=head2 run_upgrade +sub _source_exists +{ + my ($self, $rs) = @_; - $self->run_upgrade(qr/create/i); + my $c; + my $exception; + try { + $c = $rs->search({ 1, 0 })->count; + } catch { + $exception=1; + }; + return 0 if $exception || !defined $c; -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. + return 1; +} + +1; + + +=head1 AUTHORS + +Jess Robinson +Luke Saunders -=head1 AUTHOR +=head1 LICENSE -Jess Robinson +You may distribute this code under the same terms as Perl itself.