Profile of SQL/Translator/Schema/Procedure.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:22:37 2012

Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/SQL/Translator/Schema/Procedure.pm
Statements | Executed 15 statements in 666µs

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 971µs | 2.24ms | SQL::Translator::Schema::Procedure::::BEGIN@49SQL::Translator::Schema::Procedure::BEGIN@49
1 | 1 | 1 | 12µs | 14µs | SQL::Translator::Schema::Procedure::::BEGIN@48SQL::Translator::Schema::Procedure::BEGIN@48
1 | 1 | 1 | 9µs | 1.50ms | SQL::Translator::Schema::Procedure::::BEGIN@51SQL::Translator::Schema::Procedure::BEGIN@51
1 | 1 | 1 | 7µs | 22µs | SQL::Translator::Schema::Procedure::::BEGIN@53SQL::Translator::Schema::Procedure::BEGIN@53
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Procedure::::DESTROYSQL::Translator::Schema::Procedure::DESTROY
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Procedure::::commentsSQL::Translator::Schema::Procedure::comments
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Procedure::::equalsSQL::Translator::Schema::Procedure::equals
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Procedure::::nameSQL::Translator::Schema::Procedure::name
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Procedure::::orderSQL::Translator::Schema::Procedure::order
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Procedure::::ownerSQL::Translator::Schema::Procedure::owner
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Procedure::::parametersSQL::Translator::Schema::Procedure::parameters
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Procedure::::schemaSQL::Translator::Schema::Procedure::schema
0 | 0 | 0 | 0s | 0s | SQL::Translator::Schema::Procedure::::sqlSQL::Translator::Schema::Procedure::sql

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::Procedure;
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::Procedure - SQL::Translator procedure object
26 |  |  |  |  |
27 |  |  |  |  | =head1 SYNOPSIS
28 |  |  |  |  |
29 |  |  |  |  | use SQL::Translator::Schema::Procedure;
30 |  |  |  |  | my $procedure = SQL::Translator::Schema::Procedure->new(
31 |  |  |  |  | name => 'foo',
32 |  |  |  |  | sql => 'CREATE PROC foo AS SELECT * FROM bar',
33 |  |  |  |  | parameters => 'foo,bar',
34 |  |  |  |  | owner => 'nomar',
35 |  |  |  |  | comments => 'blah blah blah',
36 |  |  |  |  | schema => $schema,
37 |  |  |  |  | );
38 |  |  |  |  |
39 |  |  |  |  | =head1 DESCRIPTION
40 |  |  |  |  |
41 |  |  |  |  | C<SQL::Translator::Schema::Procedure> is a class for dealing with
42 |  |  |  |  | stored procedures (and possibly other pieces of nameable SQL code?).
43 |  |  |  |  |
44 |  |  |  |  | =head1 METHODS
45 |  |  |  |  |
46 |  |  |  |  | =cut
47 |  |  |  |  |
48 | 3 | 19µs | 2 | 16µs | # spent 14µs (12+2) within SQL::Translator::Schema::Procedure::BEGIN@48 which was called: # once (12µs+2µs) by SQL::Translator::Schema::BEGIN@49 at line 48 use strict; # spent 14µs making 1 call to SQL::Translator::Schema::Procedure::BEGIN@48 # spent 2µs making 1 call to strict::import
49 | 3 | 109µs | 2 | 2.28ms | # spent 2.24ms (971µs+1.26) within SQL::Translator::Schema::Procedure::BEGIN@49 which was called: # once (971µs+1.26ms) by SQL::Translator::Schema::BEGIN@49 at line 49 use SQL::Translator::Utils 'parse_list_arg'; # spent 2.24ms making 1 call to SQL::Translator::Schema::Procedure::BEGIN@49 # spent 46µs making 1 call to Exporter::import
50 |  |  |  |  |
51 | 3 | 27µs | 2 | 2.98ms | # spent 1.50ms (9µs+1.49) within SQL::Translator::Schema::Procedure::BEGIN@51 which was called: # once (9µs+1.49ms) by SQL::Translator::Schema::BEGIN@49 at line 51 use base 'SQL::Translator::Schema::Object'; # spent 1.50ms making 1 call to SQL::Translator::Schema::Procedure::BEGIN@51 # spent 1.49ms making 1 call to base::import
52 |  |  |  |  |
53 | 3 | 502µs | 2 | 38µs | # spent 22µs (7+15) within SQL::Translator::Schema::Procedure::BEGIN@53 which was called: # once (7µs+15µs) by SQL::Translator::Schema::BEGIN@49 at line 53 use vars qw($VERSION); # spent 22µs making 1 call to SQL::Translator::Schema::Procedure::BEGIN@53 # spent 16µs making 1 call to vars::import
54 |  |  |  |  |
55 | 1 | 600ns |  |  | $VERSION = '1.59';
56 |  |  |  |  |
57 |  |  |  |  | # ----------------------------------------------------------------------
58 |  |  |  |  |
59 | 1 | 5µs | 1 | 49µs | __PACKAGE__->_attributes( qw/ # spent 49µs making 1 call to SQL::Translator::Schema::Object::_attributes
60 |  |  |  |  | name sql parameters comments owner sql schema order
61 |  |  |  |  | /);
62 |  |  |  |  |
63 |  |  |  |  | =pod
64 |  |  |  |  |
65 |  |  |  |  | =head2 new
66 |  |  |  |  |
67 |  |  |  |  | Object constructor.
68 |  |  |  |  |
69 |  |  |  |  | my $schema = SQL::Translator::Schema::Procedure->new;
70 |  |  |  |  |
71 |  |  |  |  | =cut
72 |  |  |  |  |
73 |  |  |  |  | # ----------------------------------------------------------------------
74 |  |  |  |  | sub parameters {
75 |  |  |  |  |
76 |  |  |  |  | =pod
77 |  |  |  |  |
78 |  |  |  |  | =head2 parameters
79 |  |  |  |  |
80 |  |  |  |  | Gets and set the parameters of the stored procedure.
81 |  |  |  |  |
82 |  |  |  |  | $procedure->parameters('id');
83 |  |  |  |  | $procedure->parameters('id', 'name');
84 |  |  |  |  | $procedure->parameters( 'id, name' );
85 |  |  |  |  | $procedure->parameters( [ 'id', 'name' ] );
86 |  |  |  |  | $procedure->parameters( qw[ id name ] );
87 |  |  |  |  |
88 |  |  |  |  | my @parameters = $procedure->parameters;
89 |  |  |  |  |
90 |  |  |  |  | =cut
91 |  |  |  |  |
92 |  |  |  |  | my $self = shift;
93 |  |  |  |  | my $parameters = parse_list_arg( @_ );
94 |  |  |  |  |
95 |  |  |  |  | if ( @$parameters ) {
96 |  |  |  |  | my ( %unique, @unique );
97 |  |  |  |  | for my $p ( @$parameters ) {
98 |  |  |  |  | next if $unique{ $p };
99 |  |  |  |  | $unique{ $p } = 1;
100 |  |  |  |  | push @unique, $p;
101 |  |  |  |  | }
102 |  |  |  |  |
103 |  |  |  |  | $self->{'parameters'} = \@unique;
104 |  |  |  |  | }
105 |  |  |  |  |
106 |  |  |  |  | return wantarray ? @{ $self->{'parameters'} || [] } : ($self->{'parameters'} || '');
107 |  |  |  |  | }
108 |  |  |  |  |
109 |  |  |  |  | # ----------------------------------------------------------------------
110 |  |  |  |  | sub name {
111 |  |  |  |  |
112 |  |  |  |  | =pod
113 |  |  |  |  |
114 |  |  |  |  | =head2 name
115 |  |  |  |  |
116 |  |  |  |  | Get or set the procedure's name.
117 |  |  |  |  |
118 |  |  |  |  | $procedure->name('foo');
119 |  |  |  |  | my $name = $procedure->name;
120 |  |  |  |  |
121 |  |  |  |  | =cut
122 |  |  |  |  |
123 |  |  |  |  | my $self = shift;
124 |  |  |  |  | $self->{'name'} = shift if @_;
125 |  |  |  |  | return $self->{'name'} || '';
126 |  |  |  |  | }
127 |  |  |  |  |
128 |  |  |  |  | # ----------------------------------------------------------------------
129 |  |  |  |  | sub sql {
130 |  |  |  |  |
131 |  |  |  |  | =pod
132 |  |  |  |  |
133 |  |  |  |  | =head2 sql
134 |  |  |  |  |
135 |  |  |  |  | Get or set the procedure's SQL.
136 |  |  |  |  |
137 |  |  |  |  | $procedure->sql('select * from foo');
138 |  |  |  |  | my $sql = $procedure->sql;
139 |  |  |  |  |
140 |  |  |  |  | =cut
141 |  |  |  |  |
142 |  |  |  |  | my $self = shift;
143 |  |  |  |  | $self->{'sql'} = shift if @_;
144 |  |  |  |  | return $self->{'sql'} || '';
145 |  |  |  |  | }
146 |  |  |  |  |
147 |  |  |  |  | # ----------------------------------------------------------------------
148 |  |  |  |  | sub order {
149 |  |  |  |  |
150 |  |  |  |  | =pod
151 |  |  |  |  |
152 |  |  |  |  | =head2 order
153 |  |  |  |  |
154 |  |  |  |  | Get or set the order of the procedure.
155 |  |  |  |  |
156 |  |  |  |  | $procedure->order( 3 );
157 |  |  |  |  | my $order = $procedure->order;
158 |  |  |  |  |
159 |  |  |  |  | =cut
160 |  |  |  |  |
161 |  |  |  |  | my $self = shift;
162 |  |  |  |  | $self->{'order'} = shift if @_;
163 |  |  |  |  | return $self->{'order'};
164 |  |  |  |  | }
165 |  |  |  |  |
166 |  |  |  |  | # ----------------------------------------------------------------------
167 |  |  |  |  | sub owner {
168 |  |  |  |  |
169 |  |  |  |  | =pod
170 |  |  |  |  |
171 |  |  |  |  | =head2 owner
172 |  |  |  |  |
173 |  |  |  |  | Get or set the owner of the procedure.
174 |  |  |  |  |
175 |  |  |  |  | $procedure->owner('nomar');
176 |  |  |  |  | my $sql = $procedure->owner;
177 |  |  |  |  |
178 |  |  |  |  | =cut
179 |  |  |  |  |
180 |  |  |  |  | my $self = shift;
181 |  |  |  |  | $self->{'owner'} = shift if @_;
182 |  |  |  |  | return $self->{'owner'} || '';
183 |  |  |  |  | }
184 |  |  |  |  |
185 |  |  |  |  | # ----------------------------------------------------------------------
186 |  |  |  |  | sub comments {
187 |  |  |  |  |
188 |  |  |  |  | =pod
189 |  |  |  |  |
190 |  |  |  |  | =head2 comments
191 |  |  |  |  |
192 |  |  |  |  | Get or set the comments on a procedure.
193 |  |  |  |  |
194 |  |  |  |  | $procedure->comments('foo');
195 |  |  |  |  | $procedure->comments('bar');
196 |  |  |  |  | print join( ', ', $procedure->comments ); # prints "foo, bar"
197 |  |  |  |  |
198 |  |  |  |  | =cut
199 |  |  |  |  |
200 |  |  |  |  | my $self = shift;
201 |  |  |  |  |
202 |  |  |  |  | for my $arg ( @_ ) {
203 |  |  |  |  | $arg = $arg->[0] if ref $arg;
204 |  |  |  |  | push @{ $self->{'comments'} }, $arg if $arg;
205 |  |  |  |  | }
206 |  |  |  |  |
207 |  |  |  |  | if ( @{ $self->{'comments'} || [] } ) {
208 |  |  |  |  | return wantarray
209 |  |  |  |  | ? @{ $self->{'comments'} || [] }
210 |  |  |  |  | : join( "\n", @{ $self->{'comments'} || [] } );
211 |  |  |  |  | }
212 |  |  |  |  | else {
213 |  |  |  |  | return wantarray ? () : '';
214 |  |  |  |  | }
215 |  |  |  |  | }
216 |  |  |  |  |
217 |  |  |  |  | # ----------------------------------------------------------------------
218 |  |  |  |  | sub schema {
219 |  |  |  |  |
220 |  |  |  |  | =pod
221 |  |  |  |  |
222 |  |  |  |  | =head2 schema
223 |  |  |  |  |
224 |  |  |  |  | Get or set the procedures's schema object.
225 |  |  |  |  |
226 |  |  |  |  | $procedure->schema( $schema );
227 |  |  |  |  | my $schema = $procedure->schema;
228 |  |  |  |  |
229 |  |  |  |  | =cut
230 |  |  |  |  |
231 |  |  |  |  | my $self = shift;
232 |  |  |  |  | if ( my $arg = shift ) {
233 |  |  |  |  | return $self->error('Not a schema object') unless
234 |  |  |  |  | UNIVERSAL::isa( $arg, 'SQL::Translator::Schema' );
235 |  |  |  |  | $self->{'schema'} = $arg;
236 |  |  |  |  | }
237 |  |  |  |  |
238 |  |  |  |  | return $self->{'schema'};
239 |  |  |  |  | }
240 |  |  |  |  |
241 |  |  |  |  | # ----------------------------------------------------------------------
242 |  |  |  |  | sub equals {
243 |  |  |  |  |
244 |  |  |  |  | =pod
245 |  |  |  |  |
246 |  |  |  |  | =head2 equals
247 |  |  |  |  |
248 |  |  |  |  | Determines if this procedure is the same as another
249 |  |  |  |  |
250 |  |  |  |  | my $isIdentical = $procedure1->equals( $procedure2 );
251 |  |  |  |  |
252 |  |  |  |  | =cut
253 |  |  |  |  |
254 |  |  |  |  | my $self = shift;
255 |  |  |  |  | my $other = shift;
256 |  |  |  |  | my $case_insensitive = shift;
257 |  |  |  |  | my $ignore_sql = shift;
258 |  |  |  |  |
259 |  |  |  |  | return 0 unless $self->SUPER::equals($other);
260 |  |  |  |  | return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
261 |  |  |  |  |
262 |  |  |  |  | unless ($ignore_sql) {
263 |  |  |  |  | my $selfSql = $self->sql;
264 |  |  |  |  | my $otherSql = $other->sql;
265 |  |  |  |  | # Remove comments
266 |  |  |  |  | $selfSql =~ s/--.*$//mg;
267 |  |  |  |  | $otherSql =~ s/--.*$//mg;
268 |  |  |  |  | # Collapse whitespace to space to avoid whitespace comparison issues
269 |  |  |  |  | $selfSql =~ s/\s+/ /sg;
270 |  |  |  |  | $otherSql =~ s/\s+/ /sg;
271 |  |  |  |  | return 0 unless $selfSql eq $otherSql;
272 |  |  |  |  | }
273 |  |  |  |  |
274 |  |  |  |  | return 0 unless $self->_compare_objects(scalar $self->parameters, scalar $other->parameters);
275 |  |  |  |  | # return 0 unless $self->comments eq $other->comments;
276 |  |  |  |  | # return 0 unless $case_insensitive ? uc($self->owner) eq uc($other->owner) : $self->owner eq $other->owner;
277 |  |  |  |  | return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
278 |  |  |  |  | return 1;
279 |  |  |  |  | }
280 |  |  |  |  |
281 |  |  |  |  | # ----------------------------------------------------------------------
282 |  |  |  |  | sub DESTROY {
283 |  |  |  |  | my $self = shift;
284 |  |  |  |  | undef $self->{'schema'}; # destroy cyclical reference
285 |  |  |  |  | }
286 |  |  |  |  |
287 | 1 | 4µs |  |  | 1;
288 |  |  |  |  |
289 |  |  |  |  | # ----------------------------------------------------------------------
290 |  |  |  |  |
291 |  |  |  |  | =pod
292 |  |  |  |  |
293 |  |  |  |  | =head1 AUTHORS
294 |  |  |  |  |
295 |  |  |  |  | Ken Youens-Clark E<lt>kclark@cshl.orgE<gt>,
296 |  |  |  |  | Paul Harrington E<lt>Paul-Harrington@deshaw.comE<gt>.
297 |  |  |  |  |
298 |  |  |  |  | =cut