[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Schema / Versioned.pm

package DBIx::Class::Version::Table;
use base 'DBIx::Class';
use strict;
use warnings;

__PACKAGE__->load_components(qw/ Core/);
__PACKAGE__->table('SchemaVersions');

__PACKAGE__->add_columns
    ( 'Version' => {
        'data_type' => 'VARCHAR',
        'is_auto_increment' => 0,
        'default_value' => undef,
        'is_foreign_key' => 0,
        'name' => 'Version',
        'is_nullable' => 0,
        'size' => '10'
        },
      'Installed' => {
          'data_type' => 'VARCHAR',
          'is_auto_increment' => 0,
          'default_value' => undef,
          'is_foreign_key' => 0,
          'name' => 'Installed',
          'is_nullable' => 0,
          'size' => '20'
          },
      );
__PACKAGE__->set_primary_key('Version');

package DBIx::Class::Version;
use base 'DBIx::Class::Schema';
use strict;
use warnings;

__PACKAGE__->register_class('Table', 'DBIx::Class::Version::Table');


# ---------------------------------------------------------------------------
package DBIx::Class::Schema::Versioned;

use strict;
use warnings;
use base 'DBIx::Class';
use POSIX 'strftime';
use Data::Dumper;

__PACKAGE__->mk_classdata('_filedata');
__PACKAGE__->mk_classdata('upgrade_directory');
__PACKAGE__->mk_classdata('backup_directory');
__PACKAGE__->mk_classdata('do_backup');

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) = @_;
    $self->{vschema} = DBIx::Class::Version->connect(@{$self->storage->connect_info()});

    my $pversion = $self->get_db_version();

    if($pversion eq $self->schema_version)
    {
        warn "This version is already installed\n";
        return 1;
    }

    if(!$pversion)
    {
        warn "Your DB is currently unversioned. Please call upgrade on your schema to sync the DB.\n";
        return 1;
    }

    my $file = $self->ddl_filename(
                                   $self->storage->sqlt_type,
                                   $self->upgrade_directory,
                                   $self->schema_version
                                   );
    if(!$file)
    {
        # No upgrade path between these two versions
        return 1;
    }


    ## 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";
}

sub get_db_version
{
    my ($self, $rs) = @_;

    my $vtable = $self->{vschema}->resultset('Table');
    return 0 unless ($self->_source_exists($vtable));

    my $psearch = $vtable->search(undef, 
                                    { select => [
                                                 { 'max' => 'Installed' },
                                                 ],
                                          as => ['maxinstall'],
                                      })->first;
    my $pversion = $vtable->search({ Installed => $psearch->get_column('maxinstall'),
                                })->first;
    $pversion = $pversion->Version if($pversion);
    return $pversion;
}

sub _source_exists
{
    my ($self, $rs) = @_;

    my $c = eval {
        $rs->search({ 1, 0 })->count;
    };
    return 0 if $@ || !defined $c;

    return 1;
}

sub backup
{
    my ($self) = @_;
    ## Make each ::DBI::Foo do this
    $self->storage->backup($self->backup_directory());
}

sub upgrade
{
    my ($self, $params) = @_;
    $params ||= {};
    my $db_version = $self->get_db_version();

    my %driver_to_db_map = (
                            'mysql' => 'MySQL'
                           );
    if (!$db_version) {
      my $db = $driver_to_db_map{$self->storage->dbh->{Driver}->{Name}};
      unless ($db) {
        print "Sorry, this is an unsupported DB\n";
        return;
      }

      if ($params->{create_diff}) {
        require SQL::Translator;
        require SQL::Translator::Diff;
        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 = $self->storage->configure_sqlt($dbic_tr, $db);
        $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);
        }
        
        my $diff = SQL::Translator::Diff::schema_diff($db_tr->schema, $db, 
                                                      $dbic_tr->schema, $db,
                                                      { caseopt => 1 });
        
        my $filename = $self->ddl_filename(
                                           $db,
                                           $self->upgrade_directory,
                                           $self->schema_version,
                                           'PRE',
                                           );
        my $file;
        if(!open($file, ">$filename")) {
          $self->throw_exception("Can't open $filename for writing ($!)");
          next;
        }
        print $file $diff;
        close($file);
        
        print "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";
      }

      # create versions table
      $self->{vschema}->deploy;
    } else {
      if ($db_version eq $self->schema_version) {
        print "Upgrade not necessary\n";
        return;
      }

      my $file = $self->ddl_filename(
                                 $self->storage->sqlt_type,
                                 $self->upgrade_directory,
                                 $self->schema_version,
                                 $db_version,
                                 );

      if(!-f $file)
      {
         warn "Upgrade not possible, no upgrade file found ($file)\n";
         return;
      }

      my $fh;
      open $fh, "<$file" or warn("Can't open upgrade file, $file ($!)");
      my @data = split(/\n/, join('', <$fh>));
      @data = grep(!/^--/, @data);
      @data = split(/;/, join('', @data));
      close($fh);
      @data = grep { $_ && $_ !~ /^-- / } @data;
      @data = grep { $_ !~ /^(BEGIN TRANACTION|COMMIT)/m } @data;
      
      $self->_filedata(\@data);
      $self->backup() if($self->do_backup);

      $self->txn_do(sub {
        $self->do_upgrade();
      });
    }

    my $vtable = $self->{vschema}->resultset('Table');
    $vtable->create({ Version => $self->schema_version,
                      Installed => strftime("%Y-%m-%d %H:%M:%S", gmtime())
                      });

}

