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