lib/SQL/Translator/Schema/Procedure.pm

   1 package SQL::Translator::Schema::Procedure;
   2
   3 # ----------------------------------------------------------------------
   4 # $Id: Procedure.pm,v 1.8 2007-03-21 15:20:50 duality72 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 SQL::Translator::Utils 'parse_list_arg';
  52
  53 use base 'SQL::Translator::Schema::Object';
  54
  55 use vars qw($VERSION);
  56
  57 $VERSION = sprintf "%d.%02d", q$Revision: 1.8 $ =~ /(\d+)\.(\d+)/;
  58
  59 # ----------------------------------------------------------------------
  60
  61 __PACKAGE__->_attributes( qw/
  62     name sql parameters comments owner sql schema order
  63 /);
  64
  65 =pod
  66
  67 =head2 new
  68
  69 Object constructor.
  70
  71   my $schema = SQL::Translator::Schema::Procedure->new;
  72
  73 =cut
  74
  75 # ----------------------------------------------------------------------
  76 sub parameters {
  77
  78 =pod
  79
  80 =head2 parameters
  81
  82 Gets and set the parameters of the stored procedure.
  83
  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 ] );
  89
  90   my @parameters = $procedure->parameters;
  91
  92 =cut
  93
  94     my $self   = shift;
  95     my $parameters = parse_list_arg( @_ );
  96
  97     if ( @$parameters ) {
  98         my ( %unique, @unique );
  99         for my $p ( @$parameters ) {
 100             next if $unique{ $p };
 101             $unique{ $p } = 1;
 102             push @unique, $p;
 103         }
 104
 105         $self->{'parameters'} = \@unique;
 106     }
 107
 108     return wantarray ? @{ $self->{'parameters'} || [] } : ($self->{'parameters'} || '');
 109 }
 110
 111 # ----------------------------------------------------------------------
 112 sub name {
 113
 114 =pod
 115
 116 =head2 name
 117
 118 Get or set the procedure's name.
 119
 120   $procedure->name('foo');
 121   my $name = $procedure->name;
 122
 123 =cut
 124
 125     my $self        = shift;
 126     $self->{'name'} = shift if @_;
 127     return $self->{'name'} || '';
 128 }
 129
 130 # ----------------------------------------------------------------------
 131 sub sql {
 132
 133 =pod
 134
 135 =head2 sql
 136
 137 Get or set the procedure's SQL.
 138
 139   $procedure->sql('select * from foo');
 140   my $sql = $procedure->sql;
 141
 142 =cut
 143
 144     my $self       = shift;
 145     $self->{'sql'} = shift if @_;
 146     return $self->{'sql'} || '';
 147 }
 148
 149 # ----------------------------------------------------------------------
 150 sub order {
 151
 152 =pod
 153
 154 =head2 order
 155
 156 Get or set the order of the procedure.
 157
 158   $procedure->order( 3 );
 159   my $order = $procedure->order;
 160
 161 =cut
 162
 163     my $self         = shift;
 164     $self->{'order'} = shift if @_;
 165     return $self->{'order'};
 166 }
 167
 168 # ----------------------------------------------------------------------
 169 sub owner {
 170
 171 =pod
 172
 173 =head2 owner
 174
 175 Get or set the owner of the procedure.
 176
 177   $procedure->owner('nomar');
 178   my $sql = $procedure->owner;
 179
 180 =cut
 181
 182     my $self         = shift;
 183     $self->{'owner'} = shift if @_;
 184     return $self->{'owner'} || '';
 185 }
 186
 187 # ----------------------------------------------------------------------
 188 sub comments {
 189
 190 =pod
 191
 192 =head2 comments
 193
 194 Get or set the comments on a procedure.
 195
 196   $procedure->comments('foo');
 197   $procedure->comments('bar');
 198   print join( ', ', $procedure->comments ); # prints "foo, bar"
 199
 200 =cut
 201
 202     my $self = shift;
 203
 204     for my $arg ( @_ ) {
 205         $arg = $arg->[0] if ref $arg;
 206         push @{ $self->{'comments'} }, $arg if $arg;
 207     }
 208
 209     if ( @{ $self->{'comments'} || [] } ) {
 210         return wantarray
 211             ? @{ $self->{'comments'} || [] }
 212             : join( "\n", @{ $self->{'comments'} || [] } );
 213     }
 214     else {
 215         return wantarray ? () : '';
 216     }
 217 }
 218
 219 # ----------------------------------------------------------------------
 220 sub schema {
 221
 222 =pod
 223
 224 =head2 schema
 225
 226 Get or set the procedures's schema object.
 227
 228   $procedure->schema( $schema );
 229   my $schema = $procedure->schema;
 230
 231 =cut
 232
 233     my $self = shift;
 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;
 238     }
 239
 240     return $self->{'schema'};
 241 }
 242
 243 # ----------------------------------------------------------------------
 244 sub equals {
 245
 246 =pod
 247
 248 =head2 equals
 249
 250 Determines if this procedure is the same as another
 251
 252   my $isIdentical = $procedure1->equals( $procedure2 );
 253
 254 =cut
 255
 256     my $self = shift;
 257     my $other = shift;
 258     my $case_insensitive = shift;
 259     my $ignore_sql = shift;
 260
 261     return 0 unless $self->SUPER::equals($other);
 262     return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
 263
 264     unless ($ignore_sql) {
 265         my $selfSql = $self->sql;
 266         my $otherSql = $other->sql;
 267         # Remove comments
 268         $selfSql =~ s/--.*$//mg;
 269         $otherSql =~ s/--.*$//mg;
 270         # Collapse whitespace to space to avoid whitespace comparison issues
 271         $selfSql =~ s/\s+/ /sg;
 272         $otherSql =~ s/\s+/ /sg;
 273         return 0 unless $selfSql eq $otherSql;
 274     }
 275
 276     return 0 unless $self->_compare_objects(scalar $self->parameters, scalar $other->parameters);
 277 #    return 0 unless $self->comments eq $other->comments;
 278 #    return 0 unless $case_insensitive ? uc($self->owner) eq uc($other->owner) : $self->owner eq $other->owner;
 279     return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
 280     return 1;
 281 }
 282
 283 # ----------------------------------------------------------------------
 284 sub DESTROY {
 285     my $self = shift;
 286     undef $self->{'schema'}; # destroy cyclical reference
 287 }
 288
 289 1;
 290
 291 # ----------------------------------------------------------------------
 292
 293 =pod
 294
 295 =head1 AUTHORS
 296
 297 Ken Y. Clark E<lt>kclark@cshl.orgE<gt>,
 298 Paul Harrington E<lt>Paul-Harrington@deshaw.comE<gt>.
 299
 300 =cut