lib/SQL/Translator/Schema/Procedure.pm

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