1 package SQL::Translator::Schema::Procedure;
7 SQL::Translator::Schema::Procedure - SQL::Translator procedure object
11 use SQL::Translator::Schema::Procedure;
12 my $procedure = SQL::Translator::Schema::Procedure->new(
14 sql => 'CREATE PROC foo AS SELECT * FROM bar',
15 parameters => 'foo,bar',
17 comments => 'blah blah blah',
23 C<SQL::Translator::Schema::Procedure> is a class for dealing with
24 stored procedures (and possibly other pieces of nameable SQL code?).
31 use SQL::Translator::Utils qw(parse_list_arg ex2err);
32 use SQL::Translator::Types qw(schema_obj);
33 use List::MoreUtils qw(uniq);
36 SQL::Translator::Role::Error
37 SQL::Translator::Role::BuildArgs
38 SQL::Translator::Schema::Role::Extra
39 SQL::Translator::Schema::Role::Compare
42 our $VERSION = '1.59';
48 my $schema = SQL::Translator::Schema::Procedure->new;
54 Gets and set the parameters of the stored procedure.
56 $procedure->parameters('id');
57 $procedure->parameters('id', 'name');
58 $procedure->parameters( 'id, name' );
59 $procedure->parameters( [ 'id', 'name' ] );
60 $procedure->parameters( qw[ id name ] );
62 my @parameters = $procedure->parameters;
68 default => sub { [] },
69 coerce => sub { [uniq @{parse_list_arg($_[0])}] },
72 around parameters => sub {
75 my $fields = parse_list_arg( @_ );
76 $self->$orig($fields) if @$fields;
78 return wantarray ? @{ $self->$orig } : $self->$orig;
83 Get or set the procedure's name.
85 $procedure->name('foo');
86 my $name = $procedure->name;
90 has name => ( is => 'rw', default => sub { '' } );
94 Get or set the procedure's SQL.
96 $procedure->sql('select * from foo');
97 my $sql = $procedure->sql;
101 has sql => ( is => 'rw', default => sub { '' } );
105 Get or set the order of the procedure.
107 $procedure->order( 3 );
108 my $order = $procedure->order;
112 has order => ( is => 'rw' );
117 Get or set the owner of the procedure.
119 $procedure->owner('nomar');
120 my $sql = $procedure->owner;
124 has owner => ( is => 'rw', default => sub { '' } );
128 Get or set the comments on a procedure.
130 $procedure->comments('foo');
131 $procedure->comments('bar');
132 print join( ', ', $procedure->comments ); # prints "foo, bar"
138 coerce => sub { ref($_[0]) eq 'ARRAY' ? $_[0] : [$_[0]] },
139 default => sub { [] },
142 around comments => sub {
145 my @comments = ref $_[0] ? @{ $_[0] } : @_;
147 for my $arg ( @comments ) {
148 $arg = $arg->[0] if ref $arg;
149 push @{ $self->$orig }, $arg if defined $arg && $arg;
152 return wantarray ? @{ $self->$orig } : join( "\n", @{ $self->$orig } );
157 Get or set the procedures's schema object.
159 $procedure->schema( $schema );
160 my $schema = $procedure->schema;
164 has schema => ( is => 'rw', isa => schema_obj('Schema'), weak_ref => 1 );
166 around schema => \&ex2err;
170 Determines if this procedure is the same as another
172 my $isIdentical = $procedure1->equals( $procedure2 );
176 around equals => sub {
180 my $case_insensitive = shift;
181 my $ignore_sql = shift;
183 return 0 unless $self->$orig($other);
184 return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
186 unless ($ignore_sql) {
187 my $selfSql = $self->sql;
188 my $otherSql = $other->sql;
190 $selfSql =~ s/--.*$//mg;
191 $otherSql =~ s/--.*$//mg;
192 # Collapse whitespace to space to avoid whitespace comparison issues
193 $selfSql =~ s/\s+/ /sg;
194 $otherSql =~ s/\s+/ /sg;
195 return 0 unless $selfSql eq $otherSql;
198 return 0 unless $self->_compare_objects(scalar $self->parameters, scalar $other->parameters);
199 # return 0 unless $self->comments eq $other->comments;
200 # return 0 unless $case_insensitive ? uc($self->owner) eq uc($other->owner) : $self->owner eq $other->owner;
201 return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
205 # Must come after all 'has' declarations
206 around new => \&ex2err;
214 Ken Youens-Clark E<lt>kclark@cshl.orgE<gt>,
215 Paul Harrington E<lt>Paul-Harrington@deshaw.comE<gt>.