lib/SQL/Translator/Schema/Procedure.pm

   1 package SQL::Translator::Schema::Procedure;
   2
   3 =pod
   4
   5 =head1 NAME
   6
   7 SQL::Translator::Schema::Procedure - SQL::Translator procedure object
   8
   9 =head1 SYNOPSIS
  10
  11   use SQL::Translator::Schema::Procedure;
  12   my $procedure  = SQL::Translator::Schema::Procedure->new(
  13       name       => 'foo',
  14       sql        => 'CREATE PROC foo AS SELECT * FROM bar',
  15       parameters => 'foo,bar',
  16       owner      => 'nomar',
  17       comments   => 'blah blah blah',
  18       schema     => $schema,
  19   );
  20
  21 =head1 DESCRIPTION
  22
  23 C<SQL::Translator::Schema::Procedure> is a class for dealing with
  24 stored procedures (and possibly other pieces of nameable SQL code?).
  25
  26 =head1 METHODS
  27
  28 =cut
  29
  30 use strict;
  31 use SQL::Translator::Utils 'parse_list_arg';
  32
  33 use base 'SQL::Translator::Schema::Object';
  34
  35 use vars qw($VERSION);
  36
  37 $VERSION = '1.59';
  38
  39 __PACKAGE__->_attributes( qw/
  40     name sql parameters comments owner sql schema order
  41 /);
  42
  43 =pod
  44
  45 =head2 new
  46
  47 Object constructor.
  48
  49   my $schema = SQL::Translator::Schema::Procedure->new;
  50
  51 =cut
  52
  53 sub parameters {
  54
  55 =pod
  56
  57 =head2 parameters
  58
  59 Gets and set the parameters of the stored procedure.
  60
  61   $procedure->parameters('id');
  62   $procedure->parameters('id', 'name');
  63   $procedure->parameters( 'id, name' );
  64   $procedure->parameters( [ 'id', 'name' ] );
  65   $procedure->parameters( qw[ id name ] );
  66
  67   my @parameters = $procedure->parameters;
  68
  69 =cut
  70
  71     my $self   = shift;
  72     my $parameters = parse_list_arg( @_ );
  73
  74     if ( @$parameters ) {
  75         my ( %unique, @unique );
  76         for my $p ( @$parameters ) {
  77             next if $unique{ $p };
  78             $unique{ $p } = 1;
  79             push @unique, $p;
  80         }
  81
  82         $self->{'parameters'} = \@unique;
  83     }
  84
  85     return wantarray ? @{ $self->{'parameters'} || [] } : ($self->{'parameters'} || '');
  86 }
  87
  88 sub name {
  89
  90 =pod
  91
  92 =head2 name
  93
  94 Get or set the procedure's name.
  95
  96   $procedure->name('foo');
  97   my $name = $procedure->name;
  98
  99 =cut
 100
 101     my $self        = shift;
 102     $self->{'name'} = shift if @_;
 103     return $self->{'name'} || '';
 104 }
 105
 106 sub sql {
 107
 108 =pod
 109
 110 =head2 sql
 111
 112 Get or set the procedure's SQL.
 113
 114   $procedure->sql('select * from foo');
 115   my $sql = $procedure->sql;
 116
 117 =cut
 118
 119     my $self       = shift;
 120     $self->{'sql'} = shift if @_;
 121     return $self->{'sql'} || '';
 122 }
 123
 124 sub order {
 125
 126 =pod
 127
 128 =head2 order
 129
 130 Get or set the order of the procedure.
 131
 132   $procedure->order( 3 );
 133   my $order = $procedure->order;
 134
 135 =cut
 136
 137     my $self         = shift;
 138     $self->{'order'} = shift if @_;
 139     return $self->{'order'};
 140 }
 141
 142 sub owner {
 143
 144 =pod
 145
 146 =head2 owner
 147
 148 Get or set the owner of the procedure.
 149
 150   $procedure->owner('nomar');
 151   my $sql = $procedure->owner;
 152
 153 =cut
 154
 155     my $self         = shift;
 156     $self->{'owner'} = shift if @_;
 157     return $self->{'owner'} || '';
 158 }
 159
 160 sub comments {
 161
 162 =pod
 163
 164 =head2 comments
 165
 166 Get or set the comments on a procedure.
 167
 168   $procedure->comments('foo');
 169   $procedure->comments('bar');
 170   print join( ', ', $procedure->comments ); # prints "foo, bar"
 171
 172 =cut
 173
 174     my $self = shift;
 175
 176     for my $arg ( @_ ) {
 177         $arg = $arg->[0] if ref $arg;
 178         push @{ $self->{'comments'} }, $arg if $arg;
 179     }
 180
 181     if ( @{ $self->{'comments'} || [] } ) {
 182         return wantarray
 183             ? @{ $self->{'comments'} || [] }
 184             : join( "\n", @{ $self->{'comments'} || [] } );
 185     }
 186     else {
 187         return wantarray ? () : '';
 188     }
 189 }
 190
 191 sub schema {
 192
 193 =pod
 194
 195 =head2 schema
 196
 197 Get or set the procedures's schema object.
 198
 199   $procedure->schema( $schema );
 200   my $schema = $procedure->schema;
 201
 202 =cut
 203
 204     my $self = shift;
 205     if ( my $arg = shift ) {
 206         return $self->error('Not a schema object') unless
 207             UNIVERSAL::isa( $arg, 'SQL::Translator::Schema' );
 208         $self->{'schema'} = $arg;
 209     }
 210
 211     return $self->{'schema'};
 212 }
 213
 214 sub equals {
 215
 216 =pod
 217
 218 =head2 equals
 219
 220 Determines if this procedure is the same as another
 221
 222   my $isIdentical = $procedure1->equals( $procedure2 );
 223
 224 =cut
 225
 226     my $self = shift;
 227     my $other = shift;
 228     my $case_insensitive = shift;
 229     my $ignore_sql = shift;
 230
 231     return 0 unless $self->SUPER::equals($other);
 232     return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
 233
 234     unless ($ignore_sql) {
 235         my $selfSql = $self->sql;
 236         my $otherSql = $other->sql;
 237         # Remove comments
 238         $selfSql =~ s/--.*$//mg;
 239         $otherSql =~ s/--.*$//mg;
 240         # Collapse whitespace to space to avoid whitespace comparison issues
 241         $selfSql =~ s/\s+/ /sg;
 242         $otherSql =~ s/\s+/ /sg;
 243         return 0 unless $selfSql eq $otherSql;
 244     }
 245
 246     return 0 unless $self->_compare_objects(scalar $self->parameters, scalar $other->parameters);
 247 #    return 0 unless $self->comments eq $other->comments;
 248 #    return 0 unless $case_insensitive ? uc($self->owner) eq uc($other->owner) : $self->owner eq $other->owner;
 249     return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
 250     return 1;
 251 }
 252
 253 sub DESTROY {
 254     my $self = shift;
 255     undef $self->{'schema'}; # destroy cyclical reference
 256 }
 257
 258 1;
 259
 260 =pod
 261
 262 =head1 AUTHORS
 263
 264 Ken Youens-Clark E<lt>kclark@cshl.orgE<gt>,
 265 Paul Harrington E<lt>Paul-Harrington@deshaw.comE<gt>.
 266
 267 =cut