From: Jess Robinson Date: Fri, 19 May 2006 08:38:59 +0000 (+0000) Subject: Remove Versioning.pm, add backup to SQLite X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=645670f5d654667e543b5ee86ae4fb6436aa389b;p=dbsrgits%2FDBIx-Class-Historic.git Remove Versioning.pm, add backup to SQLite --- diff --git a/lib/DBIx/Class/Storage/DBI/SQLite.pm b/lib/DBIx/Class/Storage/DBI/SQLite.pm index 091b5e7..1275406 100644 --- a/lib/DBIx/Class/Storage/DBI/SQLite.pm +++ b/lib/DBIx/Class/Storage/DBI/SQLite.pm @@ -2,6 +2,9 @@ package DBIx::Class::Storage::DBI::SQLite; use strict; use warnings; +use POSIX 'strftime'; +use File::Copy; +use Path::Class; use base qw/DBIx::Class::Storage::DBI::MultiDistinctEmulation/; @@ -9,6 +12,34 @@ sub last_insert_id { return $_[0]->dbh->func('last_insert_rowid'); } +sub backup +{ + my ($self) = @_; + + ## Where is the db file? + my $dsn = $self->connect_info()->[0]; + + my $dbname = $1 if($dsn =~ /dbname=([^;]+)/); + if(!$dbname) + { + $dbname = $1 if($dsn =~ /^dbi:SQLite:(.+)$/i); + } + $self->throw_exception("Cannot determine name of SQLite db file") + if(!$dbname || !-f $dbname); + + print "Found database: $dbname\n"; + my $dbfile = file($dbname); +# my ($vol, $dir, $file) = File::Spec->splitpath($dbname); + my $file = $dbfile->basename(); + $file = strftime("%y%m%d%h%M%s", localtime()) . $file; + $file = "B$file" while(-f $file); + + my $res = copy($dbname, $file); + $self->throw_exception("Backup failed! ($!)") if(!$res); + + return $file; +} + 1; =head1 NAME diff --git a/lib/DBIx/Class/Versioning.pm b/lib/DBIx/Class/Versioning.pm deleted file mode 100644 index 7e892d7..0000000 --- a/lib/DBIx/Class/Versioning.pm +++ /dev/null @@ -1,270 +0,0 @@ -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 -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