Profile of SQL/Translator/Schema/Object.pm

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

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

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
379 | 2 | 2 | 9.32ms | 44.0ms | SQL::Translator::Schema::Object::::initSQL::Translator::Schema::Object::init
387 | 9 | 9 | 2.22ms | 3.29ms | SQL::Translator::Schema::Object::::_attributesSQL::Translator::Schema::Object::_attributes
1 | 1 | 1 | 595µs | 703µs | SQL::Translator::Schema::Object::::BEGIN@40SQL::Translator::Schema::Object::BEGIN@40
11 | 1 | 1 | 113µs | 540µs | SQL::Translator::Schema::Object::::equalsSQL::Translator::Schema::Object::equals
5 | 2 | 2 | 46µs | 46µs | SQL::Translator::Schema::Object::::extraSQL::Translator::Schema::Object::extra
1 | 1 | 1 | 15µs | 19µs | SQL::Translator::Schema::Object::::BEGIN@36SQL::Translator::Schema::Object::BEGIN@36
1 | 1 | 1 | 11µs | 11µs | SQL::Translator::Schema::Object::::BEGIN@37SQL::Translator::Schema::Object::BEGIN@37
1 | 1 | 1 | 8µs | 76µs | SQL::Translator::Schema::Object::::BEGIN@38SQL::Translator::Schema::Object::BEGIN@38
1 | 1 | 1 | 7µs | 55µs | SQL::Translator::Schema::Object::::BEGIN@39SQL::Translator::Schema::Object::BEGIN@39
1 | 1 | 1 | 7µs | 22µs | SQL::Translator::Schema::Object::::BEGIN@42SQL::Translator::Schema::Object::BEGIN@42
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Object::::_compare_objectsSQL::Translator::Schema::Object::_compare_objects
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Object::::remove_extraSQL::Translator::Schema::Object::remove_extra

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::Object;
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::Object - Base class SQL::Translator Schema objects.
26 |  |  |  |  |
27 |  |  |  |  | =head1 SYNOPSIS
28 |  |  |  |  |
29 |  |  |  |  | =head1 DESCSIPTION
30 |  |  |  |  |
31 |  |  |  |  | Base class for Schema objects. Sub classes L<Class::Base> and adds the following
32 |  |  |  |  | extra functionality.
33 |  |  |  |  |
34 |  |  |  |  | =cut
35 |  |  |  |  |
36 | 3 | 19µs | 2 | 22µs | # spent 19µs (15+4) within SQL::Translator::Schema::Object::BEGIN@36 which was called: # once (15µs+4µs) by base::import at line 36 use strict; # spent 19µs making 1 call to SQL::Translator::Schema::Object::BEGIN@36 # spent 3µs making 1 call to strict::import
37 | 3 | 26µs | 1 | 11µs | # spent 11µs within SQL::Translator::Schema::Object::BEGIN@37 which was called: # once (11µs+0s) by base::import at line 37 use Class::Base; # spent 11µs making 1 call to SQL::Translator::Schema::Object::BEGIN@37
38 | 3 | 19µs | 2 | 76µs | # spent 76µs (8+68) within SQL::Translator::Schema::Object::BEGIN@38 which was called: # once (8µs+68µs) by base::import at line 38 use base 'Class::Data::Inheritable'; # spent 76µs making 1 call to SQL::Translator::Schema::Object::BEGIN@38 # spent 68µs making 1 call to base::import, recursion: max depth 1, sum of overlapping time 68µs
39 | 3 | 21µs | 2 | 55µs | # spent 55µs (7+48) within SQL::Translator::Schema::Object::BEGIN@39 which was called: # once (7µs+48µs) by base::import at line 39 use base 'Class::Base'; # spent 55µs making 1 call to SQL::Translator::Schema::Object::BEGIN@39 # spent 48µs making 1 call to base::import, recursion: max depth 1, sum of overlapping time 48µs
40 | 3 | 129µs | 2 | 707µs | # spent 703µs (595+108) within SQL::Translator::Schema::Object::BEGIN@40 which was called: # once (595µs+108µs) by base::import at line 40 use Class::MakeMethods::Utility::Ref qw( ref_compare ); # spent 703µs making 1 call to SQL::Translator::Schema::Object::BEGIN@40 # spent 3µs making 1 call to Class::MakeMethods::Utility::Ref::import
41 |  |  |  |  |
42 | 3 | 339µs | 2 | 38µs | # spent 22µs (7+15) within SQL::Translator::Schema::Object::BEGIN@42 which was called: # once (7µs+15µs) by base::import at line 42 use vars qw[ $VERSION ]; # spent 22µs making 1 call to SQL::Translator::Schema::Object::BEGIN@42 # spent 15µs making 1 call to vars::import
43 |  |  |  |  |
44 | 1 | 400ns |  |  | $VERSION = '1.59';
45 |  |  |  |  |
46 |  |  |  |  |
47 |  |  |  |  | =head1 Construction
48 |  |  |  |  |
49 |  |  |  |  | Derived classes should declare their attributes using the C<_attributes>
50 |  |  |  |  | method. They can then inherit the C<init> method from here which will call
51 |  |  |  |  | accessors of the same name for any values given in the hash passed to C<new>.
52 |  |  |  |  | Note that you will have to impliment the accessors your self and we expect perl
53 |  |  |  |  | style methods; call with no args to get and with arg to set.
54 |  |  |  |  |
55 |  |  |  |  | e.g. If we setup our class as follows;
56 |  |  |  |  |
57 |  |  |  |  | package SQL::Translator::Schema::Table;
58 |  |  |  |  | use base qw/SQL::Translator::Schema::Object/;
59 |  |  |  |  |
60 |  |  |  |  | __PACKAGE__->_attributes( qw/schema name/ );
61 |  |  |  |  |
62 |  |  |  |  | sub name { ... }
63 |  |  |  |  | sub schema { ... }
64 |  |  |  |  |
65 |  |  |  |  | Then we can construct it with
66 |  |  |  |  |
67 |  |  |  |  | my $table = SQL::Translator::Schema::Table->new(
68 |  |  |  |  | schema => $schema,
69 |  |  |  |  | name => 'foo',
70 |  |  |  |  | );
71 |  |  |  |  |
72 |  |  |  |  | and init will call C<< $table->name("foo") >> and C<< $table->schema($schema) >>
73 |  |  |  |  | to set it up. Any undefined args will be ignored.
74 |  |  |  |  |
75 |  |  |  |  | Multiple calls to C<_attributes> are cumulative and sub classes will inherit
76 |  |  |  |  | their parents attribute names.
77 |  |  |  |  |
78 |  |  |  |  | This is currently experimental, but will hopefull go on to form an introspection
79 |  |  |  |  | API for the Schema objects.
80 |  |  |  |  |
81 |  |  |  |  | =cut
82 |  |  |  |  |
83 |  |  |  |  |
84 | 1 | 6µs | 1 | 15µs | __PACKAGE__->mk_classdata("__attributes"); # spent 15µs making 1 call to Class::Data::Inheritable::mk_classdata
85 |  |  |  |  |
86 |  |  |  |  | # Define any global attributes here
87 | 1 | 2µs | 1 | 4µs | __PACKAGE__->__attributes([qw/extra/]); # spent 4µs making 1 call to Class::Data::Inheritable::__ANON__[Class/Data/Inheritable.pm:23]
88 |  |  |  |  |
89 |  |  |  |  | # Set the classes attribute names. Multiple calls are cumulative.
90 |  |  |  |  | # We need to be careful to create a new ref so that all classes don't end up
91 |  |  |  |  | # with the same ref and hence the same attributes!
92 |  |  |  |  | # spent 3.29ms (2.22+1.07) within SQL::Translator::Schema::Object::_attributes which was called 387 times, avg 9µs/call: # 379 times (2.06ms+808µs) by SQL::Translator::Schema::Object::init at line 102, avg 8µs/call # once (23µs+42µs) by SQL::Translator::Schema::BEGIN@50 at line 65 of SQL/Translator/Schema/Table.pm # once (23µs+37µs) by SQL::Translator::Schema::Table::BEGIN@44 at line 96 of SQL/Translator/Schema/Field.pm # once (23µs+33µs) by SQL::Translator::BEGIN@39 at line 61 of SQL/Translator/Schema.pm # once (20µs+33µs) by SQL::Translator::Schema::Table::BEGIN@43 at line 64 of SQL/Translator/Schema/Constraint.pm # once (16µs+37µs) by SQL::Translator::Schema::BEGIN@51 at line 61 of SQL/Translator/Schema/Trigger.pm # once (21µs+28µs) by SQL::Translator::Schema::BEGIN@49 at line 59 of SQL/Translator/Schema/Procedure.pm # once (14µs+32µs) by SQL::Translator::Schema::Table::BEGIN@45 at line 66 of SQL/Translator/Schema/Index.pm # once (14µs+26µs) by SQL::Translator::Schema::BEGIN@52 at line 55 of SQL/Translator/Schema/View.pm sub _attributes {
93 | 1161 | 2.10ms |  |  | my $class = shift;
94 |  |  | 16 | 254µs | if (@_) { $class->__attributes( [ @{$class->__attributes}, @_ ] ); } # spent 254µs making 16 calls to Class::Data::Inheritable::__ANON__[Class/Data/Inheritable.pm:23], avg 16µs/call
95 |  |  | 387 | 821µs | return @{$class->__attributes}; # spent 821µs making 387 calls to Class::Data::Inheritable::__ANON__[Class/Data/Inheritable.pm:23], avg 2µs/call
96 |  |  |  |  | }
97 |  |  |  |  |
98 |  |  |  |  | # Call accessors for any args in hashref passed
99 |  |  |  |  | # spent 44.0ms (9.32+34.7) within SQL::Translator::Schema::Object::init which was called 379 times, avg 116µs/call: # 312 times (7.70ms+29.5ms) by Class::Base::new at line 59 of Class/Base.pm, avg 119µs/call # 67 times (1.62ms+5.17ms) by SQL::Translator::Schema::Constraint::init at line 95 of SQL/Translator/Schema/Constraint.pm, avg 101µs/call sub init {
100 | 1137 | 1.52ms |  |  | my ( $self, $config ) = @_;
101 |  |  |  |  |
102 |  |  | 379 | 2.87ms | for my $arg ( $self->_attributes ) { # spent 2.87ms making 379 calls to SQL::Translator::Schema::Object::_attributes, avg 8µs/call
103 | 6844 | 5.91ms |  |  | next unless defined $config->{$arg};
104 |  |  | 2256 | 31.8ms | defined $self->$arg( $config->{$arg} ) or return; # spent 5.86ms making 240 calls to SQL::Translator::Schema::Field::is_nullable, avg 24µs/call # spent 5.16ms making 240 calls to SQL::Translator::Schema::Field::size, avg 22µs/call # spent 5.10ms making 240 calls to SQL::Translator::Schema::Field::name, avg 21µs/call # spent 4.98ms making 240 calls to SQL::Translator::Schema::Field::is_foreign_key, avg 21µs/call # spent 2.77ms making 240 calls to SQL::Translator::Schema::Field::table, avg 12µs/call # spent 2.50ms making 67 calls to SQL::Translator::Schema::Constraint::fields, avg 37µs/call # spent 910µs making 240 calls to SQL::Translator::Schema::Field::data_type, avg 4µs/call # spent 843µs making 67 calls to SQL::Translator::Schema::Constraint::table, avg 13µs/call # spent 619µs making 240 calls to SQL::Translator::Schema::Field::is_auto_increment, avg 3µs/call # spent 601µs making 31 calls to SQL::Translator::Schema::Index::fields, avg 19µs/call # spent 504µs making 67 calls to SQL::Translator::Schema::Constraint::type, avg 8µs/call # spent 438µs making 29 calls to SQL::Translator::Schema::Constraint::reference_fields, avg 15µs/call # spent 402µs making 31 calls to SQL::Translator::Schema::Index::table, avg 13µs/call # spent 300µs making 35 calls to SQL::Translator::Schema::Table::name, avg 9µs/call # spent 123µs making 29 calls to SQL::Translator::Schema::Index::type, avg 4µs/call # spent 122µs making 55 calls to SQL::Translator::Schema::Field::default_value, avg 2µs/call # spent 105µs making 32 calls to SQL::Translator::Schema::Constraint::name, avg 3µs/call # spent 102µs making 2 calls to SQL::Translator::Schema::View::fields, avg 51µs/call # spent 85µs making 31 calls to SQL::Translator::Schema::Index::name, avg 3µs/call # spent 77µs making 29 calls to SQL::Translator::Schema::Constraint::reference_table, avg 3µs/call # spent 75µs making 29 calls to SQL::Translator::Schema::Constraint::on_update, avg 3µs/call # spent 73µs making 29 calls to SQL::Translator::Schema::Constraint::on_delete, avg 3µs/call # spent 38µs making 3 calls to SQL::Translator::Schema::Object::extra, avg 13µs/call # spent 12µs making 2 calls to SQL::Translator::Schema::View::schema, avg 6µs/call # spent 12µs making 4 calls to SQL::Translator::Schema::translator, avg 3µs/call # spent 8µs making 2 calls to SQL::Translator::Schema::View::sql, avg 4µs/call # spent 5µs making 2 calls to SQL::Translator::Schema::View::name, avg 3µs/call
105 |  |  |  |  | }
106 |  |  |  |  |
107 |  |  |  |  | return $self;
108 |  |  |  |  | }
109 |  |  |  |  |
110 |  |  |  |  | # ----------------------------------------------------------------------
111 |  |  |  |  | # spent 46µs within SQL::Translator::Schema::Object::extra which was called 5 times, avg 9µs/call: # 3 times (38µs+0s) by SQL::Translator::Schema::Object::init at line 104, avg 13µs/call # 2 times (8µs+0s) by SQL::Translator::Producer::SQLite::create_view at line 139 of SQL/Translator/Producer/SQLite.pm, avg 4µs/call sub extra {
112 |  |  |  |  |
113 |  |  |  |  | =pod
114 |  |  |  |  |
115 |  |  |  |  | =head1 Global Attributes
116 |  |  |  |  |
117 |  |  |  |  | The following attributes are defined here, therefore all schema objects will
118 |  |  |  |  | have them.
119 |  |  |  |  |
120 |  |  |  |  | =head2 extra
121 |  |  |  |  |
122 |  |  |  |  | Get or set the objects "extra" attibutes (e.g., "ZEROFILL" for MySQL fields).
123 |  |  |  |  | Call with no args to get all the extra data.
124 |  |  |  |  | Call with a single name arg to get the value of the named extra attribute,
125 |  |  |  |  | returned as a scalar. Call with a hash or hashref to set extra attributes.
126 |  |  |  |  | Returns a hash or a hashref.
127 |  |  |  |  |
128 |  |  |  |  | $field->extra( qualifier => 'ZEROFILL' );
129 |  |  |  |  |
130 |  |  |  |  | $qualifier = $field->extra('qualifier');
131 |  |  |  |  |
132 |  |  |  |  | %extra = $field->extra;
133 |  |  |  |  | $extra = $field->extra;
134 |  |  |  |  |
135 |  |  |  |  | =cut
136 |  |  |  |  |
137 | 25 | 40µs |  |  | my $self = shift;
138 |  |  |  |  | @_ = %{$_[0]} if ref $_[0] eq "HASH";
139 |  |  |  |  | my $extra = $self->{'extra'} ||= {};
140 |  |  |  |  |
141 | 6 | 14µs |  |  | if (@_==1) {
142 |  |  |  |  | return exists($extra->{$_[0]}) ? $extra->{$_[0]} : undef ;
143 |  |  |  |  | }
144 |  |  |  |  | elsif (@_) {
145 |  |  |  |  | my %args = @_;
146 |  |  |  |  | while ( my ( $key, $value ) = each %args ) {
147 |  |  |  |  | $extra->{$key} = $value;
148 |  |  |  |  | }
149 |  |  |  |  | }
150 |  |  |  |  |
151 |  |  |  |  | return wantarray ? %$extra : $extra;
152 |  |  |  |  | }
153 |  |  |  |  |
154 |  |  |  |  | # ----------------------------------------------------------------------
155 |  |  |  |  | sub remove_extra {
156 |  |  |  |  |
157 |  |  |  |  | =head2 remove_extra
158 |  |  |  |  |
159 |  |  |  |  | L</extra> can only be used to get or set "extra" attributes but not to
160 |  |  |  |  | remove some. Call with no args to remove all extra attributes that
161 |  |  |  |  | have been set before. Call with a list of key names to remove
162 |  |  |  |  | certain extra attributes only.
163 |  |  |  |  |
164 |  |  |  |  | # remove all extra attributes
165 |  |  |  |  | $field->remove_extra();
166 |  |  |  |  |
167 |  |  |  |  | # remove timezone and locale attributes only
168 |  |  |  |  | $field->remove_extra(qw/timezone locale/);
169 |  |  |  |  |
170 |  |  |  |  | =cut
171 |  |  |  |  |
172 |  |  |  |  | my ( $self, @keys ) = @_;
173 |  |  |  |  | unless (@keys) {
174 |  |  |  |  | $self->{'extra'} = {};
175 |  |  |  |  | }
176 |  |  |  |  | else {
177 |  |  |  |  | delete $self->{'extra'}{$_} for @keys;
178 |  |  |  |  | }
179 |  |  |  |  | }
180 |  |  |  |  |
181 |  |  |  |  | # ----------------------------------------------------------------------
182 |  |  |  |  | # spent 540µs (113+427) within SQL::Translator::Schema::Object::equals which was called 11 times, avg 49µs/call: # 11 times (113µs+427µs) by SQL::Translator::Schema::Index::equals at line 262 of SQL/Translator/Schema/Index.pm, avg 49µs/call sub equals {
183 |  |  |  |  |
184 |  |  |  |  | =pod
185 |  |  |  |  |
186 |  |  |  |  | =head2 equals
187 |  |  |  |  |
188 |  |  |  |  | Determines if this object is the same as another.
189 |  |  |  |  |
190 |  |  |  |  | my $isIdentical = $object1->equals( $object2 );
191 |  |  |  |  |
192 |  |  |  |  | =cut
193 |  |  |  |  |
194 | 66 | 163µs |  |  | my $self = shift;
195 |  |  |  |  | my $other = shift;
196 |  |  |  |  |
197 |  |  |  |  | return 0 unless $other;
198 |  |  | 22 | 415µs | return 1 if overload::StrVal($self) eq overload::StrVal($other); # spent 415µs making 22 calls to overload::AddrRef, avg 19µs/call
199 |  |  | 11 | 12µs | return 0 unless $other->isa( __PACKAGE__ ); # spent 12µs making 11 calls to UNIVERSAL::isa, avg 1µs/call
200 |  |  |  |  | return 1;
201 |  |  |  |  | }
202 |  |  |  |  |
203 |  |  |  |  | # ----------------------------------------------------------------------
204 |  |  |  |  | sub _compare_objects {
205 |  |  |  |  | my $self = shift;
206 |  |  |  |  | my $obj1 = shift;
207 |  |  |  |  | my $obj2 = shift;
208 |  |  |  |  | my $result = (ref_compare($obj1, $obj2) == 0);
209 |  |  |  |  | # if ( !$result ) {
210 |  |  |  |  | # use Carp qw(cluck);
211 |  |  |  |  | # cluck("How did I get here?");
212 |  |  |  |  | # use Data::Dumper;
213 |  |  |  |  | # $Data::Dumper::Maxdepth = 1;
214 |  |  |  |  | # print "obj1: ", Dumper($obj1), "\n";
215 |  |  |  |  | # print "obj2: ", Dumper($obj2), "\n";
216 |  |  |  |  | # }
217 |  |  |  |  | return $result;
218 |  |  |  |  | }
219 |  |  |  |  |
220 |  |  |  |  | #=============================================================================
221 |  |  |  |  |
222 | 1 | 4µs |  |  | 1;
223 |  |  |  |  |
224 |  |  |  |  | =pod
225 |  |  |  |  |
226 |  |  |  |  | =head1 SEE ALSO
227 |  |  |  |  |
228 |  |  |  |  | =head1 TODO
229 |  |  |  |  |
230 |  |  |  |  | =head1 BUGS
231 |  |  |  |  |
232 |  |  |  |  | =head1 AUTHOR
233 |  |  |  |  |
234 |  |  |  |  | Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
235 |  |  |  |  | Mark Addison E<lt>mark.addison@itn.co.ukE<gt>.
236 |  |  |  |  |
237 |  |  |  |  | =cut