sub do_upgrade
{
    my ($self) = @_;

    ## overridable sub, per default just run 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);
}

sub run_upgrade
{
    my ($self, $stm) = @_;
#    print "Reg: $stm\n";
    my @statements = grep { $_ =~ $stm } @{$self->_filedata};
#    print "Statements: ", join("\n", @statements), "\n";
    $self->_filedata([ grep { $_ !~ /$stm/i } @{$self->_filedata} ]);

    for (@statements)
    {      
        $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;
}

1;

=head1 NAME

DBIx::Class::Schema::Versioned - 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/+DBIx::Class::Schema::Versioned/);
  __PACKAGE__->upgrade_directory('/path/to/upgrades/');
  __PACKAGE__->backup_directory('/path/to/backups/');

  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<DBIx::Class::Schema>
classes, to enable them to upgrade to newer schema layouts. To use this
module, you need to have called C<create_ddl_dir> on your Schema to
create your upgrade files to include with your delivery.

A table called I<SchemaVersions> 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<ddl_filename>
in L<DBIx::Class::Schema>. 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<upgrade> 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.


=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. 

This method should return the name of the backup file, if appropriate..

=head2 upgrade

This is the main upgrade method which calls the overridable do_upgrade and
also handles the backups and updating of the SchemaVersion table.

=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<run_upgrade>
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<CREATE>
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<upgrade> 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 <castaway@desert-island.demon.co.uk>
Commit	Line	Data
c9d2e0a2	1	package DBIx::Class::Version::Table;
	2	use base 'DBIx::Class';
	3	use strict;
	4	use warnings;
	5
	6	__PACKAGE__->load_components(qw/ Core/);
	7	__PACKAGE__->table('SchemaVersions');
	8
ad1446da	9	__PACKAGE__->add_columns
	10	( 'Version' => {
	11	'data_type' => 'VARCHAR',
	12	'is_auto_increment' => 0,
	13	'default_value' => undef,
	14	'is_foreign_key' => 0,
	15	'name' => 'Version',
	16	'is_nullable' => 0,
	17	'size' => '10'
	18	},
c9d2e0a2	19	'Installed' => {
	20	'data_type' => 'VARCHAR',
	21	'is_auto_increment' => 0,
	22	'default_value' => undef,
	23	'is_foreign_key' => 0,
	24	'name' => 'Installed',
	25	'is_nullable' => 0,
	26	'size' => '20'
ad1446da	27	},
ad1446da	28	);
c9d2e0a2	29	__PACKAGE__->set_primary_key('Version');
	30
	31	package DBIx::Class::Version;
	32	use base 'DBIx::Class::Schema';
	33	use strict;
	34	use warnings;
	35
	36	__PACKAGE__->register_class('Table', 'DBIx::Class::Version::Table');
	37
	38
	39	# ---------------------------------------------------------------------------
	40	package DBIx::Class::Schema::Versioned;
	41
	42	use strict;
	43	use warnings;
	44	use base 'DBIx::Class';
	45	use POSIX 'strftime';
	46	use Data::Dumper;
	47
	48	__PACKAGE__->mk_classdata('_filedata');
	49	__PACKAGE__->mk_classdata('upgrade_directory');
