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