Added a little to the POD to explain version dependency.
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Schema / Procedure.pm
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>.