1 package SQL::Translator::Schema::Procedure;
3 # ----------------------------------------------------------------------
4 # $Id: Procedure.pm,v 1.5 2005-06-27 21:59:20 duality72 Exp $
5 # ----------------------------------------------------------------------
6 # Copyright (C) 2002-4 SQLFairy Authors
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.
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.
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
21 # -------------------------------------------------------------------
27 SQL::Translator::Schema::Procedure - SQL::Translator procedure object
31 use SQL::Translator::Schema::Procedure;
32 my $procedure = SQL::Translator::Schema::Procedure->new(
34 sql => 'CREATE PROC foo AS SELECT * FROM bar',
35 parameters => 'foo,bar',
37 comments => 'blah blah blah',
43 C<SQL::Translator::Schema::Procedure> is a class for dealing with
44 stored procedures (and possibly other pieces of nameable SQL code?).
51 use SQL::Translator::Utils 'parse_list_arg';
53 use base 'SQL::Translator::Schema::Object';
55 use vars qw($VERSION);
57 $VERSION = sprintf "%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/;
59 # ----------------------------------------------------------------------
61 __PACKAGE__->_attributes( qw/
62 name sql parameters comments owner sql schema order
71 my $schema = SQL::Translator::Schema::Procedure->new;
75 # ----------------------------------------------------------------------
82 Gets and set the parameters of the stored procedure.
84 $procedure->parameters('id');
85 $procedure->parameters('id', 'name');
86 $procedure->parameters( 'id, name' );
87 $procedure->parameters( [ 'id', 'name' ] );
88 $procedure->parameters( qw[ id name ] );
90 my @parameters = $procedure->parameters;
95 my $parameters = parse_list_arg( @_ );
98 my ( %unique, @unique );
99 for my $p ( @$parameters ) {
100 next if $unique{ $p };
105 $self->{'parameters'} = \@unique;
108 return wantarray ? @{ $self->{'parameters'} || [] } : $self->{'parameters'};
111 # ----------------------------------------------------------------------
118 Get or set the procedure's name.
120 $procedure->name('foo');
121 my $name = $procedure->name;
126 $self->{'name'} = shift if @_;
127 return $self->{'name'} || '';
130 # ----------------------------------------------------------------------
137 Get or set the procedure's SQL.
139 $procedure->sql('select * from foo');
140 my $sql = $procedure->sql;
145 $self->{'sql'} = shift if @_;
146 return $self->{'sql'} || '';
149 # ----------------------------------------------------------------------
156 Get or set the order of the procedure.
158 $procedure->order( 3 );
159 my $order = $procedure->order;
164 $self->{'order'} = shift if @_;
165 return $self->{'order'};
168 # ----------------------------------------------------------------------
175 Get or set the owner of the procedure.
177 $procedure->owner('nomar');
178 my $sql = $procedure->owner;
183 $self->{'owner'} = shift if @_;
184 return $self->{'owner'} || '';
187 # ----------------------------------------------------------------------
194 Get or set the comments on a procedure.
196 $procedure->comments('foo');
197 $procedure->comments('bar');
198 print join( ', ', $procedure->comments ); # prints "foo, bar"
205 $arg = $arg->[0] if ref $arg;
206 push @{ $self->{'comments'} }, $arg if $arg;
209 if ( @{ $self->{'comments'} || [] } ) {
211 ? @{ $self->{'comments'} || [] }
212 : join( "\n", @{ $self->{'comments'} || [] } );
215 return wantarray ? () : '';
219 # ----------------------------------------------------------------------
226 Get or set the procedures's schema object.
228 $procedure->schema( $schema );
229 my $schema = $procedure->schema;
234 if ( my $arg = shift ) {
235 return $self->error('Not a schema object') unless
236 UNIVERSAL::isa( $arg, 'SQL::Translator::Schema' );
237 $self->{'schema'} = $arg;
240 return $self->{'schema'};
243 # ----------------------------------------------------------------------
250 Determines if this procedure is the same as another
252 my $isIdentical = $procedure1->equals( $procedure2 );
259 return 0 unless $self->SUPER::equals($other);
260 return 0 unless $self->name eq $other->name;
261 return 0 unless $self->sql eq $other->sql;
262 return 0 unless $self->_compare_objects($self->parameters, $other->parameters);
263 # return 0 unless $self->comments eq $other->comments;
264 return 0 unless $self->owner eq $other->owner;
265 return 0 unless $self->_compare_objects($self->extra, $other->extra);
269 # ----------------------------------------------------------------------
272 undef $self->{'schema'}; # destroy cyclical reference
277 # ----------------------------------------------------------------------
283 Ken Y. Clark E<lt>kclark@cshl.orgE<gt>,
284 Paul Harrington E<lt>Paul-Harrington@deshaw.comE<gt>.