8795fefb	50	__PACKAGE__->mk_classdata('backup_directory');
f925f7cb	51	__PACKAGE__->mk_classdata('do_backup');
c9d2e0a2	52
42416a0b	53	sub schema_version {
	54	my ($self) = @_;
	55	my $class = ref($self)\|\|$self;
	56	my $version;
	57	{
	58	no strict 'refs';
	59	$version = ${"${class}::VERSION"};
	60	}
	61	return $version;
	62	}
	63
a2800991	64	sub connection {
	65	my $self = shift;
	66	$self->next::method(@_);
	67	$self->_on_connect;
	68	return $self;
	69	}
	70
737416a4	71	sub _on_connect
c9d2e0a2	72	{
c9d2e0a2	73	my ($self) = @_;
e6129e56	74	$self->{vschema} = DBIx::Class::Version->connect(@{$self->storage->connect_info()});
e2c0df8e	75
0d865134	76	my $pversion = $self->get_db_version();
0d865134	77
42416a0b	78	if($pversion eq $self->schema_version)
c9d2e0a2	79	{
	80	warn "This version is already installed\n";
	81	return 1;
	82	}
	83
c9d2e0a2	84	if(!$pversion)
c9d2e0a2	85	{
0d865134	86	warn "Your DB is currently unversioned. Please call upgrade on your schema to sync the DB.\n";
c9d2e0a2	87	return 1;
	88	}
	89
	90	my $file = $self->ddl_filename(
	91	$self->storage->sqlt_type,
	92	$self->upgrade_directory,
42416a0b	93	$self->schema_version
c9d2e0a2	94	);
	95	if(!$file)
	96	{
	97	# No upgrade path between these two versions
	98	return 1;
	99	}
	100
c9d2e0a2	101
	102	## Don't do this yet, do only on command?
	103	## If we do this later, where does the Version table get updated??
42416a0b	104	warn "Versions out of sync. This is " . $self->schema_version .
c9d2e0a2	105	", your database contains version $pversion, please call upgrade on your Schema.\n";
c9d2e0a2	106	}
c9d2e0a2	107
e6129e56	108	sub get_db_version
	109	{
	110	my ($self, $rs) = @_;
	111
	112	my $vtable = $self->{vschema}->resultset('Table');
0d865134	113	return 0 unless ($self->_source_exists($vtable));
0d865134	114
e6129e56	115	my $psearch = $vtable->search(undef,
	116	{ select => [
	117	{ 'max' => 'Installed' },
	118	],
	119	as => ['maxinstall'],
	120	})->first;
f925f7cb	121	my $pversion = $vtable->search({ Installed => $psearch->get_column('maxinstall'),
e6129e56	122	})->first;
	123	$pversion = $pversion->Version if($pversion);
	124	return $pversion;
	125	}
	126
