From: Ken Youens-Clark Date: Wed, 8 Oct 2003 17:31:24 +0000 (+0000) Subject: Adding Paul's Procedure class. X-Git-Tag: v0.04~116 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2c0b3f9f5158b8b9f29f72aa3a7ef0c7af7a0888;p=dbsrgits%2FSQL-Translator.git Adding Paul's Procedure class. --- diff --git a/lib/SQL/Translator/Schema/Procedure.pm b/lib/SQL/Translator/Schema/Procedure.pm new file mode 100644 index 0000000..c3b5a27 --- /dev/null +++ b/lib/SQL/Translator/Schema/Procedure.pm @@ -0,0 +1,264 @@ +package SQL::Translator::Schema::Procedure; + +# ---------------------------------------------------------------------- +# $Id: Procedure.pm,v 1.1 2003-10-08 17:31:24 kycl4rk Exp $ +# ---------------------------------------------------------------------- +# Copyright (C) 2003 Ken Y. Clark , +# Paul Harrington . +# +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License as +# published by the Free Software Foundation; version 2. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA +# 02111-1307 USA +# ------------------------------------------------------------------- + +=pod + +=head1 NAME + +SQL::Translator::Schema::Procedure - SQL::Translator procedure object + +=head1 SYNOPSIS + + use SQL::Translator::Schema::Procedure; + my $procedure = SQL::Translator::Schema::Procedure->new( + name => 'foo', + sql => 'CREATE PROC foo AS SELECT * FROM bar', + parameters => 'foo,bar', + owner => 'nomar', + comments => 'blah blah blah', + schema => $schema, + ); + +=head1 DESCRIPTION + +C is a class for dealing with +stored procedures (and possibly other pieces of nameable SQL code?). + +=head1 METHODS + +=cut + +use strict; +use Class::Base; +use SQL::Translator::Utils 'parse_list_arg'; + +use base 'Class::Base'; +use vars qw($VERSION); + +$VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/; + +# ---------------------------------------------------------------------- +sub init { + +=pod + +=head2 new + +Object constructor. + + my $schema = SQL::Translator::Schema::Procedure->new; + +=cut + + my ( $self, $config ) = @_; + + for my $arg ( qw[ name sql parameters comments owner sql schema ] ) { + next unless $config->{ $arg }; + $self->$arg( $config->{ $arg } ) or return; + } + + return $self; +} + +# ---------------------------------------------------------------------- +sub parameters { + +=pod + +=head2 parameters + +Gets and set the parameters of the stored procedure. + + $procedure->parameters('id'); + $procedure->parameters('id', 'name'); + $procedure->parameters( 'id, name' ); + $procedure->parameters( [ 'id', 'name' ] ); + $procedure->parameters( qw[ id name ] ); + + my @parameters = $procedure->parameters; + +=cut + + my $self = shift; + my $parameters = parse_list_arg( @_ ); + + if ( @$parameters ) { + my ( %unique, @unique ); + for my $p ( @$parameters ) { + next if $unique{ $p }; + $unique{ $p } = 1; + push @unique, $p; + } + + $self->{'parameters'} = \@unique; + } + + return wantarray ? @{ $self->{'parameters'} || [] } : $self->{'parameters'}; +} + +# ---------------------------------------------------------------------- +sub name { + +=pod + +=head2 name + +Get or set the procedure's name. + + $procedure->name('foo'); + my $name = $procedure->name; + +=cut + + my $self = shift; + $self->{'name'} = shift if @_; + return $self->{'name'} || ''; +} + +# ---------------------------------------------------------------------- +sub sql { + +=pod + +=head2 sql + +Get or set the procedure's SQL. + + $procedure->sql('select * from foo'); + my $sql = $procedure->sql; + +=cut + + my $self = shift; + $self->{'sql'} = shift if @_; + return $self->{'sql'} || ''; +} + +# ---------------------------------------------------------------------- +sub order { + +=pod + +=head2 order + +Get or set the order of the procedure. + + $procedure->order( 3 ); + my $order = $procedure->order; + +=cut + + my $self = shift; + $self->{'order'} = shift if @_; + return $self->{'order'}; +} + +# ---------------------------------------------------------------------- +sub owner { + +=pod + +=head2 owner + +Get or set the owner of the procedure. + + $procedure->owner('nomar'); + my $sql = $procedure->owner; + +=cut + + my $self = shift; + $self->{'owner'} = shift if @_; + return $self->{'owner'} || ''; +} + +# ---------------------------------------------------------------------- +sub comments { + +=pod + +=head2 comments + +Get or set the comments on a procedure. + + $procedure->comments('foo'); + $procedure->comments('bar'); + print join( ', ', $procedure->comments ); # prints "foo, bar" + +=cut + + my $self = shift; + + for my $arg ( @_ ) { + $arg = $arg->[0] if ref $arg; + push @{ $self->{'comments'} }, $arg if $arg; + } + + if ( @{ $self->{'comments'} || [] } ) { + return wantarray + ? @{ $self->{'comments'} || [] } + : join( "\n", @{ $self->{'comments'} || [] } ); + } + else { + return wantarray ? () : ''; + } +} + +# ---------------------------------------------------------------------- +sub schema { + +=pod + +=head2 schema + +Get or set the procedures's schema object. + + $procedure->schema( $schema ); + my $schema = $procedure->schema; + +=cut + + my $self = shift; + if ( my $arg = shift ) { + return $self->error('Not a schema object') unless + UNIVERSAL::isa( $arg, 'SQL::Translator::Schema' ); + $self->{'schema'} = $arg; + } + + return $self->{'schema'}; +} + +# ---------------------------------------------------------------------- +sub DESTROY { + my $self = shift; + undef $self->{'schema'}; # destroy cyclical reference +} + +1; + +=pod + +=head1 AUTHORS + +Ken Y. Clark Ekclark@cshl.orgE, +Paul Harrington EPaul-Harrington@deshaw.comE.