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