a2800991	127	sub _source_exists
c9d2e0a2	128	{
	129	my ($self, $rs) = @_;
	130
	131	my $c = eval {
	132	$rs->search({ 1, 0 })->count;
	133	};
	134	return 0 if $@ \|\| !defined $c;
	135
	136	return 1;
	137	}
	138
	139	sub backup
	140	{
	141	my ($self) = @_;
	142	## Make each ::DBI::Foo do this
8795fefb	143	$self->storage->backup($self->backup_directory());
c9d2e0a2	144	}
	145
	146	sub upgrade
	147	{
ad1446da	148	my ($self, $params) = @_;
ad1446da	149	$params \|\|= {};
0d865134	150	my $db_version = $self->get_db_version();
c9d2e0a2	151
1d48fcff	152	my %driver_to_db_map = (
	153	'mysql' => 'MySQL'
	154	);
0d865134	155	if (!$db_version) {
0d865134	156	my $db = $driver_to_db_map{$self->storage->dbh->{Driver}->{Name}};
	157	unless ($db) {
	158	print "Sorry, this is an unsupported DB\n";
	159	return;
	160	}
	161
ad1446da	162	if ($params->{create_diff}) {
	163	require SQL::Translator;
	164	require SQL::Translator::Diff;
	165	my $db_tr = SQL::Translator->new({
	166	add_drop_table => 1,
	167	parser => 'DBI',
	168	parser_args => { dbh => $self->storage->dbh }
	169	});
	170
	171	$db_tr->producer($db);
	172	my $dbic_tr = SQL::Translator->new;
	173	$dbic_tr->parser('SQL::Translator::Parser::DBIx::Class');
	174	$dbic_tr = $self->storage->configure_sqlt($dbic_tr, $db);
	175	$dbic_tr->data($self);
	176	$dbic_tr->producer($db);
	177
	178	$db_tr->schema->name('db_schema');
	179	$dbic_tr->schema->name('dbic_schema');
	180
	181	# is this really necessary?
	182	foreach my $tr ($db_tr, $dbic_tr) {
	183	my $data = $tr->data;
	184	$tr->parser->($tr, $$data);
	185	}
	186
	187	my $diff = SQL::Translator::Diff::schema_diff($db_tr->schema, $db,
	188	$dbic_tr->schema, $db,
	189	{ caseopt => 1 });
	190
	191	my $filename = $self->ddl_filename(
	192	$db,
	193	$self->upgrade_directory,
	194	$self->schema_version,
	195	'PRE',
	196	);
	197	my $file;
	198	if(!open($file, ">$filename")) {
0d865134	199	$self->throw_exception("Can't open $filename for writing ($!)");
0d865134	200	next;
ad1446da	201	}
	202	print $file $diff;
	203	close($file);
	204
	205	print "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";
0d865134	206	}
0d865134	207
bcd1448c	208	# create versions table
bcd1448c	209	$self->{vschema}->deploy;
0d865134	210	} else {
1d48fcff	211	if ($db_version eq $self->schema_version) {
	212	print "Upgrade not necessary\n";
	213	return;
	214	}
	215
0d865134	216	my $file = $self->ddl_filename(
b98d9e8a	217	$self->storage->sqlt_type,
	218	$self->upgrade_directory,
	219	$self->schema_version,
0d865134	220	$db_version,
b98d9e8a	221	);
b98d9e8a	222
0d865134	223	if(!-f $file)
	224	{
	225	warn "Upgrade not possible, no upgrade file found ($file)\n";
	226	return;
	227	}
	228
	229	my $fh;
	230	open $fh, "<$file" or warn("Can't open upgrade file, $file ($!)");
da153fe5	231	my @data = split(/\n/, join('', <$fh>));
	232	@data = grep(!/^--/, @data);
	233	@data = split(/;/, join('', @data));
0d865134	234	close($fh);
	235	@data = grep { $_ && $_ !~ /^-- / } @data;
	236	@data = grep { $_ !~ /^(BEGIN TRANACTION\|COMMIT)/m } @data;
	237
	238	$self->_filedata(\@data);
	239	$self->backup() if($self->do_backup);
	240
	241	$self->txn_do(sub {
	242	$self->do_upgrade();
	243	});
b98d9e8a	244	}
b98d9e8a	245
e6129e56	246	my $vtable = $self->{vschema}->resultset('Table');
	247	$vtable->create({ Version => $self->schema_version,
	248	Installed => strftime("%Y-%m-%d %H:%M:%S", gmtime())
	249	});
f925f7cb	250
e6129e56	251	}
c9d2e0a2	252
e6129e56	253	sub do_upgrade
	254	{
	255	my ($self) = @_;
	256
	257	## overridable sub, per default just run all the commands.
c9d2e0a2	258	$self->run_upgrade(qr/create/i);
	259	$self->run_upgrade(qr/alter table .*? add/i);
	260	$self->run_upgrade(qr/alter table .*? (?!drop)/i);
	261	$self->run_upgrade(qr/alter table .*? drop/i);
	262	$self->run_upgrade(qr/drop/i);
c9d2e0a2	263	}
c9d2e0a2	264
c9d2e0a2	265	sub run_upgrade
	266	{
	267	my ($self, $stm) = @_;
	268	# print "Reg: $stm\n";
	269	my @statements = grep { $_ =~ $stm } @{$self->_filedata};
	270	# print "Statements: ", join("\n", @statements), "\n";
	271	$self->_filedata([ grep { $_ !~ /$stm/i } @{$self->_filedata} ]);
	272
	273	for (@statements)
ad1446da	274	{
70f39278	275	$self->storage->debugobj->query_start($_) if $self->storage->debug;
c9d2e0a2	276	$self->storage->dbh->do($_) or warn "SQL was:\n $_";
70f39278	277	$self->storage->debugobj->query_end($_) if $self->storage->debug;
c9d2e0a2	278	}
	279
	280	return 1;
	281	}
	282
