lib/SQL/Translator/Schema/Procedure.pm

   1 package SQL::Translator::Schema::Procedure;
   2
   3 # ----------------------------------------------------------------------
   4 # $Id: Procedure.pm,v 1.2 2004-02-09 22:15:15 kycl4rk Exp $
   5 # ----------------------------------------------------------------------
   6 # Copyright (C) 2002-4 SQLFairy Authors
   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
  57 $VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/;
  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
 258 # ----------------------------------------------------------------------
 259
 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>.
 266
 267 =cut