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 |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 971µs | 2.24ms | BEGIN@49 | SQL::Translator::Schema::Procedure::
1 | 1 | 1 | 12µs | 14µs | BEGIN@48 | SQL::Translator::Schema::Procedure::
1 | 1 | 1 | 9µs | 1.50ms | BEGIN@51 | SQL::Translator::Schema::Procedure::
1 | 1 | 1 | 7µs | 22µs | BEGIN@53 | SQL::Translator::Schema::Procedure::
0 | 0 | 0 | 0s | 0s | DESTROY | SQL::Translator::Schema::Procedure::
0 | 0 | 0 | 0s | 0s | comments | SQL::Translator::Schema::Procedure::
0 | 0 | 0 | 0s | 0s | equals | SQL::Translator::Schema::Procedure::
0 | 0 | 0 | 0s | 0s | name | SQL::Translator::Schema::Procedure::
0 | 0 | 0 | 0s | 0s | order | SQL::Translator::Schema::Procedure::
0 | 0 | 0 | 0s | 0s | owner | SQL::Translator::Schema::Procedure::
0 | 0 | 0 | 0s | 0s | parameters | SQL::Translator::Schema::Procedure::
0 | 0 | 0 | 0s | 0s | schema | SQL::Translator::Schema::Procedure::
0 | 0 | 0 | 0s | 0s | sql | SQL::Translator::Schema::Procedure::
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 # 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 # 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 # 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 # 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 |