e2c0df8e	283	1;
e2c0df8e	284
c9d2e0a2	285	=head1 NAME
c9d2e0a2	286
7d9fbacf	287	DBIx::Class::Schema::Versioned - DBIx::Class::Schema plugin for Schema upgrades
c9d2e0a2	288
	289	=head1 SYNOPSIS
	290
	291	package Library::Schema;
	292	use base qw/DBIx::Class::Schema/;
	293	# load Library::Schema::CD, Library::Schema::Book, Library::Schema::DVD
	294	__PACKAGE__->load_classes(qw/CD Book DVD/);
	295
	296	__PACKAGE__->load_components(qw/+DBIx::Class::Schema::Versioned/);
	297	__PACKAGE__->upgrade_directory('/path/to/upgrades/');
8795fefb	298	__PACKAGE__->backup_directory('/path/to/backups/');
c9d2e0a2	299
	300	sub backup
	301	{
	302	my ($self) = @_;
	303	# my special backup process
	304	}
	305
	306	sub upgrade
	307	{
	308	my ($self) = @_;
	309
	310	## overridable sub, per default just runs all the commands.
	311
	312	$self->run_upgrade(qr/create/i);
	313	$self->run_upgrade(qr/alter table .*? add/i);
	314	$self->run_upgrade(qr/alter table .*? (?!drop)/i);
	315	$self->run_upgrade(qr/alter table .*? drop/i);
	316	$self->run_upgrade(qr/drop/i);
	317	$self->run_upgrade(qr//i);
	318	}
	319
	320	=head1 DESCRIPTION
	321
	322	This module is a component designed to extend L<DBIx::Class::Schema>
	323	classes, to enable them to upgrade to newer schema layouts. To use this
	324	module, you need to have called C<create_ddl_dir> on your Schema to
	325	create your upgrade files to include with your delivery.
	326
	327	A table called I<SchemaVersions> is created and maintained by the
	328	module. This contains two fields, 'Version' and 'Installed', which
	329	contain each VERSION of your Schema, and the date+time it was installed.
	330
	331	If you would like to influence which levels of version change need
	332	upgrades in your Schema, you can override the method C<ddl_filename>
	333	in L<DBIx::Class::Schema>. Return a false value if there is no upgrade
	334	path between the two versions supplied. By default, every change in
	335	your VERSION is regarded as needing an upgrade.
	336
8795fefb	337	The actual upgrade is called manually by calling C<upgrade> on your
	338	schema object. Code is run at connect time to determine whether an
	339	upgrade is needed, if so, a warning "Versions out of sync" is
	340	produced.
	341
c9d2e0a2	342	NB: At the moment, SQLite upgrading is rather spotty, as SQL::Translator::Diff
	343	returns SQL statements that SQLite does not support.
	344
	345
	346	=head1 METHODS
	347
	348	=head2 backup
	349
	350	This is an overwritable method which is called just before the upgrade, to
	351	allow you to make a backup of the database. Per default this method attempts
	352	to call C<< $self->storage->backup >>, to run the standard backup on each
	353	database type.
	354
e6129e56	355	This method should return the name of the backup file, if appropriate..
c9d2e0a2	356
	357	=head2 upgrade
	358
e6129e56	359	This is the main upgrade method which calls the overridable do_upgrade and
	360	also handles the backups and updating of the SchemaVersion table.
	361
	362	=head2 do_upgrade
	363
c9d2e0a2	364	This is an overwritable method used to run your upgrade. The freeform method
	365	allows you to run your upgrade any way you please, you can call C<run_upgrade>
	366	any number of times to run the actual SQL commands, and in between you can
	367	sandwich your data upgrading. For example, first run all the B<CREATE>
	368	commands, then migrate your data from old to new tables/formats, then
	369	issue the DROP commands when you are finished.
	370
	371	=head2 run_upgrade
	372
	373	$self->run_upgrade(qr/create/i);
	374
	375	Runs a set of SQL statements matching a passed in regular expression. The
	376	idea is that this method can be called any number of times from your
	377	C<upgrade> method, running whichever commands you specify via the
	378	regex in the parameter.
	379
8795fefb	380	=head2 upgrade_directory
	381
	382	Use this to set the directory your upgrade files are stored in.
	383
	384	=head2 backup_directory
	385
	386	Use this to set the directory you want your backups stored in.
	387
42416a0b	388	=head2 schema_version
	389
	390	Returns the current schema class' $VERSION; does -not- use $schema->VERSION
	391	since that varies in results depending on if version.pm is installed, and if
	392	so the perl or XS versions. If you want this to change, bug the version.pm
	393	author to make vpp and vxs behave the same.
	394
c9d2e0a2	395	=head1 AUTHOR
	396
	397	Jess Robinson <castaway@desert-island.demon.co.uk>