← Index
NYTProf Performance Profile   « block view • line view • sub view »
For xt/tapper-mcp-scheduler-with-db-longrun.t
  Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:23:07 2012

Filename/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/DBIx/Class/Schema/Versioned.pm
StatementsExecuted 161 statements in 3.32ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
311280µs8.27msDBIx::Class::Schema::Versioned::::_on_connect DBIx::Class::Schema::Versioned::_on_connect
211249µs215msDBIx::Class::Schema::Versioned::::_set_db_version DBIx::Class::Schema::Versioned::_set_db_version
532191µs63.6msDBIx::Class::Schema::Versioned::::get_db_version DBIx::Class::Schema::Versioned::get_db_version
211171µs502msDBIx::Class::Schema::Versioned::::install DBIx::Class::Schema::Versioned::install
511168µs59.7msDBIx::Class::Schema::Versioned::::__ANON__[:533] DBIx::Class::Schema::Versioned::__ANON__[:533]
211108µs8.48sDBIx::Class::Schema::Versioned::::deploy DBIx::Class::Schema::Versioned::deploy
31155µs32.4msDBIx::Class::Schema::Versioned::::connection DBIx::Class::Schema::Versioned::connection
11145µs2.73msDBIx::Class::Schema::Versioned::::__ANON__[:752] DBIx::Class::Schema::Versioned::__ANON__[:752]
11116µs167µsDBIx::Class::Version::Table::::BEGIN@3 DBIx::Class::Version::Table::BEGIN@3
11115µs2.76msDBIx::Class::Schema::Versioned::::_source_exists DBIx::Class::Schema::Versioned::_source_exists
11111µs220µsDBIx::Class::Schema::Versioned::::BEGIN@205 DBIx::Class::Schema::Versioned::BEGIN@205
11110µs218µsDBIx::Class::Schema::Versioned::::BEGIN@207 DBIx::Class::Schema::Versioned::BEGIN@207
11110µs52µsDBIx::Class::Schema::Versioned::::BEGIN@206 DBIx::Class::Schema::Versioned::BEGIN@206
1119µs13µsDBIx::Class::Version::Table::::BEGIN@4 DBIx::Class::Version::Table::BEGIN@4
1118µs25µsDBIx::Class::Version::Table::::BEGIN@5 DBIx::Class::Version::Table::BEGIN@5
1118µs91µsDBIx::Class::Schema::Versioned::::BEGIN@204 DBIx::Class::Schema::Versioned::BEGIN@204
1118µs65µsDBIx::Class::Version::TableCompat::::BEGIN@33DBIx::Class::Version::TableCompat::BEGIN@33
1117µs9µsDBIx::Class::Schema::Versioned::::BEGIN@200 DBIx::Class::Schema::Versioned::BEGIN@200
1117µs16µsDBIx::Class::VersionCompat::::BEGIN@58 DBIx::Class::VersionCompat::BEGIN@58
1117µs59µsDBIx::Class::Schema::Versioned::::BEGIN@202 DBIx::Class::Schema::Versioned::BEGIN@202
1117µs17µsDBIx::Class::Version::::BEGIN@50 DBIx::Class::Version::BEGIN@50
1117µs15µsDBIx::Class::Schema::Versioned::::BEGIN@201 DBIx::Class::Schema::Versioned::BEGIN@201
1116µs8µsDBIx::Class::Version::::BEGIN@49 DBIx::Class::Version::BEGIN@49
1116µs53µsDBIx::Class::VersionCompat::::BEGIN@56 DBIx::Class::VersionCompat::BEGIN@56
1116µs8µsDBIx::Class::VersionCompat::::BEGIN@57 DBIx::Class::VersionCompat::BEGIN@57
1116µs57µsDBIx::Class::Version::::BEGIN@48 DBIx::Class::Version::BEGIN@48
0000s0sDBIx::Class::Schema::Versioned::::__ANON__[:449] DBIx::Class::Schema::Versioned::__ANON__[:449]
0000s0sDBIx::Class::Schema::Versioned::::__ANON__[:754] DBIx::Class::Schema::Versioned::__ANON__[:754]
0000s0sDBIx::Class::Schema::Versioned::::_create_db_to_schema_diff DBIx::Class::Schema::Versioned::_create_db_to_schema_diff
0000s0sDBIx::Class::Schema::Versioned::::_read_sql_file DBIx::Class::Schema::Versioned::_read_sql_file
0000s0sDBIx::Class::Schema::Versioned::::apply_statement DBIx::Class::Schema::Versioned::apply_statement
0000s0sDBIx::Class::Schema::Versioned::::backup DBIx::Class::Schema::Versioned::backup
0000s0sDBIx::Class::Schema::Versioned::::create_upgrade_path DBIx::Class::Schema::Versioned::create_upgrade_path
0000s0sDBIx::Class::Schema::Versioned::::do_upgrade DBIx::Class::Schema::Versioned::do_upgrade
0000s0sDBIx::Class::Schema::Versioned::::ordered_schema_versions DBIx::Class::Schema::Versioned::ordered_schema_versions
0000s0sDBIx::Class::Schema::Versioned::::run_upgrade DBIx::Class::Schema::Versioned::run_upgrade
0000s0sDBIx::Class::Schema::Versioned::::upgrade DBIx::Class::Schema::Versioned::upgrade
0000s0sDBIx::Class::Schema::Versioned::::upgrade_single_step DBIx::Class::Schema::Versioned::upgrade_single_step
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package # Hide from PAUSE
2 DBIx::Class::Version::Table;
3323µs2318µs
# spent 167µs (16+151) within DBIx::Class::Version::Table::BEGIN@3 which was called: # once (16µs+151µs) by Class::C3::Componentised::ensure_class_loaded at line 3
use base 'DBIx::Class::Core';
# spent 167µs making 1 call to DBIx::Class::Version::Table::BEGIN@3 # spent 151µs making 1 call to base::import
4318µs218µs
# spent 13µs (9+4) within DBIx::Class::Version::Table::BEGIN@4 which was called: # once (9µs+4µs) by Class::C3::Componentised::ensure_class_loaded at line 4
use strict;
# spent 13µs making 1 call to DBIx::Class::Version::Table::BEGIN@4 # spent 4µs making 1 call to strict::import
5378µs241µs
# spent 25µs (8+16) within DBIx::Class::Version::Table::BEGIN@5 which was called: # once (8µs+16µs) by Class::C3::Componentised::ensure_class_loaded at line 5
use warnings;
# spent 25µs making 1 call to DBIx::Class::Version::Table::BEGIN@5 # spent 16µs making 1 call to warnings::import
6
7140µs1488µs__PACKAGE__->table('dbix_class_schema_versions');
# spent 488µs making 1 call to DBIx::Class::ResultSourceProxy::Table::table
8
9127µs1463µs__PACKAGE__->add_columns
# spent 463µs making 1 call to DBIx::Class::ResultSourceProxy::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 );
29118µs165µs__PACKAGE__->set_primary_key('version');
30
31package # Hide from PAUSE
32 DBIx::Class::Version::TableCompat;
33348µs2122µs
# spent 65µs (8+57) within DBIx::Class::Version::TableCompat::BEGIN@33 which was called: # once (8µs+57µs) by Class::C3::Componentised::ensure_class_loaded at line 33
use base 'DBIx::Class::Core';
# spent 65µs making 1 call to DBIx::Class::Version::TableCompat::BEGIN@33 # spent 57µs making 1 call to base::import
34118µs1329µs__PACKAGE__->table('SchemaVersions');
# spent 329µs making 1 call to DBIx::Class::ResultSourceProxy::Table::table
35
36117µs1350µs__PACKAGE__->add_columns
# spent 350µs making 1 call to DBIx::Class::ResultSourceProxy::add_columns
37 ( 'Version' => {
38 'data_type' => 'VARCHAR',
39 },
40 'Installed' => {
41 'data_type' => 'VARCHAR',
42 },
43 );
44116µs141µs__PACKAGE__->set_primary_key('Version');
45
46package # Hide from PAUSE
47 DBIx::Class::Version;
48318µs2108µs
# spent 57µs (6+51) within DBIx::Class::Version::BEGIN@48 which was called: # once (6µs+51µs) by Class::C3::Componentised::ensure_class_loaded at line 48
use base 'DBIx::Class::Schema';
# spent 57µs making 1 call to DBIx::Class::Version::BEGIN@48 # spent 51µs making 1 call to base::import
49316µs210µs
# spent 8µs (6+2) within DBIx::Class::Version::BEGIN@49 which was called: # once (6µs+2µs) by Class::C3::Componentised::ensure_class_loaded at line 49
use strict;
# spent 8µs making 1 call to DBIx::Class::Version::BEGIN@49 # spent 2µs making 1 call to strict::import
50335µs227µs
# spent 17µs (7+10) within DBIx::Class::Version::BEGIN@50 which was called: # once (7µs+10µs) by Class::C3::Componentised::ensure_class_loaded at line 50
use warnings;
# spent 17µs making 1 call to DBIx::Class::Version::BEGIN@50 # spent 10µs making 1 call to warnings::import
51
5216µs1314µs__PACKAGE__->register_class('Table', 'DBIx::Class::Version::Table');
# spent 314µs making 1 call to DBIx::Class::Schema::register_class
53
54package # Hide from PAUSE
55 DBIx::Class::VersionCompat;
56318µs2100µs
# spent 53µs (6+47) within DBIx::Class::VersionCompat::BEGIN@56 which was called: # once (6µs+47µs) by Class::C3::Componentised::ensure_class_loaded at line 56
use base 'DBIx::Class::Schema';
# spent 53µs making 1 call to DBIx::Class::VersionCompat::BEGIN@56 # spent 47µs making 1 call to base::import
57319µs210µs
# spent 8µs (6+2) within DBIx::Class::VersionCompat::BEGIN@57 which was called: # once (6µs+2µs) by Class::C3::Componentised::ensure_class_loaded at line 57
use strict;
# spent 8µs making 1 call to DBIx::Class::VersionCompat::BEGIN@57 # spent 2µs making 1 call to strict::import
58380µs224µs
# spent 16µs (7+9) within DBIx::Class::VersionCompat::BEGIN@58 which was called: # once (7µs+9µs) by Class::C3::Componentised::ensure_class_loaded at line 58
use warnings;
# spent 16µs making 1 call to DBIx::Class::VersionCompat::BEGIN@58 # spent 9µs making 1 call to warnings::import
59
6014µs1190µs__PACKAGE__->register_class('TableCompat', 'DBIx::Class::Version::TableCompat');
# spent 190µs making 1 call to DBIx::Class::Schema::register_class
61
62
63# ---------------------------------------------------------------------------
64
65=head1 NAME
66
67DBIx::Class::Schema::Versioned - DBIx::Class::Schema plugin for Schema upgrades
68
69=head1 SYNOPSIS
70
71 package MyApp::Schema;
72 use base qw/DBIx::Class::Schema/;
73
74 our $VERSION = 0.001;
75
76 # load MyApp::Schema::CD, MyApp::Schema::Book, MyApp::Schema::DVD
77 __PACKAGE__->load_classes(qw/CD Book DVD/);
78
79 __PACKAGE__->load_components(qw/Schema::Versioned/);
80 __PACKAGE__->upgrade_directory('/path/to/upgrades/');
81
82
83=head1 DESCRIPTION
84
85This module provides methods to apply DDL changes to your database using SQL
86diff files. Normally these diff files would be created using
87L<DBIx::Class::Schema/create_ddl_dir>.
88
89A table called I<dbix_class_schema_versions> is created and maintained by the
90module. This is used to determine which version your database is currently at.
91Similarly the $VERSION in your DBIC schema class is used to determine the
92current DBIC schema version.
93
94The upgrade is initiated manually by calling C<upgrade> on your schema object,
95this will attempt to upgrade the database from its current version to the current
96schema version using a diff from your I<upgrade_directory>. If a suitable diff is
97not found then no upgrade is possible.
98
99=head1 SEE ALSO
100
101L<DBIx::Class::DeploymentHandler> is a much more powerful alternative to this
102module. Examples of things it can do that this module cannot do include
103
104=over
105
106=item *
107
108Downgrades in addition to upgrades
109
110=item *
111
112Multiple sql files files per upgrade/downgrade/install
113
114=item *
115
116Perl scripts allowed for upgrade/downgrade/install
117
118=item *
119
120Just one set of files needed for upgrade, unlike this module where one might
121need to generate C<factorial(scalar @versions)>
122
123=back
124
125=head1 GETTING STARTED
126
127Firstly you need to setup your schema class as per the L</SYNOPSIS>, make sure
128you have specified an upgrade_directory and an initial $VERSION.
129
130Then you'll need two scripts, one to create DDL files and diffs and another to perform
131upgrades. Your creation script might look like a bit like this:
132
133 use strict;
134 use Pod::Usage;
135 use Getopt::Long;
136 use MyApp::Schema;
137
138 my ( $preversion, $help );
139 GetOptions(
140 'p|preversion:s' => \$preversion,
141 ) or die pod2usage;
142
143 my $schema = MyApp::Schema->connect(
144 $dsn,
145 $user,
146 $password,
147 );
148 my $sql_dir = './sql';
149 my $version = $schema->schema_version();
150 $schema->create_ddl_dir( 'MySQL', $version, $sql_dir, $preversion );
151
152Then your upgrade script might look like so:
153
154 use strict;
155 use MyApp::Schema;
156
157 my $schema = MyApp::Schema->connect(
158 $dsn,
159 $user,
160 $password,
161 );
162
163 if (!$schema->get_db_version()) {
164 # schema is unversioned
165 $schema->deploy();
166 } else {
167 $schema->upgrade();
168 }
169
170The script above assumes that if the database is unversioned then it is empty
171and we can safely deploy the DDL to it. However things are not always so simple.
172
173if you want to initialise a pre-existing database where the DDL is not the same
174as the DDL for your current schema version then you will need a diff which
175converts the database's DDL to the current DDL. The best way to do this is
176to get a dump of the database schema (without data) and save that in your
177SQL directory as version 0.000 (the filename must be as with
178L<DBIx::Class::Schema/ddl_filename>) then create a diff using your create DDL
179script given above from version 0.000 to the current version. Then hand check
180and if necessary edit the resulting diff to ensure that it will apply. Once you have
181done all that you can do this:
182
183 if (!$schema->get_db_version()) {
184 # schema is unversioned
185 $schema->install("0.000");
186 }
187
188 # this will now apply the 0.000 to current version diff
189 $schema->upgrade();
190
191In the case of an unversioned database the above code will create the
192dbix_class_schema_versions table and write version 0.000 to it, then
193upgrade will then apply the diff we talked about creating in the previous paragraph
194and then you're good to go.
195
196=cut
197
198package DBIx::Class::Schema::Versioned;
199
200317µs211µs
# spent 9µs (7+2) within DBIx::Class::Schema::Versioned::BEGIN@200 which was called: # once (7µs+2µs) by Class::C3::Componentised::ensure_class_loaded at line 200
use strict;
# spent 9µs making 1 call to DBIx::Class::Schema::Versioned::BEGIN@200 # spent 2µs making 1 call to strict::import
201317µs223µs
# spent 15µs (7+8) within DBIx::Class::Schema::Versioned::BEGIN@201 which was called: # once (7µs+8µs) by Class::C3::Componentised::ensure_class_loaded at line 201
use warnings;
# spent 15µs making 1 call to DBIx::Class::Schema::Versioned::BEGIN@201 # spent 8µs making 1 call to warnings::import
202318µs2111µs
# spent 59µs (7+52) within DBIx::Class::Schema::Versioned::BEGIN@202 which was called: # once (7µs+52µs) by Class::C3::Componentised::ensure_class_loaded at line 202
use base 'DBIx::Class::Schema';
# spent 59µs making 1 call to DBIx::Class::Schema::Versioned::BEGIN@202 # spent 52µs making 1 call to base::import
203
204327µs2174µs
# spent 91µs (8+83) within DBIx::Class::Schema::Versioned::BEGIN@204 which was called: # once (8µs+83µs) by Class::C3::Componentised::ensure_class_loaded at line 204
use DBIx::Class::Carp;
# spent 91µs making 1 call to DBIx::Class::Schema::Versioned::BEGIN@204 # spent 83µs making 1 call to DBIx::Class::Carp::import
205323µs2430µs
# spent 220µs (11+210) within DBIx::Class::Schema::Versioned::BEGIN@205 which was called: # once (11µs+210µs) by Class::C3::Componentised::ensure_class_loaded at line 205
use Time::HiRes qw/gettimeofday/;
# spent 220µs making 1 call to DBIx::Class::Schema::Versioned::BEGIN@205 # spent 210µs making 1 call to Time::HiRes::import
206321µs295µs
# spent 52µs (10+43) within DBIx::Class::Schema::Versioned::BEGIN@206 which was called: # once (10µs+43µs) by Class::C3::Componentised::ensure_class_loaded at line 206
use Try::Tiny;
# spent 52µs making 1 call to DBIx::Class::Schema::Versioned::BEGIN@206 # spent 43µs making 1 call to Exporter::import
20731.52ms2426µs
# spent 218µs (10+208) within DBIx::Class::Schema::Versioned::BEGIN@207 which was called: # once (10µs+208µs) by Class::C3::Componentised::ensure_class_loaded at line 207
use namespace::clean;
# spent 218µs making 1 call to DBIx::Class::Schema::Versioned::BEGIN@207 # spent 208µs making 1 call to namespace::clean::import
208
20915µs1192µs__PACKAGE__->mk_classdata('_filedata');
# spent 192µs making 1 call to DBIx::Class::mk_classdata
21012µs1137µs__PACKAGE__->mk_classdata('upgrade_directory');
# spent 137µs making 1 call to DBIx::Class::mk_classdata
21112µs1129µs__PACKAGE__->mk_classdata('backup_directory');
# spent 129µs making 1 call to DBIx::Class::mk_classdata
21212µs1128µs__PACKAGE__->mk_classdata('do_backup');
# spent 128µs making 1 call to DBIx::Class::mk_classdata
21312µs1128µs__PACKAGE__->mk_classdata('do_diff_on_init');
# spent 128µs making 1 call to DBIx::Class::mk_classdata
214
215
216=head1 METHODS
217
218=head2 upgrade_directory
219
220Use this to set the directory your upgrade files are stored in.
221
222=head2 backup_directory
223
224Use this to set the directory you want your backups stored in (note that backups
225are disabled by default).
226
227=cut
228
229=head2 install
230
231=over 4
232
233=item Arguments: $db_version
234
235=back
236
237Call this to initialise a previously unversioned database. The table 'dbix_class_schema_versions' will be created which will be used to store the database version.
238
239Takes one argument which should be the version that the database is currently at. Defaults to the return value of L</schema_version>.
240
241See L</getting_started> for more details.
242
243=cut
244
245sub install
246
# spent 502ms (171µs+502) within DBIx::Class::Schema::Versioned::install which was called 2 times, avg 251ms/call: # 2 times (171µs+502ms) by DBIx::Class::Schema::Versioned::deploy at line 273, avg 251ms/call
{
247859µs my ($self, $new_version) = @_;
248
249 # must be called on a fresh database
250246.9ms if ($self->get_db_version()) {
# spent 46.9ms making 2 calls to DBIx::Class::Schema::Versioned::get_db_version, avg 23.4ms/call
251 $self->throw_exception("A versioned schema has already been deployed, try upgrade instead.\n");
252 }
253
254 # default to current version if none passed
255221µs $new_version ||= $self->schema_version();
# spent 21µs making 2 calls to DBIx::Class::Schema::schema_version, avg 11µs/call
256
257493µs if ($new_version) {
258 # create versions table and version row
2592240ms $self->{vschema}->deploy;
# spent 240ms making 2 calls to DBIx::Class::Schema::deploy, avg 120ms/call
2602215ms $self->_set_db_version({ version => $new_version });
# spent 215ms making 2 calls to DBIx::Class::Schema::Versioned::_set_db_version, avg 107ms/call
261 }
262}
263
264=head2 deploy
265
266Same as L<DBIx::Class::Schema/deploy> but also calls C<install>.
267
268=cut
269
270
# spent 8.48s (108µs+8.48) within DBIx::Class::Schema::Versioned::deploy which was called 2 times, avg 4.24s/call: # 2 times (108µs+8.48s) by Tapper::Schema::TestTools::setup_db at line 42 of Tapper/Schema/TestTools.pm, avg 4.24s/call
sub deploy {
271689µs my $self = shift;
272217µs $self->next::method(@_);
# spent 17µs making 2 calls to next::method, avg 8µs/call
2732502ms $self->install();
# spent 502ms making 2 calls to DBIx::Class::Schema::Versioned::install, avg 251ms/call
274}
275
276=head2 create_upgrade_path
277
278=over 4
279
280=item Arguments: { upgrade_file => $file }
281
282=back
283
284Virtual method that should be overridden to create an upgrade file.
285This is useful in the case of upgrading across multiple versions
286to concatenate several files to create one upgrade file.
287
288You'll probably want the db_version retrieved via $self->get_db_version
289and the schema_version which is retrieved via $self->schema_version
290
291=cut
292
293sub create_upgrade_path {
294 ## override this method
295}
296
297=head2 ordered_schema_versions
298
299=over 4
300
301=item Returns: a list of version numbers, ordered from lowest to highest
302
303=back
304
305Virtual method that should be overridden to return an ordered list
306of schema versions. This is then used to produce a set of steps to
307upgrade through to achieve the required schema version.
308
309You may want the db_version retrieved via $self->get_db_version
310and the schema_version which is retrieved via $self->schema_version
311
312=cut
313
314sub ordered_schema_versions {
315 ## override this method
316}
317
318=head2 upgrade
319
320Call this to attempt to upgrade your database from the version it
321is at to the version this DBIC schema is at. If they are the same
322it does nothing.
323
324It will call L</ordered_schema_versions> to retrieve an ordered
325list of schema versions (if ordered_schema_versions returns nothing
326then it is assumed you can do the upgrade as a single step). It
327then iterates through the list of versions between the current db
328version and the schema version applying one update at a time until
329all relevant updates are applied.
330
331The individual update steps are performed by using
332L</upgrade_single_step>, which will apply the update and also
333update the dbix_class_schema_versions table.
334
335=cut
336
337sub upgrade {
338 my ($self) = @_;
339 my $db_version = $self->get_db_version();
340
341 # db unversioned
342 unless ($db_version) {
343 carp 'Upgrade not possible as database is unversioned. Please call install first.';
344 return;
345 }
346
347 # db and schema at same version. do nothing
348 if ( $db_version eq $self->schema_version ) {
349 carp 'Upgrade not necessary';
350 return;
351 }
352
353 my @version_list = $self->ordered_schema_versions;
354
355 # if nothing returned then we preload with min/max
356 @version_list = ( $db_version, $self->schema_version )
357 unless ( scalar(@version_list) );
358
359 # catch the case of someone returning an arrayref
360 @version_list = @{ $version_list[0] }
361 if ( ref( $version_list[0] ) eq 'ARRAY' );
362
363 # remove all versions in list above the required version
364 while ( scalar(@version_list)
365 && ( $version_list[-1] ne $self->schema_version ) )
366 {
367 pop @version_list;
368 }
369
370 # remove all versions in list below the current version
371 while ( scalar(@version_list) && ( $version_list[0] ne $db_version ) ) {
372 shift @version_list;
373 }
374
375 # check we have an appropriate list of versions
376 if ( scalar(@version_list) < 2 ) {
377 die;
378 }
379
380 # do sets of upgrade
381 while ( scalar(@version_list) >= 2 ) {
382 $self->upgrade_single_step( $version_list[0], $version_list[1] );
383 shift @version_list;
384 }
385}
386
387=head2 upgrade_single_step
388
389=over 4
390
391=item Arguments: db_version - the version currently within the db
392
393=item Arguments: target_version - the version to upgrade to
394
395=back
396
397Call this to attempt to upgrade your database from the
398I<db_version> to the I<target_version>. If they are the same it
399does nothing.
400
401It requires an SQL diff file to exist in your I<upgrade_directory>,
402normally you will have created this using L<DBIx::Class::Schema/create_ddl_dir>.
403
404If successful the dbix_class_schema_versions table is updated with
405the I<target_version>.
406
407This method may be called repeatedly by the upgrade method to
408upgrade through a series of updates.
409
410=cut
411
412sub upgrade_single_step
413{
414 my ($self,
415 $db_version,
416 $target_version) = @_;
417
418 # db and schema at same version. do nothing
419 if ($db_version eq $target_version) {
420 carp 'Upgrade not necessary';
421 return;
422 }
423
424 # strangely the first time this is called can
425 # differ to subsequent times. so we call it
426 # here to be sure.
427 # XXX - just fix it
428 $self->storage->sqlt_type;
429
430 my $upgrade_file = $self->ddl_filename(
431 $self->storage->sqlt_type,
432 $target_version,
433 $self->upgrade_directory,
434 $db_version,
435 );
436
437 $self->create_upgrade_path({ upgrade_file => $upgrade_file });
438
439 unless (-f $upgrade_file) {
440 carp "Upgrade not possible, no upgrade file found ($upgrade_file), please create one";
441 return;
442 }
443
444 carp "DB version ($db_version) is lower than the schema version (".$self->schema_version."). Attempting upgrade.\n";
445
446 # backup if necessary then apply upgrade
447 $self->_filedata($self->_read_sql_file($upgrade_file));
448 $self->backup() if($self->do_backup);
449 $self->txn_do(sub { $self->do_upgrade() });
450
451 # set row in dbix_class_schema_versions table
452 $self->_set_db_version({version => $target_version});
453}
454
455=head2 do_upgrade
456
457This is an overwritable method used to run your upgrade. The freeform method
458allows you to run your upgrade any way you please, you can call C<run_upgrade>
459any number of times to run the actual SQL commands, and in between you can
460sandwich your data upgrading. For example, first run all the B<CREATE>
461commands, then migrate your data from old to new tables/formats, then
462issue the DROP commands when you are finished. Will run the whole file as it is by default.
463
464=cut
465
466sub do_upgrade
467{
468 my ($self) = @_;
469
470 # just run all the commands (including inserts) in order
471 $self->run_upgrade(qr/.*?/);
472}
473
474=head2 run_upgrade
475
476 $self->run_upgrade(qr/create/i);
477
478Runs a set of SQL statements matching a passed in regular expression. The
479idea is that this method can be called any number of times from your
480C<do_upgrade> method, running whichever commands you specify via the
481regex in the parameter. Probably won't work unless called from the overridable
482do_upgrade method.
483
484=cut
485
486sub run_upgrade
487{
488 my ($self, $stm) = @_;
489
490 return unless ($self->_filedata);
491 my @statements = grep { $_ =~ $stm } @{$self->_filedata};
492 $self->_filedata([ grep { $_ !~ /$stm/i } @{$self->_filedata} ]);
493
494 for (@statements)
495 {
496 $self->storage->debugobj->query_start($_) if $self->storage->debug;
497 $self->apply_statement($_);
498 $self->storage->debugobj->query_end($_) if $self->storage->debug;
499 }
500
501 return 1;
502}
503
504=head2 apply_statement
505
506Takes an SQL statement and runs it. Override this if you want to handle errors
507differently.
508
509=cut
510
511sub apply_statement {
512 my ($self, $statement) = @_;
513
514 $self->storage->dbh->do($_) or carp "SQL was: $_";
515}
516
517=head2 get_db_version
518
519Returns the version that your database is currently at. This is determined by the values in the
520dbix_class_schema_versions table that C<upgrade> and C<install> write to.
521
522=cut
523
524sub get_db_version
525
# spent 63.6ms (191µs+63.4) within DBIx::Class::Schema::Versioned::get_db_version which was called 5 times, avg 12.7ms/call: # 2 times (81µs+46.8ms) by DBIx::Class::Schema::Versioned::install at line 250, avg 23.4ms/call # 2 times (88µs+13.7ms) by Tapper::Schema::TestTools::setup_db at line 43 of Tapper/Schema/TestTools.pm, avg 6.88ms/call # once (22µs+2.97ms) by DBIx::Class::Schema::Versioned::_on_connect at line 611
{
52620180µs my ($self, $rs) = @_;
527
52853.09ms my $vtable = $self->{vschema}->resultset('Table');
# spent 3.09ms making 5 calls to DBIx::Class::Schema::resultset, avg 618µs/call
529
# spent 59.7ms (168µs+59.6) within DBIx::Class::Schema::Versioned::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/DBIx/Class/Schema/Versioned.pm:533] which was called 5 times, avg 11.9ms/call: # 5 times (168µs+59.6ms) by Try::Tiny::try at line 71 of Try/Tiny.pm, avg 11.9ms/call
my $version = try {
5305114µs1559.6ms $vtable->search({}, { order_by => { -desc => 'installed' }, rows => 1 } )
# spent 28.7ms making 5 calls to DBIx::Class::ResultSetColumn::next, avg 5.74ms/call # spent 28.1ms making 5 calls to DBIx::Class::ResultSet::get_column, avg 5.62ms/call # spent 2.76ms making 5 calls to DBIx::Class::ResultSet::search, avg 552µs/call
531 ->get_column ('version')
532 ->next;
533560.3ms };
# spent 60.3ms making 5 calls to Try::Tiny::try, avg 12.1ms/call
534 return $version || 0;
535}
536
537=head2 schema_version
538
539Returns the current schema class' $VERSION
540
541=cut
542
543=head2 backup
544
545This is an overwritable method which is called just before the upgrade, to
546allow you to make a backup of the database. Per default this method attempts
547to call C<< $self->storage->backup >>, to run the standard backup on each
548database type.
549
550This method should return the name of the backup file, if appropriate..
551
552This method is disabled by default. Set $schema->do_backup(1) to enable it.
553
554=cut
555
556sub backup
557{
558 my ($self) = @_;
559 ## Make each ::DBI::Foo do this
560 $self->storage->backup($self->backup_directory());
561}
562
563=head2 connection
564
565Overloaded method. This checks the DBIC schema version against the DB version and
566warns if they are not the same or if the DB is unversioned. It also provides
567compatibility between the old versions table (SchemaVersions) and the new one
568(dbix_class_schema_versions).
569
570To avoid the checks on connect, set the environment var DBIC_NO_VERSION_CHECK or alternatively you can set the ignore_version attr in the forth argument like so:
571
572 my $schema = MyApp::Schema->connect(
573 $dsn,
574 $user,
575 $password,
576 { ignore_version => 1 },
577 );
578
579=cut
580
581
# spent 32.4ms (55µs+32.3) within DBIx::Class::Schema::Versioned::connection which was called 3 times, avg 10.8ms/call: # 3 times (55µs+32.3ms) by DBIx::Class::Schema::connect at line 529 of DBIx/Class/Schema.pm, avg 10.8ms/call
sub connection {
5821236µs my $self = shift;
583334µs $self->next::method(@_);
# spent 34µs making 3 calls to next::method, avg 11µs/call
58438.27ms $self->_on_connect();
# spent 8.27ms making 3 calls to DBIx::Class::Schema::Versioned::_on_connect, avg 2.76ms/call
585 return $self;
586}
587
588sub _on_connect
589
# spent 8.27ms (280µs+7.99) within DBIx::Class::Schema::Versioned::_on_connect which was called 3 times, avg 2.76ms/call: # 3 times (280µs+7.99ms) by DBIx::Class::Schema::Versioned::connection at line 584, avg 2.76ms/call
{
59021257µs my ($self) = @_;
591
592642µs my $conn_info = $self->storage->connect_info;
# spent 34µs making 3 calls to DBIx::Class::Schema::storage, avg 11µs/call # spent 8µs making 3 calls to DBIx::Class::Storage::DBI::connect_info, avg 3µs/call
59330s $self->{vschema} = DBIx::Class::Version->connect(@$conn_info);
# spent 1.23ms making 3 calls to DBIx::Class::Schema::connect, avg 410µs/call, recursion: max depth 1, sum of overlapping time 1.23ms
594426µs my $conn_attrs = $self->{vschema}->storage->_dbic_connect_attributes || {};
# spent 26µs making 3 calls to DBIx::Class::Schema::storage, avg 9µs/call # spent 800ns making 1 call to DBIx::Class::Storage::DBI::_dbic_connect_attributes
595
5963934µs my $vtable = $self->{vschema}->resultset('Table');
# spent 934µs making 3 calls to DBIx::Class::Schema::resultset, avg 311µs/call
597
598 # useful when connecting from scripts etc
599 return if ($conn_attrs->{ignore_version} || ($ENV{DBIC_NO_VERSION_CHECK} && !exists $conn_attrs->{ignore_version}));
600
601 # check for legacy versions table and move to new if exists
60212.76ms unless ($self->_source_exists($vtable)) {
# spent 2.76ms making 1 call to DBIx::Class::Schema::Versioned::_source_exists
603 my $vtable_compat = DBIx::Class::VersionCompat->connect(@$conn_info)->resultset('TableCompat');
604 if ($self->_source_exists($vtable_compat)) {
605 $self->{vschema}->deploy;
606 map { $vtable->create({ installed => $_->Installed, version => $_->Version }) } $vtable_compat->all;
607 $self->storage->_get_dbh->do("DROP TABLE " . $vtable_compat->result_source->from);
608 }
609 }
610
61112.99ms my $pversion = $self->get_db_version();
# spent 2.99ms making 1 call to DBIx::Class::Schema::Versioned::get_db_version
612
613111µs if($pversion eq $self->schema_version)
# spent 11µs making 1 call to DBIx::Class::Schema::schema_version
614 {
615 #carp "This version is already installed";
616 return 1;
617 }
618
619 if(!$pversion)
620 {
621 carp "Your DB is currently unversioned. Please call upgrade on your schema to sync the DB.";
622 return 1;
623 }
624
625 carp "Versions out of sync. This is " . $self->schema_version .
626 ", your database contains version $pversion, please call upgrade on your Schema.";
627}
628
629# is this just a waste of time? if not then merge with DBI.pm
630sub _create_db_to_schema_diff {
631 my $self = shift;
632
633 my %driver_to_db_map = (
634 'mysql' => 'MySQL'
635 );
636
637 my $db = $driver_to_db_map{$self->storage->dbh->{Driver}->{Name}};
638 unless ($db) {
639 print "Sorry, this is an unsupported DB\n";
640 return;
641 }
642
643 unless (DBIx::Class::Optional::Dependencies->req_ok_for ('deploy')) {
644 $self->throw_exception("Unable to proceed without " . DBIx::Class::Optional::Dependencies->req_missing_for ('deploy') );
645 }
646
647 my $db_tr = SQL::Translator->new({
648 add_drop_table => 1,
649 parser => 'DBI',
650 parser_args => { dbh => $self->storage->dbh }
651 });
652
653 $db_tr->producer($db);
654 my $dbic_tr = SQL::Translator->new;
655 $dbic_tr->parser('SQL::Translator::Parser::DBIx::Class');
656 $dbic_tr->data($self);
657 $dbic_tr->producer($db);
658
659 $db_tr->schema->name('db_schema');
660 $dbic_tr->schema->name('dbic_schema');
661
662 # is this really necessary?
663 foreach my $tr ($db_tr, $dbic_tr) {
664 my $data = $tr->data;
665 $tr->parser->($tr, $$data);
666 }
667
668 my $diff = SQL::Translator::Diff::schema_diff($db_tr->schema, $db,
669 $dbic_tr->schema, $db,
670 { ignore_constraint_names => 1, ignore_index_names => 1, caseopt => 1 });
671
672 my $filename = $self->ddl_filename(
673 $db,
674 $self->schema_version,
675 $self->upgrade_directory,
676 'PRE',
677 );
678 my $file;
679 if(!open($file, ">$filename"))
680 {
681 $self->throw_exception("Can't open $filename for writing ($!)");
682 next;
683 }
684 print $file $diff;
685 close($file);
686
687 carp "WARNING: There may be differences between your DB and your DBIC schema. Please review and if necessary run the SQL in $filename to sync your DB.";
688}
689
690
691
# spent 215ms (249µs+215) within DBIx::Class::Schema::Versioned::_set_db_version which was called 2 times, avg 107ms/call: # 2 times (249µs+215ms) by DBIx::Class::Schema::Versioned::install at line 260, avg 107ms/call
sub _set_db_version {
69216254µs my $self = shift;
693 my ($params) = @_;
694 $params ||= {};
695
696 my $version = $params->{version} ? $params->{version} : $self->schema_version;
69721.22ms my $vtable = $self->{vschema}->resultset('Table');
# spent 1.22ms making 2 calls to DBIx::Class::Schema::resultset, avg 612µs/call
698
699 ##############################################################################
700 # !!! NOTE !!!
701 ##############################################################################
702 #
703 # The travesty below replaces the old nice timestamp format of %Y-%m-%d %H:%M:%S
704 # This is necessary since there are legitimate cases when upgrades can happen
705 # back to back within the same second. This breaks things since we relay on the
706 # ability to sort by the 'installed' value. The logical choice of an autoinc
707 # is not possible, as it will break multiple legacy installations. Also it is
708 # not possible to format the string sanely, as the column is a varchar(20).
709 # The 'v' character is added to the front of the string, so that any version
710 # formatted by this new function will sort _after_ any existing 200... strings.
711215µs my @tm = gettimeofday();
# spent 15µs making 2 calls to Time::HiRes::gettimeofday, avg 7µs/call
712 my @dt = gmtime ($tm[0]);
7132213ms my $o = $vtable->create({
# spent 213ms making 2 calls to DBIx::Class::ResultSet::create, avg 107ms/call
714 version => $version,
715 installed => sprintf("v%04d%02d%02d_%02d%02d%02d.%03.0f",
716 $dt[5] + 1900,
717 $dt[4] + 1,
718 $dt[3],
719 $dt[2],
720 $dt[1],
721 $dt[0],
722 int($tm[1] / 1000), # convert to millisecs
723 ),
724 });
725}
726
727sub _read_sql_file {
728 my $self = shift;
729 my $file = shift || return;
730
731 open my $fh, '<', $file or carp("Can't open upgrade file, $file ($!)");
732 my @data = split /\n/, join '', <$fh>;
733 close $fh;
734
735 @data = split /;/,
736 join '',
737 grep { $_ &&
738 !/^--/ &&
739 !/^(BEGIN|BEGIN TRANSACTION|COMMIT)/mi }
740 @data;
741
742 return \@data;
743}
744
745sub _source_exists
746
# spent 2.76ms (15µs+2.75) within DBIx::Class::Schema::Versioned::_source_exists which was called: # once (15µs+2.75ms) by DBIx::Class::Schema::Versioned::_on_connect at line 602
{
747212µs my ($self, $rs) = @_;
748
749
# spent 2.73ms (45µs+2.68) within DBIx::Class::Schema::Versioned::__ANON__[/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/DBIx/Class/Schema/Versioned.pm:752] which was called: # once (45µs+2.68ms) by Try::Tiny::try at line 71 of Try/Tiny.pm
return try {
750230µs32.68ms $rs->search(\'1=0')->cursor->next;
# spent 2.24ms making 1 call to DBIx::Class::Storage::DBI::Cursor::next # spent 329µs making 1 call to DBIx::Class::ResultSet::cursor # spent 108µs making 1 call to DBIx::Class::ResultSet::search
75119µs13µs 1;
# spent 3µs making 1 call to DBIx::Class::Storage::DBI::Cursor::DESTROY
752 } catch {
753 0;
75422.75ms };
# spent 2.75ms making 1 call to Try::Tiny::try # spent 2µs making 1 call to Try::Tiny::catch
755}
756
757116µs1;
758
759
760=head1 AUTHORS
761
762Jess Robinson <castaway@desert-island.me.uk>
763Luke Saunders <luke@shadowcatsystems.co.uk>
764
765=head1 LICENSE
766
767118µs1476µsYou may distribute this code under the same terms as Perl itself.