lib/DBIx/Class/Versioning.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::Versioning;
  41
  42 use strict;
  43 use warnings;
  44 use base 'DBIx::Class';
  45 use POSIX 'strftime';
  46 use Data::Dumper;
  47 # use DBIx::Class::Version;
  48
  49 __PACKAGE__->mk_classdata('_filedata');
  50 __PACKAGE__->mk_classdata('upgrade_directory');
  51
  52 sub on_connect
  53 {
  54     my ($self) = @_;
  55     print "on_connect\n";
  56     my $vschema = DBIx::Class::Version->connect(@{$self->storage->connect_info()});
  57     my $vtable = $vschema->resultset('Table');
  58     my $pversion;
  59     if(!$self->exists($vtable))
  60     {
  61         print "deploying.. \n";
  62         $vschema->storage->debug(1);
  63         print "Debugging is: ", $vschema->storage->debug, "\n";
  64         $vschema->deploy();
  65         $pversion = 0;
  66     }
  67     else
  68     {
  69         $pversion = $vtable->search(undef,
  70                                     { select => [
  71                                              'Version',
  72                                              { 'max' => 'Installed' },
  73                                              ],
  74                                       group_by => [ 'Version' ],
  75                                       })->first;
  76         $pversion = $pversion->Version if($pversion);
  77     }
  78     if($pversion eq $self->VERSION)
  79     {
  80         print "This version is already installed\n";
  81         return 1;
  82     }
  83
  84
  85     $vtable->create({ Version => $self->VERSION,
  86                       Installed => strftime("%Y-%m-%d %H:%M:%S", gmtime())
  87                       });
  88
  89     if(!$pversion)
  90     {
  91         print "No previous version found, skipping upgrade\n";
  92         return 1;
  93     }
  94
  95     my $file = $self->ddl_filename($self->upgrade_directory,
  96                                    $self->storage->sqlt_type,
  97                                    $self->VERSION
  98                                    );
  99     $file =~ s/@{[ $self->VERSION ]}/"${pversion}-" . $self->VERSION/e;
 100     if(!-f $file)
 101     {
 102         warn "Upgrade not possible, no upgrade file found ($file)\n";
 103         return;
 104     }
 105     print "Found Upgrade file: $file\n";
 106     my $fh;
 107     open $fh, "<$file" or warn("Can't open upgrade file, $file ($!)");
 108     my @data = split(/;\n/, join('', <$fh>));
 109     close($fh);
 110     @data = grep { $_ && $_ !~ /^-- / } @data;
 111     @data = grep { $_ !~ /^(BEGIN TRANACTION|COMMIT)/m } @data;
 112     print "Commands: ", join("\n", @data), "\n";
 113     $self->_filedata(\@data);
 114
 115     $self->backup();
 116     $self->upgrade();
 117
 118 # X Create version table if not exists?
 119 # Make backup
 120 # Run create statements
 121 # Run post-create callback
 122 # Run alter/drop statement
 123 # Run post-alter callback
 124 }
 125
 126 sub exists
 127 {
 128     my ($self, $rs) = @_;
 129
 130     eval {
 131         $rs->search({ 1, 0 })->count;
 132     };
 133
 134     return 0 if $@;
 135
 136     return 1;
 137 }
 138
 139 sub backup
 140 {
 141     my ($self) = @_;
 142 }
 143
 144 sub upgrade
 145 {
 146     my ($self) = @_;
 147
 148     ## overridable sub, per default just run all the commands.
 149
 150     $self->run_upgrade(qr/create/i);
 151     $self->run_upgrade(qr/alter table .*? add/i);
 152     $self->run_upgrade(qr/alter table .*? (?!drop)/i);
 153     $self->run_upgrade(qr/alter table .*? drop/i);
 154     $self->run_upgrade(qr/drop/i);
 155     $self->run_upgrade(qr//i);
 156 }
 157
 158
 159 sub run_upgrade
 160 {
 161     my ($self, $stm) = @_;
 162     print "Reg: $stm\n";
 163     my @statements = grep { $_ =~ $stm } @{$self->_filedata};
 164 #    print "Statements: ", join("\n", @statements), "\n";
 165     $self->_filedata([ grep { $_ !~ /$stm/i } @{$self->_filedata} ]);
 166
 167     for (@statements)
 168     {
 169         $self->storage->debugfh->print("$_\n") if $self->storage->debug;
 170         print "Running \n>>$_<<\n";
 171         $self->storage->dbh->do($_) or warn "SQL was:\n $_";
 172     }
 173
 174     return 1;
 175 }