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