Profile of SQL/Translator/Schema/Constraint.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:24:05 2012

Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Translator/Schema/Constraint.pm
Statements | Executed 8559 statements in 10.5ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
433 | 6 | 4 | 5.15ms | 11.0ms | SQL::Translator::Schema::Constraint::::fieldsSQL::Translator::Schema::Constraint::fields
660 | 5 | 3 | 1.31ms | 1.40ms | SQL::Translator::Schema::Constraint::::typeSQL::Translator::Schema::Constraint::type
530 | 3 | 3 | 1.15ms | 1.53ms | SQL::Translator::Schema::Constraint::::tableSQL::Translator::Schema::Constraint::table
67 | 1 | 1 | 756µs | 7.55ms | SQL::Translator::Schema::Constraint::::initSQL::Translator::Schema::Constraint::init
29 | 1 | 1 | 201µs | 438µs | SQL::Translator::Schema::Constraint::::reference_fieldsSQL::Translator::Schema::Constraint::reference_fields
35 | 2 | 2 | 115µs | 115µs | SQL::Translator::Schema::Constraint::::nameSQL::Translator::Schema::Constraint::name
67 | 1 | 1 | 91µs | 91µs | SQL::Translator::Schema::Constraint::::CORE:substSQL::Translator::Schema::Constraint::CORE:subst (opcode)
29 | 1 | 1 | 77µs | 77µs | SQL::Translator::Schema::Constraint::::reference_tableSQL::Translator::Schema::Constraint::reference_table
29 | 1 | 1 | 75µs | 75µs | SQL::Translator::Schema::Constraint::::on_updateSQL::Translator::Schema::Constraint::on_update
29 | 1 | 1 | 73µs | 73µs | SQL::Translator::Schema::Constraint::::on_deleteSQL::Translator::Schema::Constraint::on_delete
1 | 1 | 1 | 12µs | 14µs | SQL::Translator::Schema::Constraint::::BEGIN@44SQL::Translator::Schema::Constraint::BEGIN@44
1 | 1 | 1 | 7µs | 74µs | SQL::Translator::Schema::Constraint::::BEGIN@48SQL::Translator::Schema::Constraint::BEGIN@48
1 | 1 | 1 | 7µs | 60µs | SQL::Translator::Schema::Constraint::::BEGIN@45SQL::Translator::Schema::Constraint::BEGIN@45
1 | 1 | 1 | 7µs | 24µs | SQL::Translator::Schema::Constraint::::BEGIN@46SQL::Translator::Schema::Constraint::BEGIN@46
1 | 1 | 1 | 6µs | 45µs | SQL::Translator::Schema::Constraint::::BEGIN@50SQL::Translator::Schema::Constraint::BEGIN@50
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Constraint::::DESTROYSQL::Translator::Schema::Constraint::DESTROY
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Constraint::::deferrableSQL::Translator::Schema::Constraint::deferrable
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Constraint::::equalsSQL::Translator::Schema::Constraint::equals
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Constraint::::expressionSQL::Translator::Schema::Constraint::expression
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Constraint::::field_namesSQL::Translator::Schema::Constraint::field_names
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Constraint::::is_validSQL::Translator::Schema::Constraint::is_valid
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Constraint::::match_typeSQL::Translator::Schema::Constraint::match_type
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Constraint::::optionsSQL::Translator::Schema::Constraint::options

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package SQL::Translator::Schema::Constraint;
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 |  |  |  |  | =pod
22 |  |  |  |  |
23 |  |  |  |  | =head1 NAME
24 |  |  |  |  |
25 |  |  |  |  | SQL::Translator::Schema::Constraint - SQL::Translator constraint object
26 |  |  |  |  |
27 |  |  |  |  | =head1 SYNOPSIS
28 |  |  |  |  |
29 |  |  |  |  | use SQL::Translator::Schema::Constraint;
30 |  |  |  |  | my $constraint = SQL::Translator::Schema::Constraint->new(
31 |  |  |  |  | name => 'foo',
32 |  |  |  |  | fields => [ id ],
33 |  |  |  |  | type => PRIMARY_KEY,
34 |  |  |  |  | );
35 |  |  |  |  |
36 |  |  |  |  | =head1 DESCRIPTION
37 |  |  |  |  |
38 |  |  |  |  | C<SQL::Translator::Schema::Constraint> is the constraint object.
39 |  |  |  |  |
40 |  |  |  |  | =head1 METHODS
41 |  |  |  |  |
42 |  |  |  |  | =cut
43 |  |  |  |  |
44 | 3 | 17µs | 2 | 16µs | # spent 14µs (12+2) within SQL::Translator::Schema::Constraint::BEGIN@44 which was called: # once (12µs+2µs) by SQL::Translator::Schema::Table::BEGIN@43 at line 44 use strict; # spent 14µs making 1 call to SQL::Translator::Schema::Constraint::BEGIN@44 # spent 2µs making 1 call to strict::import
45 | 3 | 19µs | 2 | 114µs | # spent 60µs (7+53) within SQL::Translator::Schema::Constraint::BEGIN@45 which was called: # once (7µs+53µs) by SQL::Translator::Schema::Table::BEGIN@43 at line 45 use SQL::Translator::Schema::Constants; # spent 60µs making 1 call to SQL::Translator::Schema::Constraint::BEGIN@45 # spent 53µs making 1 call to Exporter::import
46 | 3 | 20µs | 2 | 42µs | # spent 24µs (7+18) within SQL::Translator::Schema::Constraint::BEGIN@46 which was called: # once (7µs+18µs) by SQL::Translator::Schema::Table::BEGIN@43 at line 46 use SQL::Translator::Utils 'parse_list_arg'; # spent 24µs making 1 call to SQL::Translator::Schema::Constraint::BEGIN@46 # spent 18µs making 1 call to Exporter::import
47 |  |  |  |  |
48 | 3 | 22µs | 2 | 141µs | # spent 74µs (7+67) within SQL::Translator::Schema::Constraint::BEGIN@48 which was called: # once (7µs+67µs) by SQL::Translator::Schema::Table::BEGIN@43 at line 48 use base 'SQL::Translator::Schema::Object'; # spent 74µs making 1 call to SQL::Translator::Schema::Constraint::BEGIN@48 # spent 67µs making 1 call to base::import
49 |  |  |  |  |
50 | 3 | 1.39ms | 2 | 84µs | # spent 45µs (6+39) within SQL::Translator::Schema::Constraint::BEGIN@50 which was called: # once (6µs+39µs) by SQL::Translator::Schema::Table::BEGIN@43 at line 50 use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT); # spent 45µs making 1 call to SQL::Translator::Schema::Constraint::BEGIN@50 # spent 39µs making 1 call to vars::import
51 |  |  |  |  |
52 | 1 | 600ns |  |  | $VERSION = '1.59';
53 |  |  |  |  |
54 | 1 | 5µs |  |  | my %VALID_CONSTRAINT_TYPE = (
55 |  |  |  |  | PRIMARY_KEY, 1,
56 |  |  |  |  | UNIQUE, 1,
57 |  |  |  |  | CHECK_C, 1,
58 |  |  |  |  | FOREIGN_KEY, 1,
59 |  |  |  |  | NOT_NULL, 1,
60 |  |  |  |  | );
61 |  |  |  |  |
62 |  |  |  |  | # ----------------------------------------------------------------------
63 |  |  |  |  |
64 | 1 | 7µs | 1 | 53µs | __PACKAGE__->_attributes( qw/ # spent 53µs making 1 call to SQL::Translator::Schema::Object::_attributes
65 |  |  |  |  | table name type fields reference_fields reference_table
66 |  |  |  |  | match_type on_delete on_update expression deferrable
67 |  |  |  |  | /);
68 |  |  |  |  |
69 |  |  |  |  | # Override to remove empty arrays from args.
70 |  |  |  |  | # t/14postgres-parser breaks without this.
71 |  |  |  |  | # spent 7.55ms (756µs+6.79) within SQL::Translator::Schema::Constraint::init which was called 67 times, avg 113µs/call: # 67 times (756µs+6.79ms) by Class::Base::new at line 59 of Class/Base.pm, avg 113µs/call sub init {
72 |  |  |  |  |
73 |  |  |  |  | =pod
74 |  |  |  |  |
75 |  |  |  |  | =head2 new
76 |  |  |  |  |
77 |  |  |  |  | Object constructor.
78 |  |  |  |  |
79 |  |  |  |  | my $schema = SQL::Translator::Schema::Constraint->new(
80 |  |  |  |  | table => $table, # table to which it belongs
81 |  |  |  |  | type => 'foreign_key', # type of table constraint
82 |  |  |  |  | name => 'fk_phone_id', # name of the constraint
83 |  |  |  |  | fields => 'phone_id', # field in the referring table
84 |  |  |  |  | reference_fields => 'phone_id', # referenced field
85 |  |  |  |  | reference_table => 'phone', # referenced table
86 |  |  |  |  | match_type => 'full', # how to match
87 |  |  |  |  | on_delete => 'cascade', # what to do on deletes
88 |  |  |  |  | on_update => '', # what to do on updates
89 |  |  |  |  | );
90 |  |  |  |  |
91 |  |  |  |  | =cut
92 |  |  |  |  |
93 | 67 | 25µs |  |  | my $self = shift;
94 | 416 | 326µs |  |  | foreach ( values %{$_[0]} ) { $_ = undef if ref($_) eq "ARRAY" && ! @$_; }
95 | 67 | 392µs | 67 | 6.79ms | $self->SUPER::init(@_); # spent 6.79ms making 67 calls to SQL::Translator::Schema::Object::init, avg 101µs/call
96 |  |  |  |  | }
97 |  |  |  |  |
98 |  |  |  |  | # ----------------------------------------------------------------------
99 |  |  |  |  | sub deferrable {
100 |  |  |  |  |
101 |  |  |  |  | =pod
102 |  |  |  |  |
103 |  |  |  |  | =head2 deferrable
104 |  |  |  |  |
105 |  |  |  |  | Get or set whether the constraint is deferrable. If not defined,
106 |  |  |  |  | then returns "1." The argument is evaluated by Perl for True or
107 |  |  |  |  | False, so the following are eqivalent:
108 |  |  |  |  |
109 |  |  |  |  | $deferrable = $field->deferrable(0);
110 |  |  |  |  | $deferrable = $field->deferrable('');
111 |  |  |  |  | $deferrable = $field->deferrable('0');
112 |  |  |  |  |
113 |  |  |  |  | =cut
114 |  |  |  |  |
115 |  |  |  |  | my ( $self, $arg ) = @_;
116 |  |  |  |  |
117 |  |  |  |  | if ( defined $arg ) {
118 |  |  |  |  | $self->{'deferrable'} = $arg ? 1 : 0;
119 |  |  |  |  | }
120 |  |  |  |  |
121 |  |  |  |  | return defined $self->{'deferrable'} ? $self->{'deferrable'} : 1;
122 |  |  |  |  | }
123 |  |  |  |  |
124 |  |  |  |  | # ----------------------------------------------------------------------
125 |  |  |  |  | sub expression {
126 |  |  |  |  |
127 |  |  |  |  | =pod
128 |  |  |  |  |
129 |  |  |  |  | =head2 expression
130 |  |  |  |  |
131 |  |  |  |  | Gets and set the expression used in a CHECK constraint.
132 |  |  |  |  |
133 |  |  |  |  | my $expression = $constraint->expression('...');
134 |  |  |  |  |
135 |  |  |  |  | =cut
136 |  |  |  |  |
137 |  |  |  |  | my $self = shift;
138 |  |  |  |  |
139 |  |  |  |  | if ( my $arg = shift ) {
140 |  |  |  |  | # check arg here?
141 |  |  |  |  | $self->{'expression'} = $arg;
142 |  |  |  |  | }
143 |  |  |  |  |
144 |  |  |  |  | return $self->{'expression'} || '';
145 |  |  |  |  | }
146 |  |  |  |  |
147 |  |  |  |  | # ----------------------------------------------------------------------
148 |  |  |  |  | sub is_valid {
149 |  |  |  |  |
150 |  |  |  |  | =pod
151 |  |  |  |  |
152 |  |  |  |  | =head2 is_valid
153 |  |  |  |  |
154 |  |  |  |  | Determine whether the constraint is valid or not.
155 |  |  |  |  |
156 |  |  |  |  | my $ok = $constraint->is_valid;
157 |  |  |  |  |
158 |  |  |  |  | =cut
159 |  |  |  |  |
160 |  |  |  |  | my $self = shift;
161 |  |  |  |  | my $type = $self->type or return $self->error('No type');
162 |  |  |  |  | my $table = $self->table or return $self->error('No table');
163 |  |  |  |  | my @fields = $self->fields or return $self->error('No fields');
164 |  |  |  |  | my $table_name = $table->name or return $self->error('No table name');
165 |  |  |  |  |
166 |  |  |  |  | for my $f ( @fields ) {
167 |  |  |  |  | next if $table->get_field( $f );
168 |  |  |  |  | return $self->error(
169 |  |  |  |  | "Constraint references non-existent field '$f' ",
170 |  |  |  |  | "in table '$table_name'"
171 |  |  |  |  | );
172 |  |  |  |  | }
173 |  |  |  |  |
174 |  |  |  |  | my $schema = $table->schema or return $self->error(
175 |  |  |  |  | 'Table ', $table->name, ' has no schema object'
176 |  |  |  |  | );
177 |  |  |  |  |
178 |  |  |  |  | if ( $type eq FOREIGN_KEY ) {
179 |  |  |  |  | return $self->error('Only one field allowed for foreign key')
180 |  |  |  |  | if scalar @fields > 1;
181 |  |  |  |  |
182 |  |  |  |  | my $ref_table_name = $self->reference_table or
183 |  |  |  |  | return $self->error('No reference table');
184 |  |  |  |  |
185 |  |  |  |  | my $ref_table = $schema->get_table( $ref_table_name ) or
186 |  |  |  |  | return $self->error("No table named '$ref_table_name' in schema");
187 |  |  |  |  |
188 |  |  |  |  | my @ref_fields = $self->reference_fields or return;
189 |  |  |  |  |
190 |  |  |  |  | return $self->error('Only one field allowed for foreign key reference')
191 |  |  |  |  | if scalar @ref_fields > 1;
192 |  |  |  |  |
193 |  |  |  |  | for my $ref_field ( @ref_fields ) {
194 |  |  |  |  | next if $ref_table->get_field( $ref_field );
195 |  |  |  |  | return $self->error(
196 |  |  |  |  | "Constraint from field(s) ",
197 |  |  |  |  | join(', ', map {qq['$table_name.$_']} @fields),
198 |  |  |  |  | " to non-existent field '$ref_table_name.$ref_field'"
199 |  |  |  |  | );
200 |  |  |  |  | }
201 |  |  |  |  | }
202 |  |  |  |  | elsif ( $type eq CHECK_C ) {
203 |  |  |  |  | return $self->error('No expression for CHECK') unless
204 |  |  |  |  | $self->expression;
205 |  |  |  |  | }
206 |  |  |  |  |
207 |  |  |  |  | return 1;
208 |  |  |  |  | }
209 |  |  |  |  |
210 |  |  |  |  | # ----------------------------------------------------------------------
211 |  |  |  |  | # spent 11.0ms (5.15+5.87) within SQL::Translator::Schema::Constraint::fields which was called 433 times, avg 25µs/call: # 240 times (2.54ms+2.89ms) by SQL::Translator::Producer::SQLite::create_field at line 298 of SQL/Translator/Producer/SQLite.pm, avg 23µs/call # 67 times (1.20ms+1.30ms) by SQL::Translator::Schema::Object::init at line 104 of SQL/Translator/Schema/Object.pm, avg 37µs/call # 53 times (546µs+676µs) by SQL::Translator::Schema::Field::is_primary_key at line 385 of SQL/Translator/Schema/Field.pm, avg 23µs/call # 35 times (429µs+506µs) by SQL::Translator::Producer::SQLite::create_table at line 206 of SQL/Translator/Producer/SQLite.pm, avg 27µs/call # 35 times (401µs+454µs) by SQL::Translator::Schema::Table::add_constraint at line 136 of SQL/Translator/Schema/Table.pm, avg 24µs/call # 3 times (32µs+38µs) by SQL::Translator::Producer::SQLite::create_constraint at line 361 of SQL/Translator/Producer/SQLite.pm, avg 23µs/call sub fields {
212 |  |  |  |  |
213 |  |  |  |  | =pod
214 |  |  |  |  |
215 |  |  |  |  | =head2 fields
216 |  |  |  |  |
217 |  |  |  |  | Gets and set the fields the constraint is on. Accepts a string, list or
218 |  |  |  |  | arrayref; returns an array or array reference. Will unique the field
219 |  |  |  |  | names and keep them in order by the first occurrence of a field name.
220 |  |  |  |  |
221 |  |  |  |  | The fields are returned as Field objects if they exist or as plain
222 |  |  |  |  | names if not. (If you just want the names and want to avoid the Field's overload
223 |  |  |  |  | magic use L<field_names>).
224 |  |  |  |  |
225 |  |  |  |  | Returns undef or an empty list if the constraint has no fields set.
226 |  |  |  |  |
227 |  |  |  |  | $constraint->fields('id');
228 |  |  |  |  | $constraint->fields('id', 'name');
229 |  |  |  |  | $constraint->fields( 'id, name' );
230 |  |  |  |  | $constraint->fields( [ 'id', 'name' ] );
231 |  |  |  |  | $constraint->fields( qw[ id name ] );
232 |  |  |  |  |
233 |  |  |  |  | my @fields = $constraint->fields;
234 |  |  |  |  |
235 |  |  |  |  | =cut
236 |  |  |  |  |
237 | 433 | 110µs |  |  | my $self = shift;
238 | 433 | 424µs | 433 | 2.04ms | my $fields = parse_list_arg( @_ ); # spent 2.04ms making 433 calls to SQL::Translator::Utils::parse_list_arg, avg 5µs/call
239 |  |  |  |  |
240 | 433 | 94µs |  |  | if ( @$fields ) {
241 | 67 | 26µs |  |  | my ( %unique, @unique );
242 | 67 | 47µs |  |  | for my $f ( @$fields ) {
243 | 71 | 23µs |  |  | next if $unique{ $f };
244 | 71 | 35µs |  |  | $unique{ $f } = 1;
245 | 71 | 80µs |  |  | push @unique, $f;
246 |  |  |  |  | }
247 |  |  |  |  |
248 | 67 | 82µs |  |  | $self->{'fields'} = \@unique;
249 |  |  |  |  | }
250 |  |  |  |  |
251 | 433 | 178µs |  |  | if ( @{ $self->{'fields'} || [] } ) {
252 |  |  |  |  | # We have to return fields that don't exist on the table as names in
253 |  |  |  |  | # case those fields havn't been created yet.
254 | 460 | 1.51ms | 1380 | 3.83ms | my @ret = map { # spent 2.03ms making 460 calls to SQL::Translator::Schema::Field::__ANON__[SQL/Translator/Schema/Field.pm:58], avg 4µs/call # spent 1.11ms making 460 calls to SQL::Translator::Schema::Table::get_field, avg 2µs/call # spent 687µs making 460 calls to SQL::Translator::Schema::Constraint::table, avg 1µs/call
255 | 433 | 547µs |  |  | $self->table->get_field($_) || $_ } @{ $self->{'fields'} };
256 | 433 | 927µs |  |  | return wantarray ? @ret : \@ret;
257 |  |  |  |  | }
258 |  |  |  |  | else {
259 |  |  |  |  | return wantarray ? () : undef;
260 |  |  |  |  | }
261 |  |  |  |  | }
262 |  |  |  |  |
263 |  |  |  |  | # ----------------------------------------------------------------------
264 |  |  |  |  | sub field_names {
265 |  |  |  |  |
266 |  |  |  |  | =head2 field_names
267 |  |  |  |  |
268 |  |  |  |  | Read-only method to return a list or array ref of the field names. Returns undef
269 |  |  |  |  | or an empty list if the constraint has no fields set. Useful if you want to
270 |  |  |  |  | avoid the overload magic of the Field objects returned by the fields method.
271 |  |  |  |  |
272 |  |  |  |  | my @names = $constraint->field_names;
273 |  |  |  |  |
274 |  |  |  |  | =cut
275 |  |  |  |  |
276 |  |  |  |  | my $self = shift;
277 |  |  |  |  | return wantarray ? @{ $self->{'fields'} || [] } : ($self->{'fields'} || '');
278 |  |  |  |  | }
279 |  |  |  |  |
280 |  |  |  |  | # ----------------------------------------------------------------------
281 |  |  |  |  | sub match_type {
282 |  |  |  |  |
283 |  |  |  |  | =pod
284 |  |  |  |  |
285 |  |  |  |  | =head2 match_type
286 |  |  |  |  |
287 |  |  |  |  | Get or set the constraint's match_type. Only valid values are "full"
288 |  |  |  |  | "partial" and "simple"
289 |  |  |  |  |
290 |  |  |  |  | my $match_type = $constraint->match_type('FULL');
291 |  |  |  |  |
292 |  |  |  |  | =cut
293 |  |  |  |  |
294 |  |  |  |  | my ( $self, $arg ) = @_;
295 |  |  |  |  |
296 |  |  |  |  | if ( $arg ) {
297 |  |  |  |  | $arg = lc $arg;
298 |  |  |  |  | return $self->error("Invalid match type: $arg")
299 |  |  |  |  | unless $arg eq 'full' || $arg eq 'partial' || $arg eq 'simple';
300 |  |  |  |  | $self->{'match_type'} = $arg;
301 |  |  |  |  | }
302 |  |  |  |  |
303 |  |  |  |  | return $self->{'match_type'} || '';
304 |  |  |  |  | }
305 |  |  |  |  |
306 |  |  |  |  | # ----------------------------------------------------------------------
307 |  |  |  |  | # spent 115µs within SQL::Translator::Schema::Constraint::name which was called 35 times, avg 3µs/call: # 32 times (105µs+0s) by SQL::Translator::Schema::Object::init at line 104 of SQL/Translator/Schema/Object.pm, avg 3µs/call # 3 times (10µs+0s) by SQL::Translator::Producer::SQLite::create_constraint at line 359 of SQL/Translator/Producer/SQLite.pm, avg 3µs/call sub name {
308 |  |  |  |  |
309 |  |  |  |  | =pod
310 |  |  |  |  |
311 |  |  |  |  | =head2 name
312 |  |  |  |  |
313 |  |  |  |  | Get or set the constraint's name.
314 |  |  |  |  |
315 |  |  |  |  | my $name = $constraint->name('foo');
316 |  |  |  |  |
317 |  |  |  |  | =cut
318 |  |  |  |  |
319 | 35 | 14µs |  |  | my $self = shift;
320 | 35 | 22µs |  |  | my $arg = shift || '';
321 | 35 | 27µs |  |  | $self->{'name'} = $arg if $arg;
322 | 35 | 87µs |  |  | return $self->{'name'} || '';
323 |  |  |  |  | }
324 |  |  |  |  |
325 |  |  |  |  | # ----------------------------------------------------------------------
326 |  |  |  |  | sub options {
327 |  |  |  |  |
328 |  |  |  |  | =pod
329 |  |  |  |  |
330 |  |  |  |  | =head2 options
331 |  |  |  |  |
332 |  |  |  |  | Gets or adds to the constraints's options (e.g., "INITIALLY IMMEDIATE").
333 |  |  |  |  | Returns an array or array reference.
334 |  |  |  |  |
335 |  |  |  |  | $constraint->options('NORELY');
336 |  |  |  |  | my @options = $constraint->options;
337 |  |  |  |  |
338 |  |  |  |  | =cut
339 |  |  |  |  |
340 |  |  |  |  | my $self = shift;
341 |  |  |  |  | my $options = parse_list_arg( @_ );
342 |  |  |  |  |
343 |  |  |  |  | push @{ $self->{'options'} }, @$options;
344 |  |  |  |  |
345 |  |  |  |  | if ( ref $self->{'options'} ) {
346 |  |  |  |  | return wantarray ? @{ $self->{'options'} || [] } : $self->{'options'};
347 |  |  |  |  | }
348 |  |  |  |  | else {
349 |  |  |  |  | return wantarray ? () : [];
350 |  |  |  |  | }
351 |  |  |  |  | }
352 |  |  |  |  |
353 |  |  |  |  |
354 |  |  |  |  | # ----------------------------------------------------------------------
355 |  |  |  |  | # spent 73µs within SQL::Translator::Schema::Constraint::on_delete which was called 29 times, avg 3µs/call: # 29 times (73µs+0s) by SQL::Translator::Schema::Object::init at line 104 of SQL/Translator/Schema/Object.pm, avg 3µs/call sub on_delete {
356 |  |  |  |  |
357 |  |  |  |  | =pod
358 |  |  |  |  |
359 |  |  |  |  | =head2 on_delete
360 |  |  |  |  |
361 |  |  |  |  | Get or set the constraint's "on delete" action.
362 |  |  |  |  |
363 |  |  |  |  | my $action = $constraint->on_delete('cascade');
364 |  |  |  |  |
365 |  |  |  |  | =cut
366 |  |  |  |  |
367 | 29 | 10µs |  |  | my $self = shift;
368 |  |  |  |  |
369 | 29 | 24µs |  |  | if ( my $arg = shift ) {
370 |  |  |  |  | # validate $arg?
371 |  |  |  |  | $self->{'on_delete'} = $arg;
372 |  |  |  |  | }
373 |  |  |  |  |
374 | 29 | 66µs |  |  | return $self->{'on_delete'} || '';
375 |  |  |  |  | }
376 |  |  |  |  |
377 |  |  |  |  | # ----------------------------------------------------------------------
378 |  |  |  |  | # spent 75µs within SQL::Translator::Schema::Constraint::on_update which was called 29 times, avg 3µs/call: # 29 times (75µs+0s) by SQL::Translator::Schema::Object::init at line 104 of SQL/Translator/Schema/Object.pm, avg 3µs/call sub on_update {
379 |  |  |  |  |
380 |  |  |  |  | =pod
381 |  |  |  |  |
382 |  |  |  |  | =head2 on_update
383 |  |  |  |  |
384 |  |  |  |  | Get or set the constraint's "on update" action.
385 |  |  |  |  |
386 |  |  |  |  | my $action = $constraint->on_update('no action');
387 |  |  |  |  |
388 |  |  |  |  | =cut
389 |  |  |  |  |
390 | 29 | 9µs |  |  | my $self = shift;
391 |  |  |  |  |
392 | 29 | 24µs |  |  | if ( my $arg = shift ) {
393 |  |  |  |  | # validate $arg?
394 |  |  |  |  | $self->{'on_update'} = $arg;
395 |  |  |  |  | }
396 |  |  |  |  |
397 | 29 | 73µs |  |  | return $self->{'on_update'} || '';
398 |  |  |  |  | }
399 |  |  |  |  |
400 |  |  |  |  | # ----------------------------------------------------------------------
401 |  |  |  |  | # spent 438µs (201+237) within SQL::Translator::Schema::Constraint::reference_fields which was called 29 times, avg 15µs/call: # 29 times (201µs+237µs) by SQL::Translator::Schema::Object::init at line 104 of SQL/Translator/Schema/Object.pm, avg 15µs/call sub reference_fields {
402 |  |  |  |  |
403 |  |  |  |  | =pod
404 |  |  |  |  |
405 |  |  |  |  | =head2 reference_fields
406 |  |  |  |  |
407 |  |  |  |  | Gets and set the fields in the referred table. Accepts a string, list or
408 |  |  |  |  | arrayref; returns an array or array reference.
409 |  |  |  |  |
410 |  |  |  |  | $constraint->reference_fields('id');
411 |  |  |  |  | $constraint->reference_fields('id', 'name');
412 |  |  |  |  | $constraint->reference_fields( 'id, name' );
413 |  |  |  |  | $constraint->reference_fields( [ 'id', 'name' ] );
414 |  |  |  |  | $constraint->reference_fields( qw[ id name ] );
415 |  |  |  |  |
416 |  |  |  |  | my @reference_fields = $constraint->reference_fields;
417 |  |  |  |  |
418 |  |  |  |  | =cut
419 |  |  |  |  |
420 | 29 | 11µs |  |  | my $self = shift;
421 | 29 | 37µs | 29 | 237µs | my $fields = parse_list_arg( @_ ); # spent 237µs making 29 calls to SQL::Translator::Utils::parse_list_arg, avg 8µs/call
422 |  |  |  |  |
423 | 29 | 36µs |  |  | if ( @$fields ) {
424 |  |  |  |  | $self->{'reference_fields'} = $fields;
425 |  |  |  |  | }
426 |  |  |  |  |
427 |  |  |  |  | # Nothing set so try and derive it from the other constraint data
428 | 29 | 20µs |  |  | unless ( ref $self->{'reference_fields'} ) {
429 |  |  |  |  | my $table = $self->table or return $self->error('No table');
430 |  |  |  |  | my $schema = $table->schema or return $self->error('No schema');
431 |  |  |  |  | if ( my $ref_table_name = $self->reference_table ) {
432 |  |  |  |  | my $ref_table = $schema->get_table( $ref_table_name ) or
433 |  |  |  |  | return $self->error("Can't find table '$ref_table_name'");
434 |  |  |  |  |
435 |  |  |  |  | if ( my $constraint = $ref_table->primary_key ) {
436 |  |  |  |  | $self->{'reference_fields'} = [ $constraint->fields ];
437 |  |  |  |  | }
438 |  |  |  |  | else {
439 |  |  |  |  | $self->error(
440 |  |  |  |  | 'No reference fields defined and cannot find primary key in ',
441 |  |  |  |  | "reference table '$ref_table_name'"
442 |  |  |  |  | );
443 |  |  |  |  | }
444 |  |  |  |  | }
445 |  |  |  |  | # No ref table so we are not that sort of constraint, hence no ref
446 |  |  |  |  | # fields. So we let the return below return an empty list.
447 |  |  |  |  | }
448 |  |  |  |  |
449 | 29 | 80µs |  |  | if ( ref $self->{'reference_fields'} ) {
450 |  |  |  |  | return wantarray
451 |  |  |  |  | ? @{ $self->{'reference_fields'} }
452 |  |  |  |  | : $self->{'reference_fields'};
453 |  |  |  |  | }
454 |  |  |  |  | else {
455 |  |  |  |  | return wantarray ? () : [];
456 |  |  |  |  | }
457 |  |  |  |  | }
458 |  |  |  |  |
459 |  |  |  |  | # ----------------------------------------------------------------------
460 |  |  |  |  | # spent 77µs within SQL::Translator::Schema::Constraint::reference_table which was called 29 times, avg 3µs/call: # 29 times (77µs+0s) by SQL::Translator::Schema::Object::init at line 104 of SQL/Translator/Schema/Object.pm, avg 3µs/call sub reference_table {
461 |  |  |  |  |
462 |  |  |  |  | =pod
463 |  |  |  |  |
464 |  |  |  |  | =head2 reference_table
465 |  |  |  |  |
466 |  |  |  |  | Get or set the table referred to by the constraint.
467 |  |  |  |  |
468 |  |  |  |  | my $reference_table = $constraint->reference_table('foo');
469 |  |  |  |  |
470 |  |  |  |  | =cut
471 |  |  |  |  |
472 | 29 | 14µs |  |  | my $self = shift;
473 | 29 | 25µs |  |  | $self->{'reference_table'} = shift if @_;
474 | 29 | 69µs |  |  | return $self->{'reference_table'} || '';
475 |  |  |  |  | }
476 |  |  |  |  |
477 |  |  |  |  | # ----------------------------------------------------------------------
478 |  |  |  |  | # spent 1.53ms (1.15+383µs) within SQL::Translator::Schema::Constraint::table which was called 530 times, avg 3µs/call: # 460 times (687µs+0s) by SQL::Translator::Schema::Constraint::fields at line 254, avg 1µs/call # 67 times (460µs+383µs) by SQL::Translator::Schema::Object::init at line 104 of SQL/Translator/Schema/Object.pm, avg 13µs/call # 3 times (4µs+0s) by SQL::Translator::Producer::SQLite::create_constraint at line 362 of SQL/Translator/Producer/SQLite.pm, avg 1µs/call sub table {
479 |  |  |  |  |
480 |  |  |  |  | =pod
481 |  |  |  |  |
482 |  |  |  |  | =head2 table
483 |  |  |  |  |
484 |  |  |  |  | Get or set the constraint's table object.
485 |  |  |  |  |
486 |  |  |  |  | my $table = $field->table;
487 |  |  |  |  |
488 |  |  |  |  | =cut
489 |  |  |  |  |
490 | 530 | 128µs |  |  | my $self = shift;
491 | 530 | 233µs | 67 | 327µs | if ( my $arg = shift ) { # spent 327µs making 67 calls to SQL::Translator::Schema::Table::__ANON__[SQL/Translator/Schema/Table.pm:59], avg 5µs/call
492 | 67 | 165µs | 67 | 55µs | return $self->error('Not a table object') unless # spent 55µs making 67 calls to UNIVERSAL::isa, avg 827ns/call
493 |  |  |  |  | UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' );
494 | 67 | 46µs |  |  | $self->{'table'} = $arg;
495 |  |  |  |  | }
496 |  |  |  |  |
497 | 530 | 973µs |  |  | return $self->{'table'};
498 |  |  |  |  | }
499 |  |  |  |  |
500 |  |  |  |  | # ----------------------------------------------------------------------
501 |  |  |  |  | # spent 1.40ms (1.31+91µs) within SQL::Translator::Schema::Constraint::type which was called 660 times, avg 2µs/call: # 360 times (564µs+0s) by SQL::Translator::Schema::Table::primary_key at line 841 of SQL/Translator/Schema/Table.pm, avg 2µs/call # 99 times (144µs+0s) by SQL::Translator::Schema::Table::add_constraint at line 136 of SQL/Translator/Schema/Table.pm, avg 1µs/call # 67 times (413µs+91µs) by SQL::Translator::Schema::Object::init at line 104 of SQL/Translator/Schema/Object.pm, avg 8µs/call # 67 times (103µs+0s) by SQL::Translator::Producer::SQLite::create_table at line 237 of SQL/Translator/Producer/SQLite.pm, avg 2µs/call # 67 times (88µs+0s) by SQL::Translator::Producer::SQLite::create_table at line 240 of SQL/Translator/Producer/SQLite.pm, avg 1µs/call sub type {
502 |  |  |  |  |
503 |  |  |  |  | =pod
504 |  |  |  |  |
505 |  |  |  |  | =head2 type
506 |  |  |  |  |
507 |  |  |  |  | Get or set the constraint's type.
508 |  |  |  |  |
509 |  |  |  |  | my $type = $constraint->type( PRIMARY_KEY );
510 |  |  |  |  |
511 |  |  |  |  | =cut
512 |  |  |  |  |
513 | 660 | 256µs |  |  | my ( $self, $type ) = @_;
514 |  |  |  |  |
515 | 660 | 115µs |  |  | if ( $type ) {
516 | 67 | 35µs |  |  | $type = uc $type;
517 | 67 | 221µs | 67 | 91µs | $type =~ s/_/ /g; # spent 91µs making 67 calls to SQL::Translator::Schema::Constraint::CORE:subst, avg 1µs/call
518 | 67 | 46µs |  |  | return $self->error("Invalid constraint type: $type")
519 |  |  |  |  | unless $VALID_CONSTRAINT_TYPE{ $type };
520 | 67 | 49µs |  |  | $self->{'type'} = $type;
521 |  |  |  |  | }
522 |  |  |  |  |
523 | 660 | 1.28ms |  |  | return $self->{'type'} || '';
524 |  |  |  |  | }
525 |  |  |  |  |
526 |  |  |  |  | # ----------------------------------------------------------------------
527 |  |  |  |  | sub equals {
528 |  |  |  |  |
529 |  |  |  |  | =pod
530 |  |  |  |  |
531 |  |  |  |  | =head2 equals
532 |  |  |  |  |
533 |  |  |  |  | Determines if this constraint is the same as another
534 |  |  |  |  |
535 |  |  |  |  | my $isIdentical = $constraint1->equals( $constraint2 );
536 |  |  |  |  |
537 |  |  |  |  | =cut
538 |  |  |  |  |
539 |  |  |  |  | my $self = shift;
540 |  |  |  |  | my $other = shift;
541 |  |  |  |  | my $case_insensitive = shift;
542 |  |  |  |  | my $ignore_constraint_names = shift;
543 |  |  |  |  |
544 |  |  |  |  | return 0 unless $self->SUPER::equals($other);
545 |  |  |  |  | return 0 unless $self->type eq $other->type;
546 |  |  |  |  | unless ($ignore_constraint_names) {
547 |  |  |  |  | return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
548 |  |  |  |  | }
549 |  |  |  |  | return 0 unless $self->deferrable eq $other->deferrable;
550 |  |  |  |  | #return 0 unless $self->is_valid eq $other->is_valid;
551 |  |  |  |  | return 0 unless $case_insensitive ? uc($self->table->name) eq uc($other->table->name)
552 |  |  |  |  | : $self->table->name eq $other->table->name;
553 |  |  |  |  | return 0 unless $self->expression eq $other->expression;
554 |  |  |  |  |
555 |  |  |  |  | # Check fields, regardless of order
556 |  |  |  |  | my %otherFields = (); # create a hash of the other fields
557 |  |  |  |  | foreach my $otherField ($other->fields) {
558 |  |  |  |  | $otherField = uc($otherField) if $case_insensitive;
559 |  |  |  |  | $otherFields{$otherField} = 1;
560 |  |  |  |  | }
561 |  |  |  |  | foreach my $selfField ($self->fields) { # check for self fields in hash
562 |  |  |  |  | $selfField = uc($selfField) if $case_insensitive;
563 |  |  |  |  | return 0 unless $otherFields{$selfField};
564 |  |  |  |  | delete $otherFields{$selfField};
565 |  |  |  |  | }
566 |  |  |  |  | # Check all other fields were accounted for
567 |  |  |  |  | return 0 unless keys %otherFields == 0;
568 |  |  |  |  |
569 |  |  |  |  | # Check reference fields, regardless of order
570 |  |  |  |  | my %otherRefFields = (); # create a hash of the other reference fields
571 |  |  |  |  | foreach my $otherRefField ($other->reference_fields) {
572 |  |  |  |  | $otherRefField = uc($otherRefField) if $case_insensitive;
573 |  |  |  |  | $otherRefFields{$otherRefField} = 1;
574 |  |  |  |  | }
575 |  |  |  |  | foreach my $selfRefField ($self->reference_fields) { # check for self reference fields in hash
576 |  |  |  |  | $selfRefField = uc($selfRefField) if $case_insensitive;
577 |  |  |  |  | return 0 unless $otherRefFields{$selfRefField};
578 |  |  |  |  | delete $otherRefFields{$selfRefField};
579 |  |  |  |  | }
580 |  |  |  |  | # Check all other reference fields were accounted for
581 |  |  |  |  | return 0 unless keys %otherRefFields == 0;
582 |  |  |  |  |
583 |  |  |  |  | return 0 unless $case_insensitive ? uc($self->reference_table) eq uc($other->reference_table) : $self->reference_table eq $other->reference_table;
584 |  |  |  |  | return 0 unless $self->match_type eq $other->match_type;
585 |  |  |  |  | return 0 unless $self->on_delete eq $other->on_delete;
586 |  |  |  |  | return 0 unless $self->on_update eq $other->on_update;
587 |  |  |  |  | return 0 unless $self->_compare_objects(scalar $self->options, scalar $other->options);
588 |  |  |  |  | return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
589 |  |  |  |  | return 1;
590 |  |  |  |  | }
591 |  |  |  |  |
592 |  |  |  |  | # ----------------------------------------------------------------------
593 |  |  |  |  | sub DESTROY {
594 |  |  |  |  | my $self = shift;
595 |  |  |  |  | undef $self->{'table'}; # destroy cyclical reference
596 |  |  |  |  | }
597 |  |  |  |  |
598 | 1 | 5µs |  |  | 1;
599 |  |  |  |  |
600 |  |  |  |  | # ----------------------------------------------------------------------
601 |  |  |  |  |
602 |  |  |  |  | =pod
603 |  |  |  |  |
604 |  |  |  |  | =head1 AUTHOR
605 |  |  |  |  |
606 |  |  |  |  | Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
607 |  |  |  |  |
608 |  |  |  |  | =cut
|  |  |  |  | # spent 91µs within SQL::Translator::Schema::Constraint::CORE:subst which was called 67 times, avg 1µs/call: # 67 times (91µs+0s) by SQL::Translator::Schema::Constraint::type at line 517, avg 1µs/call sub SQL::Translator::Schema::Constraint::CORE:subst; # opcode