Commit | Line | Data |
2c0b3f9f |
1 | package SQL::Translator::Schema::Procedure; |
2 | |
3 | # ---------------------------------------------------------------------- |
6606c4c6 |
4 | # $Id: Procedure.pm,v 1.2 2004-02-09 22:15:15 kycl4rk Exp $ |
2c0b3f9f |
5 | # ---------------------------------------------------------------------- |
6606c4c6 |
6 | # Copyright (C) 2002-4 SQLFairy Authors |
2c0b3f9f |
7 | # |
8 | # This program is free software; you can redistribute it and/or |
9 | # modify it under the terms of the GNU General Public License as |
10 | # published by the Free Software Foundation; version 2. |
11 | # |
12 | # This program is distributed in the hope that it will be useful, but |
13 | # WITHOUT ANY WARRANTY; without even the implied warranty of |
14 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
15 | # General Public License for more details. |
16 | # |
17 | # You should have received a copy of the GNU General Public License |
18 | # along with this program; if not, write to the Free Software |
19 | # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA |
20 | # 02111-1307 USA |
21 | # ------------------------------------------------------------------- |
22 | |
23 | =pod |
24 | |
25 | =head1 NAME |
26 | |
27 | SQL::Translator::Schema::Procedure - SQL::Translator procedure object |
28 | |
29 | =head1 SYNOPSIS |
30 | |
31 | use SQL::Translator::Schema::Procedure; |
32 | my $procedure = SQL::Translator::Schema::Procedure->new( |
33 | name => 'foo', |
34 | sql => 'CREATE PROC foo AS SELECT * FROM bar', |
35 | parameters => 'foo,bar', |
36 | owner => 'nomar', |
37 | comments => 'blah blah blah', |
38 | schema => $schema, |
39 | ); |
40 | |
41 | =head1 DESCRIPTION |
42 | |
43 | C<SQL::Translator::Schema::Procedure> is a class for dealing with |
44 | stored procedures (and possibly other pieces of nameable SQL code?). |
45 | |
46 | =head1 METHODS |
47 | |
48 | =cut |
49 | |
50 | use strict; |
51 | use Class::Base; |
52 | use SQL::Translator::Utils 'parse_list_arg'; |
53 | |
54 | use base 'Class::Base'; |
55 | use vars qw($VERSION); |
56 | |
6606c4c6 |
57 | $VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/; |
2c0b3f9f |
58 | |
59 | # ---------------------------------------------------------------------- |
60 | sub init { |
61 | |
62 | =pod |
63 | |
64 | =head2 new |
65 | |
66 | Object constructor. |
67 | |
68 | my $schema = SQL::Translator::Schema::Procedure->new; |
69 | |
70 | =cut |
71 | |
72 | my ( $self, $config ) = @_; |
73 | |
74 | for my $arg ( qw[ name sql parameters comments owner sql schema ] ) { |
75 | next unless $config->{ $arg }; |
76 | $self->$arg( $config->{ $arg } ) or return; |
77 | } |
78 | |
79 | return $self; |
80 | } |
81 | |
82 | # ---------------------------------------------------------------------- |
83 | sub parameters { |
84 | |
85 | =pod |
86 | |
87 | =head2 parameters |
88 | |
89 | Gets and set the parameters of the stored procedure. |
90 | |
91 | $procedure->parameters('id'); |
92 | $procedure->parameters('id', 'name'); |
93 | $procedure->parameters( 'id, name' ); |
94 | $procedure->parameters( [ 'id', 'name' ] ); |
95 | $procedure->parameters( qw[ id name ] ); |
96 | |
97 | my @parameters = $procedure->parameters; |
98 | |
99 | =cut |
100 | |
101 | my $self = shift; |
102 | my $parameters = parse_list_arg( @_ ); |
103 | |
104 | if ( @$parameters ) { |
105 | my ( %unique, @unique ); |
106 | for my $p ( @$parameters ) { |
107 | next if $unique{ $p }; |
108 | $unique{ $p } = 1; |
109 | push @unique, $p; |
110 | } |
111 | |
112 | $self->{'parameters'} = \@unique; |
113 | } |
114 | |
115 | return wantarray ? @{ $self->{'parameters'} || [] } : $self->{'parameters'}; |
116 | } |
117 | |
118 | # ---------------------------------------------------------------------- |
119 | sub name { |
120 | |
121 | =pod |
122 | |
123 | =head2 name |
124 | |
125 | Get or set the procedure's name. |
126 | |
127 | $procedure->name('foo'); |
128 | my $name = $procedure->name; |
129 | |
130 | =cut |
131 | |
132 | my $self = shift; |
133 | $self->{'name'} = shift if @_; |
134 | return $self->{'name'} || ''; |
135 | } |
136 | |
137 | # ---------------------------------------------------------------------- |
138 | sub sql { |
139 | |
140 | =pod |
141 | |
142 | =head2 sql |
143 | |
144 | Get or set the procedure's SQL. |
145 | |
146 | $procedure->sql('select * from foo'); |
147 | my $sql = $procedure->sql; |
148 | |
149 | =cut |
150 | |
151 | my $self = shift; |
152 | $self->{'sql'} = shift if @_; |
153 | return $self->{'sql'} || ''; |
154 | } |
155 | |
156 | # ---------------------------------------------------------------------- |
157 | sub order { |
158 | |
159 | =pod |
160 | |
161 | =head2 order |
162 | |
163 | Get or set the order of the procedure. |
164 | |
165 | $procedure->order( 3 ); |
166 | my $order = $procedure->order; |
167 | |
168 | =cut |
169 | |
170 | my $self = shift; |
171 | $self->{'order'} = shift if @_; |
172 | return $self->{'order'}; |
173 | } |
174 | |
175 | # ---------------------------------------------------------------------- |
176 | sub owner { |
177 | |
178 | =pod |
179 | |
180 | =head2 owner |
181 | |
182 | Get or set the owner of the procedure. |
183 | |
184 | $procedure->owner('nomar'); |
185 | my $sql = $procedure->owner; |
186 | |
187 | =cut |
188 | |
189 | my $self = shift; |
190 | $self->{'owner'} = shift if @_; |
191 | return $self->{'owner'} || ''; |
192 | } |
193 | |
194 | # ---------------------------------------------------------------------- |
195 | sub comments { |
196 | |
197 | =pod |
198 | |
199 | =head2 comments |
200 | |
201 | Get or set the comments on a procedure. |
202 | |
203 | $procedure->comments('foo'); |
204 | $procedure->comments('bar'); |
205 | print join( ', ', $procedure->comments ); # prints "foo, bar" |
206 | |
207 | =cut |
208 | |
209 | my $self = shift; |
210 | |
211 | for my $arg ( @_ ) { |
212 | $arg = $arg->[0] if ref $arg; |
213 | push @{ $self->{'comments'} }, $arg if $arg; |
214 | } |
215 | |
216 | if ( @{ $self->{'comments'} || [] } ) { |
217 | return wantarray |
218 | ? @{ $self->{'comments'} || [] } |
219 | : join( "\n", @{ $self->{'comments'} || [] } ); |
220 | } |
221 | else { |
222 | return wantarray ? () : ''; |
223 | } |
224 | } |
225 | |
226 | # ---------------------------------------------------------------------- |
227 | sub schema { |
228 | |
229 | =pod |
230 | |
231 | =head2 schema |
232 | |
233 | Get or set the procedures's schema object. |
234 | |
235 | $procedure->schema( $schema ); |
236 | my $schema = $procedure->schema; |
237 | |
238 | =cut |
239 | |
240 | my $self = shift; |
241 | if ( my $arg = shift ) { |
242 | return $self->error('Not a schema object') unless |
243 | UNIVERSAL::isa( $arg, 'SQL::Translator::Schema' ); |
244 | $self->{'schema'} = $arg; |
245 | } |
246 | |
247 | return $self->{'schema'}; |
248 | } |
249 | |
250 | # ---------------------------------------------------------------------- |
251 | sub DESTROY { |
252 | my $self = shift; |
253 | undef $self->{'schema'}; # destroy cyclical reference |
254 | } |
255 | |
256 | 1; |
257 | |
6606c4c6 |
258 | # ---------------------------------------------------------------------- |
259 | |
2c0b3f9f |
260 | =pod |
261 | |
262 | =head1 AUTHORS |
263 | |
264 | Ken Y. Clark E<lt>kclark@cshl.orgE<gt>, |
265 | Paul Harrington E<lt>Paul-Harrington@deshaw.comE<gt>. |
6606c4c6 |
266 | |
267 | =cut |