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