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