Profile of DBIx/Class/Schema/Versioned.pm

← 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
Statements | Executed 161 statements in 3.32ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
3 | 1 | 1 | 280µs | 8.27ms | DBIx::Class::Schema::Versioned::::_on_connect DBIx::Class::Schema::Versioned::_on_connect
2 | 1 | 1 | 249µs | 215ms | DBIx::Class::Schema::Versioned::::_set_db_version DBIx::Class::Schema::Versioned::_set_db_version
5 | 3 | 2 | 191µs | 63.6ms | DBIx::Class::Schema::Versioned::::get_db_version DBIx::Class::Schema::Versioned::get_db_version
2 | 1 | 1 | 171µs | 502ms | DBIx::Class::Schema::Versioned::::install DBIx::Class::Schema::Versioned::install
5 | 1 | 1 | 168µs | 59.7ms | DBIx::Class::Schema::Versioned::::__ANON__[:533] DBIx::Class::Schema::Versioned::__ANON__[:533]
2 | 1 | 1 | 108µs | 8.48s | DBIx::Class::Schema::Versioned::::deploy DBIx::Class::Schema::Versioned::deploy
3 | 1 | 1 | 55µs | 32.4ms | DBIx::Class::Schema::Versioned::::connection DBIx::Class::Schema::Versioned::connection
1 | 1 | 1 | 45µs | 2.73ms | DBIx::Class::Schema::Versioned::::__ANON__[:752] DBIx::Class::Schema::Versioned::__ANON__[:752]
1 | 1 | 1 | 16µs | 167µs | DBIx::Class::Version::Table::::BEGIN@3 DBIx::Class::Version::Table::BEGIN@3
1 | 1 | 1 | 15µs | 2.76ms | DBIx::Class::Schema::Versioned::::_source_exists DBIx::Class::Schema::Versioned::_source_exists
1 | 1 | 1 | 11µs | 220µs | DBIx::Class::Schema::Versioned::::BEGIN@205 DBIx::Class::Schema::Versioned::BEGIN@205
1 | 1 | 1 | 10µs | 218µs | DBIx::Class::Schema::Versioned::::BEGIN@207 DBIx::Class::Schema::Versioned::BEGIN@207
1 | 1 | 1 | 10µs | 52µs | DBIx::Class::Schema::Versioned::::BEGIN@206 DBIx::Class::Schema::Versioned::BEGIN@206
1 | 1 | 1 | 9µs | 13µs | DBIx::Class::Version::Table::::BEGIN@4 DBIx::Class::Version::Table::BEGIN@4
1 | 1 | 1 | 8µs | 25µs | DBIx::Class::Version::Table::::BEGIN@5 DBIx::Class::Version::Table::BEGIN@5
1 | 1 | 1 | 8µs | 91µs | DBIx::Class::Schema::Versioned::::BEGIN@204 DBIx::Class::Schema::Versioned::BEGIN@204
1 | 1 | 1 | 8µs | 65µs | DBIx::Class::Version::TableCompat::::BEGIN@33DBIx::Class::Version::TableCompat::BEGIN@33
1 | 1 | 1 | 7µs | 9µs | DBIx::Class::Schema::Versioned::::BEGIN@200 DBIx::Class::Schema::Versioned::BEGIN@200
1 | 1 | 1 | 7µs | 16µs | DBIx::Class::VersionCompat::::BEGIN@58 DBIx::Class::VersionCompat::BEGIN@58
1 | 1 | 1 | 7µs | 59µs | DBIx::Class::Schema::Versioned::::BEGIN@202 DBIx::Class::Schema::Versioned::BEGIN@202
1 | 1 | 1 | 7µs | 17µs | DBIx::Class::Version::::BEGIN@50 DBIx::Class::Version::BEGIN@50
1 | 1 | 1 | 7µs | 15µs | DBIx::Class::Schema::Versioned::::BEGIN@201 DBIx::Class::Schema::Versioned::BEGIN@201
1 | 1 | 1 | 6µs | 8µs | DBIx::Class::Version::::BEGIN@49 DBIx::Class::Version::BEGIN@49
1 | 1 | 1 | 6µs | 53µs | DBIx::Class::VersionCompat::::BEGIN@56 DBIx::Class::VersionCompat::BEGIN@56
1 | 1 | 1 | 6µs | 8µs | DBIx::Class::VersionCompat::::BEGIN@57 DBIx::Class::VersionCompat::BEGIN@57
1 | 1 | 1 | 6µs | 57µs | DBIx::Class::Version::::BEGIN@48 DBIx::Class::Version::BEGIN@48
0 | 0 | 0 | 0s | 0s | DBIx::Class::Schema::Versioned::::__ANON__[:449] DBIx::Class::Schema::Versioned::__ANON__[:449]
0 | 0 | 0 | 0s | 0s | DBIx::Class::Schema::Versioned::::__ANON__[:754] DBIx::Class::Schema::Versioned::__ANON__[:754]
0 | 0 | 0 | 0s | 0s | DBIx::Class::Schema::Versioned::::_create_db_to_schema_diff DBIx::Class::Schema::Versioned::_create_db_to_schema_diff
0 | 0 | 0 | 0s | 0s | DBIx::Class::Schema::Versioned::::_read_sql_file DBIx::Class::Schema::Versioned::_read_sql_file
0 | 0 | 0 | 0s | 0s | DBIx::Class::Schema::Versioned::::apply_statement DBIx::Class::Schema::Versioned::apply_statement
0 | 0 | 0 | 0s | 0s | DBIx::Class::Schema::Versioned::::backup DBIx::Class::Schema::Versioned::backup
0 | 0 | 0 | 0s | 0s | DBIx::Class::Schema::Versioned::::create_upgrade_path DBIx::Class::Schema::Versioned::create_upgrade_path
0 | 0 | 0 | 0s | 0s | DBIx::Class::Schema::Versioned::::do_upgrade DBIx::Class::Schema::Versioned::do_upgrade
0 | 0 | 0 | 0s | 0s | DBIx::Class::Schema::Versioned::::ordered_schema_versions DBIx::Class::Schema::Versioned::ordered_schema_versions
0 | 0 | 0 | 0s | 0s | DBIx::Class::Schema::Versioned::::run_upgrade DBIx::Class::Schema::Versioned::run_upgrade
0 | 0 | 0 | 0s | 0s | DBIx::Class::Schema::Versioned::::upgrade DBIx::Class::Schema::Versioned::upgrade
0 | 0 | 0 | 0s | 0s | DBIx::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
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package # Hide from PAUSE
2 |  |  |  |  | DBIx::Class::Version::Table;
3 | 3 | 23µs | 2 | 318µ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
4 | 3 | 18µs | 2 | 18µ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
5 | 3 | 78µs | 2 | 41µ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 |  |  |  |  |
7 | 1 | 40µs | 1 | 488µs | __PACKAGE__->table('dbix_class_schema_versions'); # spent 488µs making 1 call to DBIx::Class::ResultSourceProxy::Table::table
8 |  |  |  |  |
9 | 1 | 27µs | 1 | 463µ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 |  |  |  |  | );
29 | 1 | 18µs | 1 | 65µs | __PACKAGE__->set_primary_key('version'); # spent 65µs making 1 call to DBIx::Class::ResultSourceProxy::set_primary_key
30 |  |  |  |  |
31 |  |  |  |  | package # Hide from PAUSE
32 |  |  |  |  | DBIx::Class::Version::TableCompat;
33 | 3 | 48µs | 2 | 122µ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
34 | 1 | 18µs | 1 | 329µs | __PACKAGE__->table('SchemaVersions'); # spent 329µs making 1 call to DBIx::Class::ResultSourceProxy::Table::table
35 |  |  |  |  |
36 | 1 | 17µs | 1 | 350µ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 |  |  |  |  | );
44 | 1 | 16µs | 1 | 41µs | __PACKAGE__->set_primary_key('Version'); # spent 41µs making 1 call to DBIx::Class::ResultSourceProxy::set_primary_key
45 |  |  |  |  |
46 |  |  |  |  | package # Hide from PAUSE
47 |  |  |  |  | DBIx::Class::Version;
48 | 3 | 18µs | 2 | 108µ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
49 | 3 | 16µs | 2 | 10µ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
50 | 3 | 35µs | 2 | 27µ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 |  |  |  |  |
52 | 1 | 6µs | 1 | 314µs | __PACKAGE__->register_class('Table', 'DBIx::Class::Version::Table'); # spent 314µs making 1 call to DBIx::Class::Schema::register_class
53 |  |  |  |  |
54 |  |  |  |  | package # Hide from PAUSE
55 |  |  |  |  | DBIx::Class::VersionCompat;
56 | 3 | 18µs | 2 | 100µ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
57 | 3 | 19µs | 2 | 10µ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
58 | 3 | 80µs | 2 | 24µ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 |  |  |  |  |
60 | 1 | 4µs | 1 | 190µ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 |  |  |  |  |
67 |  |  |  |  | DBIx::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 |  |  |  |  |
85 |  |  |  |  | This module provides methods to apply DDL changes to your database using SQL
86 |  |  |  |  | diff files. Normally these diff files would be created using
87 |  |  |  |  | L<DBIx::Class::Schema/create_ddl_dir>.
88 |  |  |  |  |
89 |  |  |  |  | A table called I<dbix_class_schema_versions> is created and maintained by the
90 |  |  |  |  | module. This is used to determine which version your database is currently at.
91 |  |  |  |  | Similarly the $VERSION in your DBIC schema class is used to determine the
92 |  |  |  |  | current DBIC schema version.
93 |  |  |  |  |
94 |  |  |  |  | The upgrade is initiated manually by calling C<upgrade> on your schema object,
95 |  |  |  |  | this will attempt to upgrade the database from its current version to the current
96 |  |  |  |  | schema version using a diff from your I<upgrade_directory>. If a suitable diff is
97 |  |  |  |  | not found then no upgrade is possible.
98 |  |  |  |  |
99 |  |  |  |  | =head1 SEE ALSO
100 |  |  |  |  |
101 |  |  |  |  | L<DBIx::Class::DeploymentHandler> is a much more powerful alternative to this
102 |  |  |  |  | module. Examples of things it can do that this module cannot do include
103 |  |  |  |  |
104 |  |  |  |  | =over
105 |  |  |  |  |
106 |  |  |  |  | =item *
107 |  |  |  |  |
108 |  |  |  |  | Downgrades in addition to upgrades
109 |  |  |  |  |
110 |  |  |  |  | =item *
111 |  |  |  |  |
112 |  |  |  |  | Multiple sql files files per upgrade/downgrade/install
113 |  |  |  |  |
114 |  |  |  |  | =item *
115 |  |  |  |  |
116 |  |  |  |  | Perl scripts allowed for upgrade/downgrade/install
117 |  |  |  |  |
118 |  |  |  |  | =item *
119 |  |  |  |  |
120 |  |  |  |  | Just one set of files needed for upgrade, unlike this module where one might
121 |  |  |  |  | need to generate C<factorial(scalar @versions)>
122 |  |  |  |  |
123 |  |  |  |  | =back
124 |  |  |  |  |
125 |  |  |  |  | =head1 GETTING STARTED
126 |  |  |  |  |
127 |  |  |  |  | Firstly you need to setup your schema class as per the L</SYNOPSIS>, make sure
128 |  |  |  |  | you have specified an upgrade_directory and an initial $VERSION.
129 |  |  |  |  |
130 |  |  |  |  | Then you'll need two scripts, one to create DDL files and diffs and another to perform
131 |  |  |  |  | upgrades. 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 |  |  |  |  |
152 |  |  |  |  | Then 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 |  |  |  |  |
170 |  |  |  |  | The script above assumes that if the database is unversioned then it is empty
171 |  |  |  |  | and we can safely deploy the DDL to it. However things are not always so simple.
172 |  |  |  |  |
173 |  |  |  |  | if you want to initialise a pre-existing database where the DDL is not the same
174 |  |  |  |  | as the DDL for your current schema version then you will need a diff which
175 |  |  |  |  | converts the database's DDL to the current DDL. The best way to do this is
176 |  |  |  |  | to get a dump of the database schema (without data) and save that in your
177 |  |  |  |  | SQL directory as version 0.000 (the filename must be as with
178 |  |  |  |  | L<DBIx::Class::Schema/ddl_filename>) then create a diff using your create DDL
179 |  |  |  |  | script given above from version 0.000 to the current version. Then hand check
180 |  |  |  |  | and if necessary edit the resulting diff to ensure that it will apply. Once you have
181 |  |  |  |  | done 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 |  |  |  |  |
191 |  |  |  |  | In the case of an unversioned database the above code will create the
192 |  |  |  |  | dbix_class_schema_versions table and write version 0.000 to it, then
193 |  |  |  |  | upgrade will then apply the diff we talked about creating in the previous paragraph
194 |  |  |  |  | and then you're good to go.
195 |  |  |  |  |
196 |  |  |  |  | =cut
197 |  |  |  |  |
198 |  |  |  |  | package DBIx::Class::Schema::Versioned;
199 |  |  |  |  |
200 | 3 | 17µs | 2 | 11µ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
201 | 3 | 17µs | 2 | 23µ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
202 | 3 | 18µs | 2 | 111µ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 |  |  |  |  |
204 | 3 | 27µs | 2 | 174µ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
205 | 3 | 23µs | 2 | 430µ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
206 | 3 | 21µs | 2 | 95µ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
207 | 3 | 1.52ms | 2 | 426µ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 |  |  |  |  |
209 | 1 | 5µs | 1 | 192µs | __PACKAGE__->mk_classdata('_filedata'); # spent 192µs making 1 call to DBIx::Class::mk_classdata
210 | 1 | 2µs | 1 | 137µs | __PACKAGE__->mk_classdata('upgrade_directory'); # spent 137µs making 1 call to DBIx::Class::mk_classdata
211 | 1 | 2µs | 1 | 129µs | __PACKAGE__->mk_classdata('backup_directory'); # spent 129µs making 1 call to DBIx::Class::mk_classdata
212 | 1 | 2µs | 1 | 128µs | __PACKAGE__->mk_classdata('do_backup'); # spent 128µs making 1 call to DBIx::Class::mk_classdata
213 | 1 | 2µs | 1 | 128µ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 |  |  |  |  |
220 |  |  |  |  | Use this to set the directory your upgrade files are stored in.
221 |  |  |  |  |
222 |  |  |  |  | =head2 backup_directory
223 |  |  |  |  |
224 |  |  |  |  | Use this to set the directory you want your backups stored in (note that backups
225 |  |  |  |  | are disabled by default).
226 |  |  |  |  |
227 |  |  |  |  | =cut
228 |  |  |  |  |
229 |  |  |  |  | =head2 install
230 |  |  |  |  |
231 |  |  |  |  | =over 4
232 |  |  |  |  |
233 |  |  |  |  | =item Arguments: $db_version
234 |  |  |  |  |
235 |  |  |  |  | =back
236 |  |  |  |  |
237 |  |  |  |  | Call 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 |  |  |  |  |
239 |  |  |  |  | Takes one argument which should be the version that the database is currently at. Defaults to the return value of L</schema_version>.
240 |  |  |  |  |
241 |  |  |  |  | See L</getting_started> for more details.
242 |  |  |  |  |
243 |  |  |  |  | =cut
244 |  |  |  |  |
245 |  |  |  |  | sub 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 {
247 | 8 | 59µs |  |  | my ($self, $new_version) = @_;
248 |  |  |  |  |
249 |  |  |  |  | # must be called on a fresh database
250 |  |  | 2 | 46.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
255 |  |  | 2 | 21µs | $new_version ||= $self->schema_version(); # spent 21µs making 2 calls to DBIx::Class::Schema::schema_version, avg 11µs/call
256 |  |  |  |  |
257 | 4 | 93µs |  |  | if ($new_version) {
258 |  |  |  |  | # create versions table and version row
259 |  |  | 2 | 240ms | $self->{vschema}->deploy; # spent 240ms making 2 calls to DBIx::Class::Schema::deploy, avg 120ms/call
260 |  |  | 2 | 215ms | $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 |  |  |  |  |
266 |  |  |  |  | Same 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 {
271 | 6 | 89µs |  |  | my $self = shift;
272 |  |  | 2 | 17µs | $self->next::method(@_); # spent 17µs making 2 calls to next::method, avg 8µs/call
273 |  |  | 2 | 502ms | $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 |  |  |  |  |
284 |  |  |  |  | Virtual method that should be overridden to create an upgrade file.
285 |  |  |  |  | This is useful in the case of upgrading across multiple versions
286 |  |  |  |  | to concatenate several files to create one upgrade file.
287 |  |  |  |  |
288 |  |  |  |  | You'll probably want the db_version retrieved via $self->get_db_version
289 |  |  |  |  | and the schema_version which is retrieved via $self->schema_version
290 |  |  |  |  |
291 |  |  |  |  | =cut
292 |  |  |  |  |
293 |  |  |  |  | sub 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 |  |  |  |  |
305 |  |  |  |  | Virtual method that should be overridden to return an ordered list
306 |  |  |  |  | of schema versions. This is then used to produce a set of steps to
307 |  |  |  |  | upgrade through to achieve the required schema version.
308 |  |  |  |  |
309 |  |  |  |  | You may want the db_version retrieved via $self->get_db_version
310 |  |  |  |  | and the schema_version which is retrieved via $self->schema_version
311 |  |  |  |  |
312 |  |  |  |  | =cut
313 |  |  |  |  |
314 |  |  |  |  | sub ordered_schema_versions {
315 |  |  |  |  | ## override this method
316 |  |  |  |  | }
317 |  |  |  |  |
318 |  |  |  |  | =head2 upgrade
319 |  |  |  |  |
320 |  |  |  |  | Call this to attempt to upgrade your database from the version it
321 |  |  |  |  | is at to the version this DBIC schema is at. If they are the same
322 |  |  |  |  | it does nothing.
323 |  |  |  |  |
324 |  |  |  |  | It will call L</ordered_schema_versions> to retrieve an ordered
325 |  |  |  |  | list of schema versions (if ordered_schema_versions returns nothing
326 |  |  |  |  | then it is assumed you can do the upgrade as a single step). It
327 |  |  |  |  | then iterates through the list of versions between the current db
328 |  |  |  |  | version and the schema version applying one update at a time until
329 |  |  |  |  | all relevant updates are applied.
330 |  |  |  |  |
331 |  |  |  |  | The individual update steps are performed by using
332 |  |  |  |  | L</upgrade_single_step>, which will apply the update and also
333 |  |  |  |  | update the dbix_class_schema_versions table.
334 |  |  |  |  |
335 |  |  |  |  | =cut
336 |  |  |  |  |
337 |  |  |  |  | sub 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 |  |  |  |  |
397 |  |  |  |  | Call this to attempt to upgrade your database from the
398 |  |  |  |  | I<db_version> to the I<target_version>. If they are the same it
399 |  |  |  |  | does nothing.
400 |  |  |  |  |
401 |  |  |  |  | It requires an SQL diff file to exist in your I<upgrade_directory>,
402 |  |  |  |  | normally you will have created this using L<DBIx::Class::Schema/create_ddl_dir>.
403 |  |  |  |  |
404 |  |  |  |  | If successful the dbix_class_schema_versions table is updated with
405 |  |  |  |  | the I<target_version>.
406 |  |  |  |  |
407 |  |  |  |  | This method may be called repeatedly by the upgrade method to
408 |  |  |  |  | upgrade through a series of updates.
409 |  |  |  |  |
410 |  |  |  |  | =cut
411 |  |  |  |  |
412 |  |  |  |  | sub 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 |  |  |  |  |
457 |  |  |  |  | This is an overwritable method used to run your upgrade. The freeform method
458 |  |  |  |  | allows you to run your upgrade any way you please, you can call C<run_upgrade>
459 |  |  |  |  | any number of times to run the actual SQL commands, and in between you can
460 |  |  |  |  | sandwich your data upgrading. For example, first run all the B<CREATE>
461 |  |  |  |  | commands, then migrate your data from old to new tables/formats, then
462 |  |  |  |  | issue the DROP commands when you are finished. Will run the whole file as it is by default.
463 |  |  |  |  |
464 |  |  |  |  | =cut
465 |  |  |  |  |
466 |  |  |  |  | sub 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 |  |  |  |  |
478 |  |  |  |  | Runs a set of SQL statements matching a passed in regular expression. The
479 |  |  |  |  | idea is that this method can be called any number of times from your
480 |  |  |  |  | C<do_upgrade> method, running whichever commands you specify via the
481 |  |  |  |  | regex in the parameter. Probably won't work unless called from the overridable
482 |  |  |  |  | do_upgrade method.
483 |  |  |  |  |
484 |  |  |  |  | =cut
485 |  |  |  |  |
486 |  |  |  |  | sub 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 |  |  |  |  |
506 |  |  |  |  | Takes an SQL statement and runs it. Override this if you want to handle errors
507 |  |  |  |  | differently.
508 |  |  |  |  |
509 |  |  |  |  | =cut
510 |  |  |  |  |
511 |  |  |  |  | sub apply_statement {
512 |  |  |  |  | my ($self, $statement) = @_;
513 |  |  |  |  |
514 |  |  |  |  | $self->storage->dbh->do($_) or carp "SQL was: $_";
515 |  |  |  |  | }
516 |  |  |  |  |
517 |  |  |  |  | =head2 get_db_version
518 |  |  |  |  |
519 |  |  |  |  | Returns the version that your database is currently at. This is determined by the values in the
520 |  |  |  |  | dbix_class_schema_versions table that C<upgrade> and C<install> write to.
521 |  |  |  |  |
522 |  |  |  |  | =cut
523 |  |  |  |  |
524 |  |  |  |  | sub 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 {
526 | 20 | 180µs |  |  | my ($self, $rs) = @_;
527 |  |  |  |  |
528 |  |  | 5 | 3.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 {
530 | 5 | 114µs | 15 | 59.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;
533 |  |  | 5 | 60.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 |  |  |  |  |
539 |  |  |  |  | Returns the current schema class' $VERSION
540 |  |  |  |  |
541 |  |  |  |  | =cut
542 |  |  |  |  |
543 |  |  |  |  | =head2 backup
544 |  |  |  |  |
545 |  |  |  |  | This is an overwritable method which is called just before the upgrade, to
546 |  |  |  |  | allow you to make a backup of the database. Per default this method attempts
547 |  |  |  |  | to call C<< $self->storage->backup >>, to run the standard backup on each
548 |  |  |  |  | database type.
549 |  |  |  |  |
550 |  |  |  |  | This method should return the name of the backup file, if appropriate..
551 |  |  |  |  |
552 |  |  |  |  | This method is disabled by default. Set $schema->do_backup(1) to enable it.
553 |  |  |  |  |
554 |  |  |  |  | =cut
555 |  |  |  |  |
556 |  |  |  |  | sub 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 |  |  |  |  |
565 |  |  |  |  | Overloaded method. This checks the DBIC schema version against the DB version and
566 |  |  |  |  | warns if they are not the same or if the DB is unversioned. It also provides
567 |  |  |  |  | compatibility between the old versions table (SchemaVersions) and the new one
568 |  |  |  |  | (dbix_class_schema_versions).
569 |  |  |  |  |
570 |  |  |  |  | To 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 {
582 | 12 | 36µs |  |  | my $self = shift;
583 |  |  | 3 | 34µs | $self->next::method(@_); # spent 34µs making 3 calls to next::method, avg 11µs/call
584 |  |  | 3 | 8.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 |  |  |  |  |
588 |  |  |  |  | sub _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 {
590 | 21 | 257µs |  |  | my ($self) = @_;
591 |  |  |  |  |
592 |  |  | 6 | 42µ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
593 |  |  | 3 | 0s | $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
594 |  |  | 4 | 26µ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 |  |  |  |  |
596 |  |  | 3 | 934µ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
602 |  |  | 1 | 2.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 |  |  |  |  |
611 |  |  | 1 | 2.99ms | my $pversion = $self->get_db_version(); # spent 2.99ms making 1 call to DBIx::Class::Schema::Versioned::get_db_version
612 |  |  |  |  |
613 |  |  | 1 | 11µ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
630 |  |  |  |  | sub _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 {
692 | 16 | 254µs |  |  | my $self = shift;
693 |  |  |  |  | my ($params) = @_;
694 |  |  |  |  | $params ||= {};
695 |  |  |  |  |
696 |  |  |  |  | my $version = $params->{version} ? $params->{version} : $self->schema_version;
697 |  |  | 2 | 1.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.
711 |  |  | 2 | 15µs | my @tm = gettimeofday(); # spent 15µs making 2 calls to Time::HiRes::gettimeofday, avg 7µs/call
712 |  |  |  |  | my @dt = gmtime ($tm[0]);
713 |  |  | 2 | 213ms | 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 |  |  |  |  |
727 |  |  |  |  | sub _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 |  |  |  |  |
745 |  |  |  |  | sub _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 {
747 | 2 | 12µ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 {
750 | 2 | 30µs | 3 | 2.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
751 | 1 | 9µs | 1 | 3µs | 1; # spent 3µs making 1 call to DBIx::Class::Storage::DBI::Cursor::DESTROY
752 |  |  |  |  | } catch {
753 |  |  |  |  | 0;
754 |  |  | 2 | 2.75ms | }; # spent 2.75ms making 1 call to Try::Tiny::try # spent 2µs making 1 call to Try::Tiny::catch
755 |  |  |  |  | }
756 |  |  |  |  |
757 | 1 | 16µs |  |  | 1;
758 |  |  |  |  |
759 |  |  |  |  |
760 |  |  |  |  | =head1 AUTHORS
761 |  |  |  |  |
762 |  |  |  |  | Jess Robinson <castaway@desert-island.me.uk>
763 |  |  |  |  | Luke Saunders <luke@shadowcatsystems.co.uk>
764 |  |  |  |  |
765 |  |  |  |  | =head1 LICENSE
766 |  |  |  |  |
767 | 1 | 18µs | 1 | 476µs | You may distribute this code under the same terms as Perl itself. # spent 476µs making 1 call to B::Hooks::EndOfScope::__ANON__[B/Hooks/EndOfScope.pm:26]