← 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:22:37 2012

Filename/2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Translator/Schema/Object.pm
StatementsExecuted 9261 statements in 10.3ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
379229.32ms44.0msSQL::Translator::Schema::Object::::initSQL::Translator::Schema::Object::init
387992.22ms3.29msSQL::Translator::Schema::Object::::_attributesSQL::Translator::Schema::Object::_attributes
111595µs703µsSQL::Translator::Schema::Object::::BEGIN@40SQL::Translator::Schema::Object::BEGIN@40
1111113µs540µsSQL::Translator::Schema::Object::::equalsSQL::Translator::Schema::Object::equals
52246µs46µsSQL::Translator::Schema::Object::::extraSQL::Translator::Schema::Object::extra
11115µs19µsSQL::Translator::Schema::Object::::BEGIN@36SQL::Translator::Schema::Object::BEGIN@36
11111µs11µsSQL::Translator::Schema::Object::::BEGIN@37SQL::Translator::Schema::Object::BEGIN@37
1118µs76µsSQL::Translator::Schema::Object::::BEGIN@38SQL::Translator::Schema::Object::BEGIN@38
1117µs55µsSQL::Translator::Schema::Object::::BEGIN@39SQL::Translator::Schema::Object::BEGIN@39
1117µs22µsSQL::Translator::Schema::Object::::BEGIN@42SQL::Translator::Schema::Object::BEGIN@42
0000s0sSQL::Translator::Schema::Object::::_compare_objectsSQL::Translator::Schema::Object::_compare_objects
0000s0sSQL::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
1package 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
25SQL::Translator::Schema::Object - Base class SQL::Translator Schema objects.
26
27=head1 SYNOPSIS
28
29=head1 DESCSIPTION
30
31Base class for Schema objects. Sub classes L<Class::Base> and adds the following
32extra functionality.
33
34=cut
35
36319µs222µ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
37326µs111µ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
38319µs276µ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
39321µs255µ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
403129µs2707µ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
423339µs238µ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
441400ns$VERSION = '1.59';
45
46
47=head1 Construction
48
49Derived classes should declare their attributes using the C<_attributes>
50method. They can then inherit the C<init> method from here which will call
51accessors of the same name for any values given in the hash passed to C<new>.
52Note that you will have to impliment the accessors your self and we expect perl
53style methods; call with no args to get and with arg to set.
54
55e.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
65Then we can construct it with
66
67 my $table = SQL::Translator::Schema::Table->new(
68 schema => $schema,
69 name => 'foo',
70 );
71
72and init will call C<< $table->name("foo") >> and C<< $table->schema($schema) >>
73to set it up. Any undefined args will be ignored.
74
75Multiple calls to C<_attributes> are cumulative and sub classes will inherit
76their parents attribute names.
77
78This is currently experimental, but will hopefull go on to form an introspection
79API for the Schema objects.
80
81=cut
82
83
8416µs115µs__PACKAGE__->mk_classdata("__attributes");
# spent 15µs making 1 call to Class::Data::Inheritable::mk_classdata
85
86# Define any global attributes here
8712µs14µs__PACKAGE__->__attributes([qw/extra/]);
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 {
9311612.10ms my $class = shift;
9416254µ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
95387821µ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 {
10079817.43ms my ( $self, $config ) = @_;
101
1023792.87ms for my $arg ( $self->_attributes ) {
# spent 2.87ms making 379 calls to SQL::Translator::Schema::Object::_attributes, avg 8µs/call
103 next unless defined $config->{$arg};
104225631.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
117The following attributes are defined here, therefore all schema objects will
118have them.
119
120=head2 extra
121
122Get or set the objects "extra" attibutes (e.g., "ZEROFILL" for MySQL fields).
123Call with no args to get all the extra data.
124Call with a single name arg to get the value of the named extra attribute,
125returned as a scalar. Call with a hash or hashref to set extra attributes.
126Returns 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
1373154µs my $self = shift;
138 @_ = %{$_[0]} if ref $_[0] eq "HASH";
139 my $extra = $self->{'extra'} ||= {};
140
141 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# ----------------------------------------------------------------------
155sub remove_extra {
156
157=head2 remove_extra
158
159L</extra> can only be used to get or set "extra" attributes but not to
160remove some. Call with no args to remove all extra attributes that
161have been set before. Call with a list of key names to remove
162certain 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
188Determines if this object is the same as another.
189
190 my $isIdentical = $object1->equals( $object2 );
191
192=cut
193
19466163µs my $self = shift;
195 my $other = shift;
196
197 return 0 unless $other;
19822415µs return 1 if overload::StrVal($self) eq overload::StrVal($other);
# spent 415µs making 22 calls to overload::AddrRef, avg 19µs/call
1991112µ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# ----------------------------------------------------------------------
204sub _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
22214µs1;
223
224=pod
225
226=head1 SEE ALSO
227
228=head1 TODO
229
230=head1 BUGS
231
232=head1 AUTHOR
233
234Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
235Mark Addison E<lt>mark.addison@itn.co.ukE<gt>.
236
237=cut