--- /dev/null
+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::Versioning;
+
+use strict;
+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');
+
+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))
+ {
+# 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);
+ }
+# warn("Previous version: $pversion\n");
+ if($pversion eq $self->VERSION)
+ {
+ warn "This version is already installed\n";
+ return 1;
+ }
+
+
+ $vtable->create({ Version => $self->VERSION,
+ Installed => strftime("%Y-%m-%d %H:%M:%S", gmtime())
+ });
+
+ if(!$pversion)
+ {
+ 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";
+ 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
+{
+ my ($self, $rs) = @_;
+
+ eval {
+ $rs->search({ 1, 0 })->count;
+ };
+
+ return 0 if $@;
+
+ return 1;
+}
+
+sub backup
+{
+ my ($self) = @_;
+ ## Make each ::DBI::Foo do this
+# $self->storage->backup();
+}
+
+sub 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);
+ $self->run_upgrade(qr//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->debugfh->print("$_\n") if $self->storage->debug;
+# 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<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.
+
+
+=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<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.
+
+=head1 AUTHOR
+
+Jess Robinson <castaway@desert-island.demon.co.uk>
projects / dbsrgits/DBIx-Class.git / commitdiff