[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');


# ---------------------------------------------------------------------------

=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/');


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

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.

So you'll probably want to write a script which generates your DDLs and diffs
and another which executes the upgrade.

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

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

=cut

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');
__PACKAGE__->mk_classdata('do_diff_on_init');

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

=cut

sub schema_version {
  my ($self) = @_;
  my $class = ref($self)||$self;
  my $version;
  {
    no strict 'refs';
    $version = ${"${class}::VERSION"};
  }
  return $version;
}

=head2 get_db_version

Returns the version that your database is currently at. This is determined by the values in the
SchemaVersions table that $self->upgrade writes to.

=cut

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

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

=cut

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

# is this just a waste of time?
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;
  }

  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,
                                                { ignore_constraint_names => 1, ignore_index_names => 1, 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";
}

=head2 upgrade

Call this to attempt to upgrade your database from the version it is at to the version
this DBIC schema is at. 

It requires an SQL diff file to exist in $schema->upgrade_directory, normally you will
have created this using $schema->create_ddl_dir.

=cut

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

  # db unversioned
  unless ($db_version) {
    # set version in SchemaVersions table, can't actually upgrade as we don 't know what version the DB is at
    $self->_create_db_to_schema_diff() if ($self->do_diff_on_init);

    # create versions table and version row
    $self->{vschema}->deploy;
    $self->_set_db_version;
    return;
  }

  # db and schema at same version. do nothing
  if ($db_version eq $self->schema_version) {
    print "Upgrade not necessary\n";
    return;
  }

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

  unless (-f $upgrade_file) {
    warn "Upgrade not possible, no upgrade file found ($upgrade_file), please create one\n";
    return;
  }

  # 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 SchemaVersions table
  $self->_set_db_version;
}

sub _set_db_version {
  my $self = shift;

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

}

sub _read_sql_file {
  my $self = shift;
  my $file = shift || return;

  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;
  return \@data;
}

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

Will run the whole file as it is by default.

=cut

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);
}

=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. Probably won't work unless called from the overridable
do_upgrade method.

=cut

sub run_upgrade
{
    my ($self, $stm) = @_;

    return unless ($self->_filedata);
    my @statements = grep { $_ =~ $stm } @{$self->_filedata};
    $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;
}

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

  warn "Versions out of sync. This is " . $self->schema_version . 
    ", your database contains version $pversion, please call upgrade on your Schema.\n";
}

1;


=head1 AUTHORS

Jess Robinson <castaway@desert-island.demon.co.uk>
Luke Saunders <luke@shadowcatsystems.co.uk>

=head1 LICENSE

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