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