← 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:24:06 2012

Filename/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Translator/Producer/SQLite.pm
StatementsExecuted 6342 statements in 11.0ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
240117.52ms28.7msSQL::Translator::Producer::SQLite::::create_fieldSQL::Translator::Producer::SQLite::create_field
35112.75ms37.1msSQL::Translator::Producer::SQLite::::create_tableSQL::Translator::Producer::SQLite::create_table
3111651µs1.24msSQL::Translator::Producer::SQLite::::create_indexSQL::Translator::Producer::SQLite::create_index
411498µs39.2msSQL::Translator::Producer::SQLite::::produceSQL::Translator::Producer::SQLite::produce
50131362µs362µsSQL::Translator::Producer::SQLite::::CORE:matchSQL::Translator::Producer::SQLite::CORE:match (opcode)
3421119µs119µsSQL::Translator::Producer::SQLite::::mk_nameSQL::Translator::Producer::SQLite::mk_name
2911104µs104µsSQL::Translator::Producer::SQLite::::create_foreignkeySQL::Translator::Producer::SQLite::create_foreignkey
31183µs199µsSQL::Translator::Producer::SQLite::::create_constraintSQL::Translator::Producer::SQLite::create_constraint
21149µs77µsSQL::Translator::Producer::SQLite::::create_viewSQL::Translator::Producer::SQLite::create_view
653127µs27µsSQL::Translator::Producer::SQLite::::CORE:substSQL::Translator::Producer::SQLite::CORE:subst (opcode)
11117µs21µsSQL::Translator::Producer::SQLite::::BEGIN@38SQL::Translator::Producer::SQLite::BEGIN@38
11114µs69µsSQL::Translator::Producer::SQLite::::BEGIN@41SQL::Translator::Producer::SQLite::BEGIN@41
11111µs38µsSQL::Translator::Producer::SQLite::::BEGIN@40SQL::Translator::Producer::SQLite::BEGIN@40
11110µs54µsSQL::Translator::Producer::SQLite::::BEGIN@44SQL::Translator::Producer::SQLite::BEGIN@44
1118µs40µsSQL::Translator::Producer::SQLite::::BEGIN@42SQL::Translator::Producer::SQLite::BEGIN@42
1118µs22µsSQL::Translator::Producer::SQLite::::BEGIN@39SQL::Translator::Producer::SQLite::BEGIN@39
0000s0sSQL::Translator::Producer::SQLite::::add_fieldSQL::Translator::Producer::SQLite::add_field
0000s0sSQL::Translator::Producer::SQLite::::alter_create_constraintSQL::Translator::Producer::SQLite::alter_create_constraint
0000s0sSQL::Translator::Producer::SQLite::::alter_create_indexSQL::Translator::Producer::SQLite::alter_create_index
0000s0sSQL::Translator::Producer::SQLite::::alter_drop_constraintSQL::Translator::Producer::SQLite::alter_drop_constraint
0000s0sSQL::Translator::Producer::SQLite::::alter_drop_indexSQL::Translator::Producer::SQLite::alter_drop_index
0000s0sSQL::Translator::Producer::SQLite::::alter_tableSQL::Translator::Producer::SQLite::alter_table
0000s0sSQL::Translator::Producer::SQLite::::batch_alter_tableSQL::Translator::Producer::SQLite::batch_alter_table
0000s0sSQL::Translator::Producer::SQLite::::create_triggerSQL::Translator::Producer::SQLite::create_trigger
0000s0sSQL::Translator::Producer::SQLite::::drop_tableSQL::Translator::Producer::SQLite::drop_table
0000s0sSQL::Translator::Producer::SQLite::::preproces_schemaSQL::Translator::Producer::SQLite::preproces_schema
0000s0sSQL::Translator::Producer::SQLite::::rename_tableSQL::Translator::Producer::SQLite::rename_table
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package SQL::Translator::Producer::SQLite;
2
3# -------------------------------------------------------------------
4# Copyright (C) 2002-2009 SQLFairy Authors
5#
6# This program is free software; you can redistribute it and/or
7# modify it under the terms of the GNU General Public License as
8# published by the Free Software Foundation; version 2.
9#
10# This program is distributed in the hope that it will be useful, but
11# WITHOUT ANY WARRANTY; without even the implied warranty of
12# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13# General Public License for more details.
14#
15# You should have received a copy of the GNU General Public License
16# along with this program; if not, write to the Free Software
17# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
18# 02111-1307 USA
19# -------------------------------------------------------------------
20
21=head1 NAME
22
23SQL::Translator::Producer::SQLite - SQLite producer for SQL::Translator
24
25=head1 SYNOPSIS
26
27 use SQL::Translator;
28
29 my $t = SQL::Translator->new( parser => '...', producer => 'SQLite' );
30 $t->translate;
31
32=head1 DESCRIPTION
33
34This module will produce text output of the schema suitable for SQLite.
35
36=cut
37
38324µs225µs
# spent 21µs (17+4) within SQL::Translator::Producer::SQLite::BEGIN@38 which was called: # once (17µs+4µs) by SQL::Translator::load at line 38
use strict;
# spent 21µs making 1 call to SQL::Translator::Producer::SQLite::BEGIN@38 # spent 4µs making 1 call to strict::import
39319µs235µs
# spent 22µs (8+14) within SQL::Translator::Producer::SQLite::BEGIN@39 which was called: # once (8µs+14µs) by SQL::Translator::load at line 39
use warnings;
# spent 22µs making 1 call to SQL::Translator::Producer::SQLite::BEGIN@39 # spent 14µs making 1 call to warnings::import
40328µs264µs
# spent 38µs (11+26) within SQL::Translator::Producer::SQLite::BEGIN@40 which was called: # once (11µs+26µs) by SQL::Translator::load at line 40
use Data::Dumper;
# spent 38µs making 1 call to SQL::Translator::Producer::SQLite::BEGIN@40 # spent 26µs making 1 call to Exporter::import
41327µs2124µs
# spent 69µs (14+55) within SQL::Translator::Producer::SQLite::BEGIN@41 which was called: # once (14µs+55µs) by SQL::Translator::load at line 41
use SQL::Translator::Schema::Constants;
# spent 69µs making 1 call to SQL::Translator::Producer::SQLite::BEGIN@41 # spent 55µs making 1 call to Exporter::import
42321µs272µs
# spent 40µs (8+32) within SQL::Translator::Producer::SQLite::BEGIN@42 which was called: # once (8µs+32µs) by SQL::Translator::load at line 42
use SQL::Translator::Utils qw(debug header_comment parse_dbms_version);
# spent 40µs making 1 call to SQL::Translator::Producer::SQLite::BEGIN@42 # spent 32µs making 1 call to Exporter::import
43
4431.91ms299µs
# spent 54µs (10+45) within SQL::Translator::Producer::SQLite::BEGIN@44 which was called: # once (10µs+45µs) by SQL::Translator::load at line 44
use vars qw[ $VERSION $DEBUG $WARN ];
# spent 54µs making 1 call to SQL::Translator::Producer::SQLite::BEGIN@44 # spent 45µs making 1 call to vars::import
45
461800ns$VERSION = '1.59';
471600ns$DEBUG = 0 unless defined $DEBUG;
481300ns$WARN = 0 unless defined $WARN;
49
501100nsour $max_id_length = 30;
511400nsmy %global_names;
52
53
# spent 39.2ms (498µs+38.7) within SQL::Translator::Producer::SQLite::produce which was called 4 times, avg 9.81ms/call: # 4 times (498µs+38.7ms) by SQL::Translator::translate at line 538 of SQL/Translator.pm, avg 9.81ms/call
sub produce {
5442µs my $translator = shift;
55412µs415µs local $DEBUG = $translator->debug;
# spent 15µs making 4 calls to Class::Base::debug, avg 4µs/call
56412µs413µs local $WARN = $translator->show_warnings;
# spent 13µs making 4 calls to SQL::Translator::show_warnings, avg 3µs/call
57412µs413µs my $no_comments = $translator->no_comments;
# spent 13µs making 4 calls to SQL::Translator::no_comments, avg 3µs/call
58411µs49µs my $add_drop_table = $translator->add_drop_table;
# spent 9µs making 4 calls to SQL::Translator::add_drop_table, avg 2µs/call
5948µs410µs my $schema = $translator->schema;
# spent 10µs making 4 calls to SQL::Translator::schema, avg 2µs/call
60410µs4114µs my $producer_args = $translator->producer_args;
# spent 114µs making 4 calls to SQL::Translator::producer_args, avg 29µs/call
61420µs4171µs my $sqlite_version = parse_dbms_version(
# spent 171µs making 4 calls to SQL::Translator::Utils::parse_dbms_version, avg 43µs/call
62 $producer_args->{sqlite_version}, 'perl'
63 );
6443µs my $no_txn = $producer_args->{no_transaction};
65
66410µs470µs debug("PKG: Beginning production\n");
# spent 70µs making 4 calls to SQL::Translator::Utils::debug, avg 17µs/call
67
68420µs %global_names = (); #reset
69
70
7141µs my $head = (header_comment() . "\n") unless $no_comments;
72
7343µs my @create = ();
74
7543µs push @create, "BEGIN TRANSACTION" unless $no_txn;
76
77420µs4962µs for my $table ( $schema->get_tables ) {
# spent 962µs making 4 calls to SQL::Translator::Schema::get_tables, avg 240µs/call
7835147µs3537.1ms push @create, create_table($table, { no_comments => $no_comments,
# spent 37.1ms making 35 calls to SQL::Translator::Producer::SQLite::create_table, avg 1.06ms/call
79 sqlite_version => $sqlite_version,
80 add_drop_table => $add_drop_table,});
81 }
82
83415µs497µs for my $view ( $schema->get_views ) {
# spent 97µs making 4 calls to SQL::Translator::Schema::get_views, avg 24µs/call
8427µs277µs push @create, create_view($view, {
# spent 77µs making 2 calls to SQL::Translator::Producer::SQLite::create_view, avg 38µs/call
85 add_drop_view => $add_drop_table,
86 no_comments => $no_comments,
87 });
88 }
89
90414µs456µs for my $trigger ( $schema->get_triggers ) {
# spent 56µs making 4 calls to SQL::Translator::Schema::get_triggers, avg 14µs/call
91 push @create, create_trigger($trigger, {
92 add_drop_trigger => $add_drop_table,
93 no_comments => $no_comments,
94 });
95 }
96
9743µs push @create, "COMMIT" unless $no_txn;
98
99480µs if (wantarray) {
100 return ($head||(), @create);
101 } else {
102 return join ('',
103 $head||(),
104 join(";\n\n", @create ),
105 ";\n",
106 );
107 }
108}
109
110# -------------------------------------------------------------------
111
# spent 119µs within SQL::Translator::Producer::SQLite::mk_name which was called 34 times, avg 4µs/call: # 31 times (107µs+0s) by SQL::Translator::Producer::SQLite::create_index at line 340, avg 3µs/call # 3 times (12µs+0s) by SQL::Translator::Producer::SQLite::create_constraint at line 360, avg 4µs/call
sub mk_name {
1123418µs my ($name, $scope, $critical) = @_;
113
1143413µs $scope ||= \%global_names;
1153417µs if ( my $prev = $scope->{ $name } ) {
116 my $name_orig = $name;
117 $name .= sprintf( "%02d", ++$prev );
118 substr($name, $max_id_length - 3) = "00"
119 if length( $name ) > $max_id_length;
120
121 warn "The name '$name_orig' has been changed to ",
122 "'$name' to make it unique.\n" if $WARN;
123
124 $scope->{ $name_orig }++;
125 }
126
1273432µs $scope->{ $name }++;
1283477µs return $name;
129}
130
131
# spent 77µs (49+28) within SQL::Translator::Producer::SQLite::create_view which was called 2 times, avg 38µs/call: # 2 times (49µs+28µs) by SQL::Translator::Producer::SQLite::produce at line 84, avg 38µs/call
sub create_view {
13221µs my ($view, $options) = @_;
13321µs my $add_drop_view = $options->{add_drop_view};
134
13523µs25µs my $view_name = $view->name;
# spent 5µs making 2 calls to SQL::Translator::Schema::View::name, avg 2µs/call
13623µs210µs debug("PKG: Looking at view '${view_name}'\n");
# spent 10µs making 2 calls to SQL::Translator::Utils::debug, avg 5µs/call
137
138 # Header. Should this look like what mysqldump produces?
139212µs28µs my $extra = $view->extra;
# spent 8µs making 2 calls to SQL::Translator::Schema::Object::extra, avg 4µs/call
1402400ns my @create;
1412700ns push @create, "DROP VIEW IF EXISTS $view_name" if $add_drop_view;
142
1432900ns my $create_view = 'CREATE';
1442600ns $create_view .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary};
1452800ns $create_view .= ' VIEW';
1462700ns $create_view .= " IF NOT EXISTS" if exists($extra->{if_not_exists}) && $extra->{if_not_exists};
14722µs $create_view .= " ${view_name}";
148
14925µs25µs if( my $sql = $view->sql ){
# spent 5µs making 2 calls to SQL::Translator::Schema::View::sql, avg 3µs/call
150 $create_view .= " AS\n ${sql}";
151 }
15221µs push @create, $create_view;
153
154 # Tack the comment onto the first statement.
1552800ns unless ($options->{no_comments}) {
156 $create[0] = "--\n-- View: ${view_name}\n--\n" . $create[0];
157 }
158
15927µs return @create;
160}
161
162
163sub create_table
164
# spent 37.1ms (2.75+34.4) within SQL::Translator::Producer::SQLite::create_table which was called 35 times, avg 1.06ms/call: # 35 times (2.75ms+34.4ms) by SQL::Translator::Producer::SQLite::produce at line 78, avg 1.06ms/call
{
1653518µs my ($table, $options) = @_;
166
1673550µs3573µs my $table_name = $table->name;
# spent 73µs making 35 calls to SQL::Translator::Schema::Table::name, avg 2µs/call
1683513µs my $no_comments = $options->{no_comments};
1693510µs my $add_drop_table = $options->{add_drop_table};
1703514µs my $sqlite_version = $options->{sqlite_version} || 0;
171
1723551µs35188µs debug("PKG: Looking at table '$table_name'\n");
# spent 188µs making 35 calls to SQL::Translator::Utils::debug, avg 5µs/call
173
1743512µs my ( @index_defs, @constraint_defs );
1753587µs351.63ms my @fields = $table->get_fields or die "No fields in $table_name";
# spent 1.63ms making 35 calls to SQL::Translator::Schema::Table::get_fields, avg 47µs/call
176
1773518µs my $temp = $options->{temporary_table} ? 'TEMPORARY ' : '';
178 #
179 # Header.
180 #
1813545µs my $exists = ($sqlite_version >= 3.003) ? ' IF EXISTS' : '';
182357µs my @create;
1833515µs my ($comment, $create_table) = "";
184357µs $comment = "--\n-- Table: $table_name\n--\n" unless $no_comments;
1853513µs if ($add_drop_table) {
186 push @create, $comment . qq[DROP TABLE$exists $table_name];
187 } else {
1883511µs $create_table = $comment;
189 }
190
1913528µs $create_table .= "CREATE ${temp}TABLE $table_name (\n";
192
193 #
194 # Comments
195 #
1963560µs35127µs if ( $table->comments and !$no_comments ){
# spent 127µs making 35 calls to SQL::Translator::Schema::Table::comments, avg 4µs/call
197 $create_table .= "-- Comments: \n-- ";
198 $create_table .= join "\n-- ", $table->comments;
199 $create_table .= "\n--\n\n";
200 }
201
202 #
203 # How many fields in PK?
204 #
2053550µs35621µs my $pk = $table->primary_key;
# spent 621µs making 35 calls to SQL::Translator::Schema::Table::primary_key, avg 18µs/call
2063555µs35935µs my @pk_fields = $pk ? $pk->fields : ();
# spent 935µs making 35 calls to SQL::Translator::Schema::Constraint::fields, avg 27µs/call
207
208 #
209 # Fields
210 #
211359µs my ( @field_defs, $pk_set );
2123520µs for my $field ( @fields ) {
213240381µs24028.7ms push @field_defs, create_field($field);
# spent 28.7ms making 240 calls to SQL::Translator::Producer::SQLite::create_field, avg 120µs/call
214 }
215
21635406µs238115µs if (
# spent 65µs making 226 calls to SQL::Translator::Producer::SQLite::CORE:match, avg 287ns/call # spent 50µs making 12 calls to SQL::Translator::Schema::Field::__ANON__[SQL/Translator/Schema/Field.pm:57], avg 4µs/call
217 scalar @pk_fields > 1
218 ||
219 ( @pk_fields && !grep /INTEGER PRIMARY KEY/, @field_defs )
220 ) {
221 push @field_defs, 'PRIMARY KEY (' . join(', ', @pk_fields ) . ')';
222 }
223
224 #
225 # Indices
226 #
2273511µs my $idx_name_default = 'A';
2283562µs35172µs for my $index ( $table->get_indices ) {
# spent 172µs making 35 calls to SQL::Translator::Schema::Table::get_indices, avg 5µs/call
2293154µs311.24ms push @index_defs, create_index($index);
# spent 1.24ms making 31 calls to SQL::Translator::Producer::SQLite::create_index, avg 40µs/call
230 }
231
232 #
233 # Constraints
234 #
235359µs my $c_name_default = 'A';
2363576µs3558µs for my $c ( $table->get_constraints ) {
# spent 58µs making 35 calls to SQL::Translator::Schema::Table::get_constraints, avg 2µs/call
23767112µs96208µs if ($c->type eq "FOREIGN KEY") {
# spent 104µs making 29 calls to SQL::Translator::Producer::SQLite::create_foreignkey, avg 4µs/call # spent 103µs making 67 calls to SQL::Translator::Schema::Constraint::type, avg 2µs/call
238 push @field_defs, create_foreignkey($c);
239 }
2406781µs6788µs next unless $c->type eq UNIQUE;
# spent 88µs making 67 calls to SQL::Translator::Schema::Constraint::type, avg 1µs/call
24138µs3199µs push @constraint_defs, create_constraint($c);
# spent 199µs making 3 calls to SQL::Translator::Producer::SQLite::create_constraint, avg 66µs/call
242 }
243
24435243µs $create_table .= join(",\n", map { " $_" } @field_defs ) . "\n)";
245
24635157µs return (@create, $create_table, @index_defs, @constraint_defs );
247}
248
249
# spent 104µs within SQL::Translator::Producer::SQLite::create_foreignkey which was called 29 times, avg 4µs/call: # 29 times (104µs+0s) by SQL::Translator::Producer::SQLite::create_table at line 237, avg 4µs/call
sub create_foreignkey {
250297µs my $c = shift;
251
2522931µs my $fk_sql = "FOREIGN KEY($c->{fields}[0]) REFERENCES ";
2532935µs $fk_sql .= ( $c->{reference_table} || '' )."(".( $c->{reference_fields}[0] || '' ).")";
254
2552956µs return $fk_sql;
256}
257
258sub create_field
259
# spent 28.7ms (7.52+21.2) within SQL::Translator::Producer::SQLite::create_field which was called 240 times, avg 120µs/call: # 240 times (7.52ms+21.2ms) by SQL::Translator::Producer::SQLite::create_table at line 213, avg 120µs/call
{
26024079µs my ($field, $options) = @_;
261
262240235µs240408µs my $field_name = $field->name;
# spent 408µs making 240 calls to SQL::Translator::Schema::Field::name, avg 2µs/call
263240271µs2401.10ms debug("PKG: Looking at field '$field_name'\n");
# spent 1.10ms making 240 calls to SQL::Translator::Utils::debug, avg 5µs/call
264240308µs240589µs my $field_comments = $field->comments
# spent 589µs making 240 calls to SQL::Translator::Schema::Field::comments, avg 2µs/call
265 ? "-- " . $field->comments . "\n "
266 : '';
267
26824088µs my $field_def = $field_comments.$field_name;
269
270 # data type and size
271240264µs2401.95ms my $size = $field->size;
# spent 1.95ms making 240 calls to SQL::Translator::Schema::Field::size, avg 8µs/call
272240255µs240381µs my $data_type = $field->data_type;
# spent 381µs making 240 calls to SQL::Translator::Schema::Field::data_type, avg 2µs/call
27324080µs $data_type = 'varchar' if lc $data_type eq 'set';
27424056µs $data_type = 'blob' if lc $data_type eq 'bytea';
275
276240600µs240230µs if ( lc $data_type =~ /(text|blob)/i ) {
# spent 230µs making 240 calls to SQL::Translator::Producer::SQLite::CORE:match, avg 957ns/call
277 $size = undef;
278 }
279
280# if ( $data_type =~ /timestamp/i ) {
281# push @trigger_defs,
282# "CREATE TRIGGER ts_${table_name} ".
283# "after insert on $table_name\n".
284# "begin\n".
285# " update $table_name set $field_name=timestamp() ".
286# "where id=new.id;\n".
287# "end;\n"
288# ;
289#
290# }
291
292 #
293 # SQLite is generally typeless, but newer versions will
294 # make a field autoincrement if it is declared as (and
295 # *only* as) INTEGER PRIMARY KEY
296 #
297240495µs4803.84ms my $pk = $field->table->primary_key;
# spent 3.48ms making 240 calls to SQL::Translator::Schema::Table::primary_key, avg 15µs/call # spent 361µs making 240 calls to SQL::Translator::Schema::Field::table, avg 2µs/call
298240317µs2405.44ms my @pk_fields = $pk ? $pk->fields : ();
# spent 5.44ms making 240 calls to SQL::Translator::Schema::Constraint::fields, avg 23µs/call
299
300240408µs2753.93ms if (
# spent 3.86ms making 240 calls to SQL::Translator::Schema::Field::is_primary_key, avg 16µs/call # spent 67µs making 35 calls to SQL::Translator::Producer::SQLite::CORE:match, avg 2µs/call
301 $field->is_primary_key &&
302 scalar @pk_fields == 1 &&
303 (
304 $data_type =~ /int(eger)?$/i
305 ||
306 ( $data_type =~ /^number?$/i && $size !~ /,/ )
307 )
308 ) {
3092713µs $data_type = 'INTEGER PRIMARY KEY';
310279µs $size = undef;
311# $pk_set = 1;
312 }
313
314240502µs240447µs $field_def .= sprintf " %s%s", $data_type,
# spent 447µs making 240 calls to SQL::Translator::Schema::Field::is_auto_increment, avg 2µs/call
315 ( !$field->is_auto_increment && $size ) ? "($size)" : '';
316
317 # Null?
318240260µs240980µs $field_def .= ' NOT NULL' unless $field->is_nullable;
# spent 980µs making 240 calls to SQL::Translator::Schema::Field::is_nullable, avg 4µs/call
319
320 # Default?
321240646µs2401.91ms SQL::Translator::Producer->_apply_default_value(
# spent 1.91ms making 240 calls to SQL::Translator::Producer::_apply_default_value, avg 8µs/call
322 $field,
323 \$field_def,
324 [
325 'NULL' => \'NULL',
326 'now()' => 'now()',
327 'CURRENT_TIMESTAMP' => 'CURRENT_TIMESTAMP',
328 ],
329 );
330
331240582µs return $field_def;
332
333}
334
335sub create_index
336
# spent 1.24ms (651µs+587µs) within SQL::Translator::Producer::SQLite::create_index which was called 31 times, avg 40µs/call: # 31 times (651µs+587µs) by SQL::Translator::Producer::SQLite::create_table at line 229, avg 40µs/call
{
3373111µs my ($index, $options) = @_;
338
3393141µs3160µs my $name = $index->name;
# spent 60µs making 31 calls to SQL::Translator::Schema::Index::name, avg 2µs/call
3403135µs31107µs $name = mk_name($name);
# spent 107µs making 31 calls to SQL::Translator::Producer::SQLite::mk_name, avg 3µs/call
341
3423146µs3155µs my $type = $index->type eq 'UNIQUE' ? "UNIQUE " : '';
# spent 55µs making 31 calls to SQL::Translator::Schema::Index::type, avg 2µs/call
343
344 # strip any field size qualifiers as SQLite doesn't like these
34593143µs62265µs my @fields = map { s/\(\d+\)$//; $_ } $index->fields;
# spent 251µs making 31 calls to SQL::Translator::Schema::Index::fields, avg 8µs/call # spent 14µs making 31 calls to SQL::Translator::Producer::SQLite::CORE:subst, avg 448ns/call
34631115µs93100µs (my $index_table_name = $index->table->name) =~ s/^.+?\.//; # table name may not specify schema
# spent 45µs making 31 calls to SQL::Translator::Schema::Index::table, avg 1µs/call # spent 44µs making 31 calls to SQL::Translator::Schema::Table::name, avg 1µs/call # spent 10µs making 31 calls to SQL::Translator::Producer::SQLite::CORE:subst, avg 339ns/call
347316µs warn "removing schema name from '" . $index->table->name . "' to make '$index_table_name'\n" if $WARN;
3483148µs my $index_def =
349 "CREATE ${type}INDEX $name ON " . $index_table_name .
350 ' (' . join( ', ', @fields ) . ')';
351
3523173µs return $index_def;
353}
354
355sub create_constraint
356
# spent 199µs (83+117) within SQL::Translator::Producer::SQLite::create_constraint which was called 3 times, avg 66µs/call: # 3 times (83µs+117µs) by SQL::Translator::Producer::SQLite::create_table at line 241, avg 66µs/call
{
35732µs my ($c, $options) = @_;
358
35938µs310µs my $name = $c->name;
# spent 10µs making 3 calls to SQL::Translator::Schema::Constraint::name, avg 3µs/call
36035µs312µs $name = mk_name($name);
# spent 12µs making 3 calls to SQL::Translator::Producer::SQLite::mk_name, avg 4µs/call
36135µs370µs my @fields = $c->fields;
# spent 70µs making 3 calls to SQL::Translator::Schema::Constraint::fields, avg 23µs/call
362318µs911µs (my $index_table_name = $c->table->name) =~ s/^.+?\.//; # table name may not specify schema
# spent 4µs making 3 calls to SQL::Translator::Schema::Table::name, avg 1µs/call # spent 4µs making 3 calls to SQL::Translator::Schema::Constraint::table, avg 1µs/call # spent 3µs making 3 calls to SQL::Translator::Producer::SQLite::CORE:subst, avg 867ns/call
36331µs warn "removing schema name from '" . $c->table->name . "' to make '$index_table_name'\n" if $WARN;
364
365313µs314µs my $c_def =
366 "CREATE UNIQUE INDEX $name ON " . $index_table_name .
367 ' (' . join( ', ', @fields ) . ')';
368
369312µs return $c_def;
370}
371
372sub create_trigger {
373 my ($trigger, $options) = @_;
374 my $add_drop = $options->{add_drop_trigger};
375
376 my @statements;
377
378 my $trigger_name = $trigger->name;
379 my $events = $trigger->database_events;
380 for my $evt ( @$events ) {
381
382 my $trig_name = $trigger_name;
383 if (@$events > 1) {
384 $trig_name .= "_$evt";
385
386 warn "Multiple database events supplied for trigger '$trigger_name', ",
387 "creating trigger '$trig_name' for the '$evt' event.\n" if $WARN;
388 }
389
390 push @statements, "DROP TRIGGER IF EXISTS $trig_name" if $add_drop;
391
392
393 $DB::single = 1;
394 my $action = "";
395 if (not ref $trigger->action) {
396 $action .= "BEGIN " . $trigger->action . " END";
397 }
398 else {
399 $action = $trigger->action->{for_each} . " "
400 if $trigger->action->{for_each};
401
402 $action = $trigger->action->{when} . " "
403 if $trigger->action->{when};
404
405 my $steps = $trigger->action->{steps} || [];
406
407 $action .= "BEGIN ";
408 $action .= $_ . "; " for (@$steps);
409 $action .= "END";
410 }
411
412 push @statements, sprintf (
413 'CREATE TRIGGER %s %s %s on %s %s',
414 $trig_name,
415 $trigger->perform_action_when,
416 $evt,
417 $trigger->on_table,
418 $action
419 );
420 }
421
422 return @statements;
423}
424
425sub alter_table { } # Noop
426
427sub add_field {
428 my ($field) = @_;
429
430 return sprintf("ALTER TABLE %s ADD COLUMN %s",
431 $field->table->name, create_field($field))
432}
433
434sub alter_create_index {
435 my ($index) = @_;
436
437 # This might cause name collisions
438 return create_index($index);
439}
440
441sub alter_create_constraint {
442 my ($constraint) = @_;
443
444 return create_constraint($constraint) if $constraint->type eq 'UNIQUE';
445}
446
447sub alter_drop_constraint { alter_drop_index(@_) }
448
449sub alter_drop_index {
450 my ($constraint) = @_;
451
452 return sprintf("DROP INDEX %s",
453 $constraint->name);
454}
455
456sub batch_alter_table {
457 my ($table, $diffs) = @_;
458
459 # If we have any of the following
460 #
461 # rename_field
462 # alter_field
463 # drop_field
464 #
465 # we need to do the following <http://www.sqlite.org/faq.html#q11>
466 #
467 # BEGIN TRANSACTION;
468 # CREATE TEMPORARY TABLE t1_backup(a,b);
469 # INSERT INTO t1_backup SELECT a,b FROM t1;
470 # DROP TABLE t1;
471 # CREATE TABLE t1(a,b);
472 # INSERT INTO t1 SELECT a,b FROM t1_backup;
473 # DROP TABLE t1_backup;
474 # COMMIT;
475 #
476 # Fun, eh?
477 #
478 # If we have rename_field we do similarly.
479
480 my $table_name = $table->name;
481 my $renaming = $diffs->{rename_table} && @{$diffs->{rename_table}};
482
483 if ( @{$diffs->{rename_field}} == 0 &&
484 @{$diffs->{alter_field}} == 0 &&
485 @{$diffs->{drop_field}} == 0
486 ) {
487# return join("\n", map {
488 return map {
489 my $meth = __PACKAGE__->can($_) or die __PACKAGE__ . " cant $_";
490 map { my $sql = $meth->(ref $_ eq 'ARRAY' ? @$_ : $_); $sql ? ("$sql") : () } @{ $diffs->{$_} }
491
492 } grep { @{$diffs->{$_}} }
493 qw/rename_table
494 alter_drop_constraint
495 alter_drop_index
496 drop_field
497 add_field
498 alter_field
499 rename_field
500 alter_create_index
501 alter_create_constraint
502 alter_table/;
503 }
504
505
506 my @sql;
507 my $old_table = $renaming ? $diffs->{rename_table}[0][0] : $table;
508
509 do {
510 local $table->{name} = $table_name . '_temp_alter';
511 # We only want the table - dont care about indexes on tmp table
512 my ($table_sql) = create_table($table, {no_comments => 1, temporary_table => 1});
513 push @sql,$table_sql;
514 };
515
516 push @sql, "INSERT INTO @{[$table_name]}_temp_alter SELECT @{[ join(', ', $old_table->get_fields)]} FROM @{[$old_table]}",
517 "DROP TABLE @{[$old_table]}",
518 create_table($table, { no_comments => 1 }),
519 "INSERT INTO @{[$table_name]} SELECT @{[ join(', ', $old_table->get_fields)]} FROM @{[$table_name]}_temp_alter",
520 "DROP TABLE @{[$table_name]}_temp_alter";
521
522 return @sql;
523# return join("", @sql, "");
524}
525
526sub drop_table {
527 my ($table) = @_;
528 return "DROP TABLE $table";
529}
530
531sub rename_table {
532 my ($old_table, $new_table, $options) = @_;
533
534 my $qt = $options->{quote_table_names} || '';
535
536 return "ALTER TABLE $qt$old_table$qt RENAME TO $qt$new_table$qt";
537
538}
539
540# No-op. Just here to signify that we are a new style parser.
541sub preproces_schema { }
542
54316µs1;
544
545=pod
546
547=head1 SEE ALSO
548
549SQL::Translator, http://www.sqlite.org/.
550
551=head1 AUTHOR
552
553Ken Youens-Clark C<< <kclark@cpan.orgE> >>.
554
555Diff code added by Ash Berlin C<< <ash@cpan.org> >>.
556
557=cut
 
# spent 362µs within SQL::Translator::Producer::SQLite::CORE:match which was called 501 times, avg 722ns/call: # 240 times (230µs+0s) by SQL::Translator::Producer::SQLite::create_field at line 276, avg 957ns/call # 226 times (65µs+0s) by SQL::Translator::Producer::SQLite::create_table at line 216, avg 287ns/call # 35 times (67µs+0s) by SQL::Translator::Producer::SQLite::create_field at line 300, avg 2µs/call
sub SQL::Translator::Producer::SQLite::CORE:match; # opcode
# spent 27µs within SQL::Translator::Producer::SQLite::CORE:subst which was called 65 times, avg 415ns/call: # 31 times (14µs+0s) by SQL::Translator::Producer::SQLite::create_index at line 345, avg 448ns/call # 31 times (10µs+0s) by SQL::Translator::Producer::SQLite::create_index at line 346, avg 339ns/call # 3 times (3µs+0s) by SQL::Translator::Producer::SQLite::create_constraint at line 362, avg 867ns/call
sub SQL::Translator::Producer::SQLite::CORE:subst; # opcode