Commit | Line | Data |
c9d2e0a2 |
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'); |
8795fefb |
50 | __PACKAGE__->mk_classdata('backup_directory'); |
c9d2e0a2 |
51 | |
42416a0b |
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 | |
737416a4 |
63 | sub _on_connect |
c9d2e0a2 |
64 | { |
65 | my ($self) = @_; |
66 | my $vschema = DBIx::Class::Version->connect(@{$self->storage->connect_info()}); |
67 | my $vtable = $vschema->resultset('Table'); |
68 | my $pversion; |
e2c0df8e |
69 | |
c9d2e0a2 |
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"); |
42416a0b |
90 | if($pversion eq $self->schema_version) |
c9d2e0a2 |
91 | { |
92 | warn "This version is already installed\n"; |
93 | return 1; |
94 | } |
95 | |
96 | ## use IC::DT? |
97 | |
98 | if(!$pversion) |
99 | { |
42416a0b |
100 | $vtable->create({ Version => $self->schema_version, |
c9d2e0a2 |
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, |
42416a0b |
112 | $self->schema_version |
c9d2e0a2 |
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, |
42416a0b |
123 | $self->schema_version, |
c9d2e0a2 |
124 | $pversion, |
125 | ); |
42416a0b |
126 | # $file =~ s/@{[ $self->schema_version ]}/"${pversion}-" . $self->schema_version/e; |
c9d2e0a2 |
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?? |
42416a0b |
144 | warn "Versions out of sync. This is " . $self->schema_version . |
c9d2e0a2 |
145 | ", your database contains version $pversion, please call upgrade on your Schema.\n"; |
42416a0b |
146 | # $self->upgrade($pversion, $self->schema_version); |
c9d2e0a2 |
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 |
8795fefb |
165 | $self->storage->backup($self->backup_directory()); |
c9d2e0a2 |
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'); |
42416a0b |
185 | $vtable->create({ Version => $self->schema_version, |
c9d2e0a2 |
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 | |
e2c0df8e |
209 | 1; |
210 | |
c9d2e0a2 |
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/'); |
8795fefb |
224 | __PACKAGE__->backup_directory('/path/to/backups/'); |
c9d2e0a2 |
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 | |
8795fefb |
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 | |
c9d2e0a2 |
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 | |
8795fefb |
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 | |
42416a0b |
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 | |
c9d2e0a2 |
319 | =head1 AUTHOR |
320 | |
321 | Jess Robinson <castaway@desert-island.demon.co.uk> |