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