lib/DBIx/Class/Schema/Versioned.pm

   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
   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         },
  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'
  27           },
  28       );
  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');
  50
  51 sub on_connect
  52 {
  53     my ($self) = @_;
  54     my $vschema = DBIx::Class::Version->connect(@{$self->storage->connect_info()});
  55     my $vtable = $vschema->resultset('Table');
  56     my $pversion;
  57     if(!$self->exists($vtable))
  58     {
  59 #        $vschema->storage->debug(1);
  60         $vschema->storage->ensure_connected();
  61         $vschema->deploy();
  62         $pversion = 0;
  63     }
  64     else
  65     {
  66         my $psearch = $vtable->search(undef,
  67                                       { select => [
  68                                                    { 'max' => 'Installed' },
  69                                                    ],
  70                                             as => ['maxinstall'],
  71                                         })->first;
  72         $pversion = $vtable->search({ Installed => $psearch->get_column('maxinstall'),
  73                                   })->first;
  74         $pversion = $pversion->Version if($pversion);
  75     }
  76 #    warn("Previous version: $pversion\n");
  77     if($pversion eq $self->VERSION)
  78     {
  79         warn "This version is already installed\n";
  80         return 1;
  81     }
  82
  83 ## use IC::DT?
  84
  85     if(!$pversion)
  86     {
  87         $vtable->create({ Version => $self->VERSION,
  88                           Installed => strftime("%Y-%m-%d %H:%M:%S", gmtime())
  89                           });
  90         ## If we let the user do this, where does the Version table get updated?
  91         warn "No previous version found, calling deploy to install this version.\n";
  92         $self->deploy();
  93         return 1;
  94     }
  95
  96     my $file = $self->ddl_filename(
  97                                    $self->storage->sqlt_type,
  98                                    $self->upgrade_directory,
  99                                    $self->VERSION
 100                                    );
 101     if(!$file)
 102     {
 103         # No upgrade path between these two versions
 104         return 1;
 105     }
 106
 107      $file = $self->ddl_filename(
 108                                  $self->storage->sqlt_type,
 109                                  $self->upgrade_directory,
 110                                  $self->VERSION,
 111                                  $pversion,
 112                                  );
 113 #    $file =~ s/@{[ $self->VERSION ]}/"${pversion}-" . $self->VERSION/e;
 114     if(!-f $file)
 115     {
 116         warn "Upgrade not possible, no upgrade file found ($file)\n";
 117         return;
 118     }
 119
 120     my $fh;
 121     open $fh, "<$file" or warn("Can't open upgrade file, $file ($!)");
 122     my @data = split(/;\n/, join('', <$fh>));
 123     close($fh);
 124     @data = grep { $_ && $_ !~ /^-- / } @data;
 125     @data = grep { $_ !~ /^(BEGIN TRANACTION|COMMIT)/m } @data;
 126
 127     $self->_filedata(\@data);
 128
 129     ## Don't do this yet, do only on command?
 130     ## If we do this later, where does the Version table get updated??
 131     warn "Versions out of sync. This is " . $self->VERSION .
 132         ", your database contains version $pversion, please call upgrade on your Schema.\n";
 133 #    $self->upgrade($pversion, $self->VERSION);
 134 }
 135
 136 sub exists
 137 {
 138     my ($self, $rs) = @_;
 139
 140     my $c = eval {
 141         $rs->search({ 1, 0 })->count;
 142     };
 143     return 0 if $@ || !defined $c;
 144
 145     return 1;
 146 }
 147
 148 sub backup
 149 {
 150     my ($self) = @_;
 151     ## Make each ::DBI::Foo do this
 152     $self->storage->backup();
 153 }
 154
 155 sub upgrade
 156 {
 157     my ($self) = @_;
 158
 159     ## overridable sub, per default just run all the commands.
 160
 161     $self->backup();
 162
 163     $self->run_upgrade(qr/create/i);
 164     $self->run_upgrade(qr/alter table .*? add/i);
 165     $self->run_upgrade(qr/alter table .*? (?!drop)/i);
 166     $self->run_upgrade(qr/alter table .*? drop/i);
 167     $self->run_upgrade(qr/drop/i);
 168 #    $self->run_upgrade(qr//i);
 169
 170     my $vschema = DBIx::Class::Version->connect(@{$self->storage->connect_info()});
 171     my $vtable = $vschema->resultset('Table');
 172     $vtable->create({ Version => $self->VERSION,
 173                       Installed => strftime("%Y-%m-%d %H:%M:%S", gmtime())
 174                       });
 175 }
 176
 177
 178 sub run_upgrade
 179 {
 180     my ($self, $stm) = @_;
 181 #    print "Reg: $stm\n";
 182     my @statements = grep { $_ =~ $stm } @{$self->_filedata};
 183 #    print "Statements: ", join("\n", @statements), "\n";
 184     $self->_filedata([ grep { $_ !~ /$stm/i } @{$self->_filedata} ]);
 185
 186     for (@statements)
 187     {
 188         $self->storage->debugfh->print("$_\n") if $self->storage->debug;
 189 #        print "Running \n>>$_<<\n";
 190         $self->storage->dbh->do($_) or warn "SQL was:\n $_";
 191     }
 192
 193     return 1;
 194 }
 195
 196 =head1 NAME
 197
 198 DBIx::Class::Versioning - DBIx::Class::Schema plugin for Schema upgrades
 199
 200 =head1 SYNOPSIS
 201
 202   package Library::Schema;
 203   use base qw/DBIx::Class::Schema/;
 204   # load Library::Schema::CD, Library::Schema::Book, Library::Schema::DVD
 205   __PACKAGE__->load_classes(qw/CD Book DVD/);
 206
 207   __PACKAGE__->load_components(qw/+DBIx::Class::Schema::Versioned/);
 208   __PACKAGE__->upgrade_directory('/path/to/upgrades/');
 209
 210   sub backup
 211   {
 212     my ($self) = @_;
 213     # my special backup process
 214   }
 215
 216   sub upgrade
 217   {
 218     my ($self) = @_;
 219
 220     ## overridable sub, per default just runs all the commands.
 221
 222     $self->run_upgrade(qr/create/i);
 223     $self->run_upgrade(qr/alter table .*? add/i);
 224     $self->run_upgrade(qr/alter table .*? (?!drop)/i);
 225     $self->run_upgrade(qr/alter table .*? drop/i);
 226     $self->run_upgrade(qr/drop/i);
 227     $self->run_upgrade(qr//i);
 228   }
 229
 230 =head1 DESCRIPTION
 231
 232 This module is a component designed to extend L<DBIx::Class::Schema>
 233 classes, to enable them to upgrade to newer schema layouts. To use this
 234 module, you need to have called C<create_ddl_dir> on your Schema to
 235 create your upgrade files to include with your delivery.
 236
 237 A table called I<SchemaVersions> is created and maintained by the
 238 module. This contains two fields, 'Version' and 'Installed', which
 239 contain each VERSION of your Schema, and the date+time it was installed.
 240
 241 If you would like to influence which levels of version change need
 242 upgrades in your Schema, you can override the method C<ddl_filename>
 243 in L<DBIx::Class::Schema>. Return a false value if there is no upgrade
 244 path between the two versions supplied. By default, every change in
 245 your VERSION is regarded as needing an upgrade.
 246
 247 NB: At the moment, SQLite upgrading is rather spotty, as SQL::Translator::Diff
 248 returns SQL statements that SQLite does not support.
 249
 250
 251 =head1 METHODS
 252
 253 =head2 backup
 254
 255 This is an overwritable method which is called just before the upgrade, to
 256 allow you to make a backup of the database. Per default this method attempts
 257 to call C<< $self->storage->backup >>, to run the standard backup on each
 258 database type.
 259
 260 This method should return the name of the backup file, if appropriate.
 261
 262 C<backup> is called from C<upgrade>, make sure you call it, if you write your
 263 own <upgrade> method.
 264
 265 =head2 upgrade
 266
 267 This is an overwritable method used to run your upgrade. The freeform method
 268 allows you to run your upgrade any way you please, you can call C<run_upgrade>
 269 any number of times to run the actual SQL commands, and in between you can
 270 sandwich your data upgrading. For example, first run all the B<CREATE>
 271 commands, then migrate your data from old to new tables/formats, then
 272 issue the DROP commands when you are finished.
 273
 274 =head2 run_upgrade
 275
 276  $self->run_upgrade(qr/create/i);
 277
 278 Runs a set of SQL statements matching a passed in regular expression. The
 279 idea is that this method can be called any number of times from your
 280 C<upgrade> method, running whichever commands you specify via the
 281 regex in the parameter.
 282
 283 =head1 AUTHOR
 284
 285 Jess Robinson <castaway@desert-island.demon.co.uk>