| Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Translator/Producer/SQLite.pm |
| Statements | Executed 6342 statements in 11.0ms |
| Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
|---|---|---|---|---|---|
| 240 | 1 | 1 | 7.52ms | 28.7ms | SQL::Translator::Producer::SQLite::create_field |
| 35 | 1 | 1 | 2.75ms | 37.1ms | SQL::Translator::Producer::SQLite::create_table |
| 31 | 1 | 1 | 651µs | 1.24ms | SQL::Translator::Producer::SQLite::create_index |
| 4 | 1 | 1 | 498µs | 39.2ms | SQL::Translator::Producer::SQLite::produce |
| 501 | 3 | 1 | 362µs | 362µs | SQL::Translator::Producer::SQLite::CORE:match (opcode) |
| 34 | 2 | 1 | 119µs | 119µs | SQL::Translator::Producer::SQLite::mk_name |
| 29 | 1 | 1 | 104µs | 104µs | SQL::Translator::Producer::SQLite::create_foreignkey |
| 3 | 1 | 1 | 83µs | 199µs | SQL::Translator::Producer::SQLite::create_constraint |
| 2 | 1 | 1 | 49µs | 77µs | SQL::Translator::Producer::SQLite::create_view |
| 65 | 3 | 1 | 27µs | 27µs | SQL::Translator::Producer::SQLite::CORE:subst (opcode) |
| 1 | 1 | 1 | 17µs | 21µs | SQL::Translator::Producer::SQLite::BEGIN@38 |
| 1 | 1 | 1 | 14µs | 69µs | SQL::Translator::Producer::SQLite::BEGIN@41 |
| 1 | 1 | 1 | 11µs | 38µs | SQL::Translator::Producer::SQLite::BEGIN@40 |
| 1 | 1 | 1 | 10µs | 54µs | SQL::Translator::Producer::SQLite::BEGIN@44 |
| 1 | 1 | 1 | 8µs | 40µs | SQL::Translator::Producer::SQLite::BEGIN@42 |
| 1 | 1 | 1 | 8µs | 22µs | SQL::Translator::Producer::SQLite::BEGIN@39 |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Producer::SQLite::add_field |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Producer::SQLite::alter_create_constraint |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Producer::SQLite::alter_create_index |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Producer::SQLite::alter_drop_constraint |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Producer::SQLite::alter_drop_index |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Producer::SQLite::alter_table |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Producer::SQLite::batch_alter_table |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Producer::SQLite::create_trigger |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Producer::SQLite::drop_table |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Producer::SQLite::preproces_schema |
| 0 | 0 | 0 | 0s | 0s | SQL::Translator::Producer::SQLite::rename_table |
| Line | State ments |
Time on line |
Calls | Time in subs |
Code |
|---|---|---|---|---|---|
| 1 | package 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 | |||||
| 23 | SQL::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 | |||||
| 34 | This module will produce text output of the schema suitable for SQLite. | ||||
| 35 | |||||
| 36 | =cut | ||||
| 37 | |||||
| 38 | 3 | 24µs | 2 | 25µ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 # spent 21µs making 1 call to SQL::Translator::Producer::SQLite::BEGIN@38
# spent 4µs making 1 call to strict::import |
| 39 | 3 | 19µs | 2 | 35µ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 # spent 22µs making 1 call to SQL::Translator::Producer::SQLite::BEGIN@39
# spent 14µs making 1 call to warnings::import |
| 40 | 3 | 28µs | 2 | 64µ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 # spent 38µs making 1 call to SQL::Translator::Producer::SQLite::BEGIN@40
# spent 26µs making 1 call to Exporter::import |
| 41 | 3 | 27µs | 2 | 124µ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 # spent 69µs making 1 call to SQL::Translator::Producer::SQLite::BEGIN@41
# spent 55µs making 1 call to Exporter::import |
| 42 | 3 | 21µs | 2 | 72µ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 # spent 40µs making 1 call to SQL::Translator::Producer::SQLite::BEGIN@42
# spent 32µs making 1 call to Exporter::import |
| 43 | |||||
| 44 | 3 | 1.91ms | 2 | 99µ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 # spent 54µs making 1 call to SQL::Translator::Producer::SQLite::BEGIN@44
# spent 45µs making 1 call to vars::import |
| 45 | |||||
| 46 | 1 | 800ns | $VERSION = '1.59'; | ||
| 47 | 1 | 600ns | $DEBUG = 0 unless defined $DEBUG; | ||
| 48 | 1 | 300ns | $WARN = 0 unless defined $WARN; | ||
| 49 | |||||
| 50 | 1 | 100ns | our $max_id_length = 30; | ||
| 51 | 1 | 400ns | my %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 | ||||
| 54 | 113 | 413µs | my $translator = shift; | ||
| 55 | 4 | 15µs | local $DEBUG = $translator->debug; # spent 15µs making 4 calls to Class::Base::debug, avg 4µs/call | ||
| 56 | 4 | 13µs | local $WARN = $translator->show_warnings; # spent 13µs making 4 calls to SQL::Translator::show_warnings, avg 3µs/call | ||
| 57 | 4 | 13µs | my $no_comments = $translator->no_comments; # spent 13µs making 4 calls to SQL::Translator::no_comments, avg 3µs/call | ||
| 58 | 4 | 9µ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 | ||
| 59 | 4 | 10µs | my $schema = $translator->schema; # spent 10µs making 4 calls to SQL::Translator::schema, avg 2µs/call | ||
| 60 | 4 | 114µs | my $producer_args = $translator->producer_args; # spent 114µs making 4 calls to SQL::Translator::producer_args, avg 29µs/call | ||
| 61 | 4 | 171µ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 | ); | ||||
| 64 | my $no_txn = $producer_args->{no_transaction}; | ||||
| 65 | |||||
| 66 | 4 | 70µs | debug("PKG: Beginning production\n"); # spent 70µs making 4 calls to SQL::Translator::Utils::debug, avg 17µs/call | ||
| 67 | |||||
| 68 | %global_names = (); #reset | ||||
| 69 | |||||
| 70 | |||||
| 71 | my $head = (header_comment() . "\n") unless $no_comments; | ||||
| 72 | |||||
| 73 | my @create = (); | ||||
| 74 | |||||
| 75 | push @create, "BEGIN TRANSACTION" unless $no_txn; | ||||
| 76 | |||||
| 77 | 4 | 962µs | for my $table ( $schema->get_tables ) { # spent 962µs making 4 calls to SQL::Translator::Schema::get_tables, avg 240µs/call | ||
| 78 | 35 | 37.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 | |||||
| 83 | 4 | 97µs | for my $view ( $schema->get_views ) { # spent 97µs making 4 calls to SQL::Translator::Schema::get_views, avg 24µs/call | ||
| 84 | 2 | 77µ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 | |||||
| 90 | 4 | 56µ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 | |||||
| 97 | push @create, "COMMIT" unless $no_txn; | ||||
| 98 | |||||
| 99 | 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 | ||||
| 112 | 170 | 157µs | my ($name, $scope, $critical) = @_; | ||
| 113 | |||||
| 114 | $scope ||= \%global_names; | ||||
| 115 | 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 | |||||
| 127 | $scope->{ $name }++; | ||||
| 128 | 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 | ||||
| 132 | 32 | 41µs | my ($view, $options) = @_; | ||
| 133 | my $add_drop_view = $options->{add_drop_view}; | ||||
| 134 | |||||
| 135 | 2 | 5µs | my $view_name = $view->name; # spent 5µs making 2 calls to SQL::Translator::Schema::View::name, avg 2µs/call | ||
| 136 | 2 | 10µ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? | ||||
| 139 | 2 | 8µs | my $extra = $view->extra; # spent 8µs making 2 calls to SQL::Translator::Schema::Object::extra, avg 4µs/call | ||
| 140 | my @create; | ||||
| 141 | push @create, "DROP VIEW IF EXISTS $view_name" if $add_drop_view; | ||||
| 142 | |||||
| 143 | my $create_view = 'CREATE'; | ||||
| 144 | $create_view .= " TEMPORARY" if exists($extra->{temporary}) && $extra->{temporary}; | ||||
| 145 | $create_view .= ' VIEW'; | ||||
| 146 | $create_view .= " IF NOT EXISTS" if exists($extra->{if_not_exists}) && $extra->{if_not_exists}; | ||||
| 147 | $create_view .= " ${view_name}"; | ||||
| 148 | |||||
| 149 | 2 | 5µ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 | } | ||||
| 152 | push @create, $create_view; | ||||
| 153 | |||||
| 154 | # Tack the comment onto the first statement. | ||||
| 155 | unless ($options->{no_comments}) { | ||||
| 156 | $create[0] = "--\n-- View: ${view_name}\n--\n" . $create[0]; | ||||
| 157 | } | ||||
| 158 | |||||
| 159 | return @create; | ||||
| 160 | } | ||||
| 161 | |||||
| 162 | |||||
| 163 | sub 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 | ||||
| 165 | 1388 | 2.18ms | my ($table, $options) = @_; | ||
| 166 | |||||
| 167 | 35 | 73µs | my $table_name = $table->name; # spent 73µs making 35 calls to SQL::Translator::Schema::Table::name, avg 2µs/call | ||
| 168 | my $no_comments = $options->{no_comments}; | ||||
| 169 | my $add_drop_table = $options->{add_drop_table}; | ||||
| 170 | my $sqlite_version = $options->{sqlite_version} || 0; | ||||
| 171 | |||||
| 172 | 35 | 188µ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 | |||||
| 174 | my ( @index_defs, @constraint_defs ); | ||||
| 175 | 35 | 1.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 | |||||
| 177 | my $temp = $options->{temporary_table} ? 'TEMPORARY ' : ''; | ||||
| 178 | # | ||||
| 179 | # Header. | ||||
| 180 | # | ||||
| 181 | my $exists = ($sqlite_version >= 3.003) ? ' IF EXISTS' : ''; | ||||
| 182 | my @create; | ||||
| 183 | my ($comment, $create_table) = ""; | ||||
| 184 | $comment = "--\n-- Table: $table_name\n--\n" unless $no_comments; | ||||
| 185 | if ($add_drop_table) { | ||||
| 186 | push @create, $comment . qq[DROP TABLE$exists $table_name]; | ||||
| 187 | } else { | ||||
| 188 | $create_table = $comment; | ||||
| 189 | } | ||||
| 190 | |||||
| 191 | $create_table .= "CREATE ${temp}TABLE $table_name (\n"; | ||||
| 192 | |||||
| 193 | # | ||||
| 194 | # Comments | ||||
| 195 | # | ||||
| 196 | 35 | 127µ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 | # | ||||
| 205 | 35 | 621µs | my $pk = $table->primary_key; # spent 621µs making 35 calls to SQL::Translator::Schema::Table::primary_key, avg 18µs/call | ||
| 206 | 35 | 935µ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 | # | ||||
| 211 | my ( @field_defs, $pk_set ); | ||||
| 212 | for my $field ( @fields ) { | ||||
| 213 | 240 | 28.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 | |||||
| 216 | 1 | 14µs | 238 | 115µ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 | # | ||||
| 227 | my $idx_name_default = 'A'; | ||||
| 228 | 35 | 172µs | for my $index ( $table->get_indices ) { # spent 172µs making 35 calls to SQL::Translator::Schema::Table::get_indices, avg 5µs/call | ||
| 229 | 31 | 1.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 | # | ||||
| 235 | my $c_name_default = 'A'; | ||||
| 236 | 35 | 58µs | for my $c ( $table->get_constraints ) { # spent 58µs making 35 calls to SQL::Translator::Schema::Table::get_constraints, avg 2µs/call | ||
| 237 | 96 | 208µ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 | } | ||||
| 240 | 67 | 88µs | next unless $c->type eq UNIQUE; # spent 88µs making 67 calls to SQL::Translator::Schema::Constraint::type, avg 1µs/call | ||
| 241 | 3 | 199µ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 | |||||
| 244 | $create_table .= join(",\n", map { " $_" } @field_defs ) . "\n)"; | ||||
| 245 | |||||
| 246 | 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 | ||||
| 250 | 116 | 129µs | my $c = shift; | ||
| 251 | |||||
| 252 | my $fk_sql = "FOREIGN KEY($c->{fields}[0]) REFERENCES "; | ||||
| 253 | $fk_sql .= ( $c->{reference_table} || '' )."(".( $c->{reference_fields}[0] || '' ).")"; | ||||
| 254 | |||||
| 255 | return $fk_sql; | ||||
| 256 | } | ||||
| 257 | |||||
| 258 | sub 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 | ||||
| 260 | 4134 | 5.47ms | my ($field, $options) = @_; | ||
| 261 | |||||
| 262 | 240 | 408µs | my $field_name = $field->name; # spent 408µs making 240 calls to SQL::Translator::Schema::Field::name, avg 2µs/call | ||
| 263 | 240 | 1.10ms | debug("PKG: Looking at field '$field_name'\n"); # spent 1.10ms making 240 calls to SQL::Translator::Utils::debug, avg 5µs/call | ||
| 264 | 240 | 589µ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 | |||||
| 268 | my $field_def = $field_comments.$field_name; | ||||
| 269 | |||||
| 270 | # data type and size | ||||
| 271 | 240 | 1.95ms | my $size = $field->size; # spent 1.95ms making 240 calls to SQL::Translator::Schema::Field::size, avg 8µs/call | ||
| 272 | 240 | 381µs | my $data_type = $field->data_type; # spent 381µs making 240 calls to SQL::Translator::Schema::Field::data_type, avg 2µs/call | ||
| 273 | $data_type = 'varchar' if lc $data_type eq 'set'; | ||||
| 274 | $data_type = 'blob' if lc $data_type eq 'bytea'; | ||||
| 275 | |||||
| 276 | 240 | 230µ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 | # | ||||
| 297 | 480 | 3.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 | ||
| 298 | 240 | 5.44ms | my @pk_fields = $pk ? $pk->fields : (); # spent 5.44ms making 240 calls to SQL::Translator::Schema::Constraint::fields, avg 23µs/call | ||
| 299 | |||||
| 300 | 275 | 3.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 | ) { | ||||
| 309 | $data_type = 'INTEGER PRIMARY KEY'; | ||||
| 310 | $size = undef; | ||||
| 311 | # $pk_set = 1; | ||||
| 312 | } | ||||
| 313 | |||||
| 314 | 240 | 447µ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? | ||||
| 318 | 240 | 980µ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? | ||||
| 321 | 240 | 1.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 | |||||
| 331 | return $field_def; | ||||
| 332 | |||||
| 333 | } | ||||
| 334 | |||||
| 335 | sub 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 | ||||
| 337 | 341 | 518µs | my ($index, $options) = @_; | ||
| 338 | |||||
| 339 | 31 | 60µs | my $name = $index->name; # spent 60µs making 31 calls to SQL::Translator::Schema::Index::name, avg 2µs/call | ||
| 340 | 31 | 107µs | $name = mk_name($name); # spent 107µs making 31 calls to SQL::Translator::Producer::SQLite::mk_name, avg 3µs/call | ||
| 341 | |||||
| 342 | 31 | 55µ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 | ||||
| 345 | 62 | 265µ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 | ||
| 346 | 93 | 100µ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 | ||
| 347 | warn "removing schema name from '" . $index->table->name . "' to make '$index_table_name'\n" if $WARN; | ||||
| 348 | my $index_def = | ||||
| 349 | "CREATE ${type}INDEX $name ON " . $index_table_name . | ||||
| 350 | ' (' . join( ', ', @fields ) . ')'; | ||||
| 351 | |||||
| 352 | return $index_def; | ||||
| 353 | } | ||||
| 354 | |||||
| 355 | sub 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 | ||||
| 357 | 24 | 60µs | my ($c, $options) = @_; | ||
| 358 | |||||
| 359 | 3 | 10µs | my $name = $c->name; # spent 10µs making 3 calls to SQL::Translator::Schema::Constraint::name, avg 3µs/call | ||
| 360 | 3 | 12µs | $name = mk_name($name); # spent 12µs making 3 calls to SQL::Translator::Producer::SQLite::mk_name, avg 4µs/call | ||
| 361 | 3 | 70µs | my @fields = $c->fields; # spent 70µs making 3 calls to SQL::Translator::Schema::Constraint::fields, avg 23µs/call | ||
| 362 | 9 | 11µ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 | ||
| 363 | warn "removing schema name from '" . $c->table->name . "' to make '$index_table_name'\n" if $WARN; | ||||
| 364 | |||||
| 365 | 1 | 4µs | 3 | 14µs | my $c_def = # spent 14µs making 3 calls to SQL::Translator::Schema::Field::__ANON__[SQL/Translator/Schema/Field.pm:57], avg 5µs/call |
| 366 | "CREATE UNIQUE INDEX $name ON " . $index_table_name . | ||||
| 367 | ' (' . join( ', ', @fields ) . ')'; | ||||
| 368 | |||||
| 369 | return $c_def; | ||||
| 370 | } | ||||
| 371 | |||||
| 372 | sub 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 | |||||
| 425 | sub alter_table { } # Noop | ||||
| 426 | |||||
| 427 | sub add_field { | ||||
| 428 | my ($field) = @_; | ||||
| 429 | |||||
| 430 | return sprintf("ALTER TABLE %s ADD COLUMN %s", | ||||
| 431 | $field->table->name, create_field($field)) | ||||
| 432 | } | ||||
| 433 | |||||
| 434 | sub alter_create_index { | ||||
| 435 | my ($index) = @_; | ||||
| 436 | |||||
| 437 | # This might cause name collisions | ||||
| 438 | return create_index($index); | ||||
| 439 | } | ||||
| 440 | |||||
| 441 | sub alter_create_constraint { | ||||
| 442 | my ($constraint) = @_; | ||||
| 443 | |||||
| 444 | return create_constraint($constraint) if $constraint->type eq 'UNIQUE'; | ||||
| 445 | } | ||||
| 446 | |||||
| 447 | sub alter_drop_constraint { alter_drop_index(@_) } | ||||
| 448 | |||||
| 449 | sub alter_drop_index { | ||||
| 450 | my ($constraint) = @_; | ||||
| 451 | |||||
| 452 | return sprintf("DROP INDEX %s", | ||||
| 453 | $constraint->name); | ||||
| 454 | } | ||||
| 455 | |||||
| 456 | sub 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 | |||||
| 526 | sub drop_table { | ||||
| 527 | my ($table) = @_; | ||||
| 528 | return "DROP TABLE $table"; | ||||
| 529 | } | ||||
| 530 | |||||
| 531 | sub 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. | ||||
| 541 | sub preproces_schema { } | ||||
| 542 | |||||
| 543 | 1 | 6µs | 1; | ||
| 544 | |||||
| 545 | =pod | ||||
| 546 | |||||
| 547 | =head1 SEE ALSO | ||||
| 548 | |||||
| 549 | SQL::Translator, http://www.sqlite.org/. | ||||
| 550 | |||||
| 551 | =head1 AUTHOR | ||||
| 552 | |||||
| 553 | Ken Youens-Clark C<< <kclark@cpan.orgE> >>. | ||||
| 554 | |||||
| 555 | Diff 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 | |||||
# 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 |