Commit | Line | Data |
2c0b3f9f |
1 | package SQL::Translator::Schema::Procedure; |
2 | |
3 | # ---------------------------------------------------------------------- |
478f608d |
4 | # Copyright (C) 2002-2009 SQLFairy Authors |
2c0b3f9f |
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 | use strict; |
2c0b3f9f |
49 | use SQL::Translator::Utils 'parse_list_arg'; |
50 | |
b6a880d1 |
51 | use base 'SQL::Translator::Schema::Object'; |
52 | |
da06ac74 |
53 | use vars qw($VERSION); |
54 | |
4ab3763d |
55 | $VERSION = '1.59'; |
da06ac74 |
56 | |
2c0b3f9f |
57 | # ---------------------------------------------------------------------- |
9371be50 |
58 | |
59 | __PACKAGE__->_attributes( qw/ |
60 | name sql parameters comments owner sql schema order |
61 | /); |
2c0b3f9f |
62 | |
63 | =pod |
64 | |
65 | =head2 new |
66 | |
67 | Object constructor. |
68 | |
69 | my $schema = SQL::Translator::Schema::Procedure->new; |
70 | |
71 | =cut |
72 | |
2c0b3f9f |
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 | |
4598b71c |
106 | return wantarray ? @{ $self->{'parameters'} || [] } : ($self->{'parameters'} || ''); |
2c0b3f9f |
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 | # ---------------------------------------------------------------------- |
abf315bb |
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; |
deee3ae8 |
256 | my $case_insensitive = shift; |
d1a895ce |
257 | my $ignore_sql = shift; |
abf315bb |
258 | |
259 | return 0 unless $self->SUPER::equals($other); |
deee3ae8 |
260 | return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name; |
261 | |
d1a895ce |
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 | } |
deee3ae8 |
273 | |
4598b71c |
274 | return 0 unless $self->_compare_objects(scalar $self->parameters, scalar $other->parameters); |
abf315bb |
275 | # return 0 unless $self->comments eq $other->comments; |
d1a895ce |
276 | # return 0 unless $case_insensitive ? uc($self->owner) eq uc($other->owner) : $self->owner eq $other->owner; |
4598b71c |
277 | return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra); |
abf315bb |
278 | return 1; |
279 | } |
280 | |
281 | # ---------------------------------------------------------------------- |
2c0b3f9f |
282 | sub DESTROY { |
283 | my $self = shift; |
284 | undef $self->{'schema'}; # destroy cyclical reference |
285 | } |
286 | |
287 | 1; |
288 | |
6606c4c6 |
289 | # ---------------------------------------------------------------------- |
290 | |
2c0b3f9f |
291 | =pod |
292 | |
293 | =head1 AUTHORS |
294 | |
295 | Ken Y. Clark E<lt>kclark@cshl.orgE<gt>, |
296 | Paul Harrington E<lt>Paul-Harrington@deshaw.comE<gt>. |
6606c4c6 |
297 | |
298 | =cut |