Allow passing an arrayref to SQLT->filename
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Schema / Procedure.pm
CommitLineData
2c0b3f9f 1package SQL::Translator::Schema::Procedure;
2
2c0b3f9f 3=pod
4
5=head1 NAME
6
7SQL::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
23C<SQL::Translator::Schema::Procedure> is a class for dealing with
24stored procedures (and possibly other pieces of nameable SQL code?).
25
26=head1 METHODS
27
28=cut
29
90097ddd 30use Moo;
0fb58589 31use SQL::Translator::Utils qw(ex2err);
32use SQL::Translator::Role::ListAttr;
dee11153 33use SQL::Translator::Types qw(schema_obj);
68d75205 34use Sub::Quote qw(quote_sub);
2c0b3f9f 35
954ed12e 36extends 'SQL::Translator::Schema::Object';
b6a880d1 37
0c04c5a2 38our $VERSION = '1.59';
da06ac74 39
2c0b3f9f 40=head2 new
41
42Object constructor.
43
44 my $schema = SQL::Translator::Schema::Procedure->new;
45
46=cut
47
2c0b3f9f 48=head2 parameters
49
50Gets and set the parameters of the stored procedure.
51
52 $procedure->parameters('id');
53 $procedure->parameters('id', 'name');
54 $procedure->parameters( 'id, name' );
55 $procedure->parameters( [ 'id', 'name' ] );
56 $procedure->parameters( qw[ id name ] );
57
58 my @parameters = $procedure->parameters;
59
60=cut
61
0fb58589 62with ListAttr parameters => ( uniq => 1 );
2c0b3f9f 63
64=head2 name
65
66Get or set the procedure's name.
67
68 $procedure->name('foo');
69 my $name = $procedure->name;
70
71=cut
72
68d75205 73has name => ( is => 'rw', default => quote_sub(q{ '' }) );
2c0b3f9f 74
75=head2 sql
76
77Get or set the procedure's SQL.
78
79 $procedure->sql('select * from foo');
80 my $sql = $procedure->sql;
81
82=cut
83
68d75205 84has sql => ( is => 'rw', default => quote_sub(q{ '' }) );
2c0b3f9f 85
86=head2 order
87
88Get or set the order of the procedure.
89
90 $procedure->order( 3 );
91 my $order = $procedure->order;
92
93=cut
94
dee11153 95has order => ( is => 'rw' );
2c0b3f9f 96
2c0b3f9f 97
98=head2 owner
99
100Get or set the owner of the procedure.
101
102 $procedure->owner('nomar');
103 my $sql = $procedure->owner;
104
105=cut
106
68d75205 107has owner => ( is => 'rw', default => quote_sub(q{ '' }) );
2c0b3f9f 108
109=head2 comments
110
111Get or set the comments on a procedure.
112
113 $procedure->comments('foo');
114 $procedure->comments('bar');
115 print join( ', ', $procedure->comments ); # prints "foo, bar"
116
117=cut
118
dee11153 119has comments => (
120 is => 'rw',
c804300c 121 coerce => quote_sub(q{ ref($_[0]) eq 'ARRAY' ? $_[0] : [$_[0]] }),
68d75205 122 default => quote_sub(q{ [] }),
dee11153 123);
2c0b3f9f 124
dee11153 125around comments => sub {
126 my $orig = shift;
127 my $self = shift;
128 my @comments = ref $_[0] ? @{ $_[0] } : @_;
2c0b3f9f 129
dee11153 130 for my $arg ( @comments ) {
131 $arg = $arg->[0] if ref $arg;
132 push @{ $self->$orig }, $arg if defined $arg && $arg;
2c0b3f9f 133 }
2c0b3f9f 134
dee11153 135 return wantarray ? @{ $self->$orig } : join( "\n", @{ $self->$orig } );
136};
2c0b3f9f 137
138=head2 schema
139
140Get or set the procedures's schema object.
141
142 $procedure->schema( $schema );
143 my $schema = $procedure->schema;
144
145=cut
146
a5bfeba8 147has schema => ( is => 'rw', isa => schema_obj('Schema'), weak_ref => 1 );
2c0b3f9f 148
dee11153 149around schema => \&ex2err;
abf315bb 150
151=head2 equals
152
153Determines if this procedure is the same as another
154
155 my $isIdentical = $procedure1->equals( $procedure2 );
156
157=cut
158
dee11153 159around equals => sub {
160 my $orig = shift;
abf315bb 161 my $self = shift;
162 my $other = shift;
deee3ae8 163 my $case_insensitive = shift;
d1a895ce 164 my $ignore_sql = shift;
ea93df61 165
dee11153 166 return 0 unless $self->$orig($other);
deee3ae8 167 return 0 unless $case_insensitive ? uc($self->name) eq uc($other->name) : $self->name eq $other->name;
ea93df61 168
d1a895ce 169 unless ($ignore_sql) {
170 my $selfSql = $self->sql;
171 my $otherSql = $other->sql;
172 # Remove comments
173 $selfSql =~ s/--.*$//mg;
174 $otherSql =~ s/--.*$//mg;
175 # Collapse whitespace to space to avoid whitespace comparison issues
176 $selfSql =~ s/\s+/ /sg;
177 $otherSql =~ s/\s+/ /sg;
178 return 0 unless $selfSql eq $otherSql;
179 }
ea93df61 180
4598b71c 181 return 0 unless $self->_compare_objects(scalar $self->parameters, scalar $other->parameters);
abf315bb 182# return 0 unless $self->comments eq $other->comments;
d1a895ce 183# return 0 unless $case_insensitive ? uc($self->owner) eq uc($other->owner) : $self->owner eq $other->owner;
4598b71c 184 return 0 unless $self->_compare_objects(scalar $self->extra, scalar $other->extra);
abf315bb 185 return 1;
dee11153 186};
abf315bb 187
dee11153 188# Must come after all 'has' declarations
189around new => \&ex2err;
190
2c0b3f9f 1911;
192
193=pod
194
195=head1 AUTHORS
196
c3b0b535 197Ken Youens-Clark E<lt>kclark@cshl.orgE<gt>,
2c0b3f9f 198Paul Harrington E<lt>Paul-Harrington@deshaw.comE<gt>.
6606c4c6 199
200=cut