Commit | Line | Data |
3c5de62a |
1 | package SQL::Translator::Schema::Index; |
2 | |
3 | # ---------------------------------------------------------------------- |
25868dc9 |
4 | # $Id: Index.pm,v 1.3 2003-05-09 17:09:43 kycl4rk Exp $ |
3c5de62a |
5 | # ---------------------------------------------------------------------- |
6 | # Copyright (C) 2003 Ken Y. Clark <kclark@cpan.org> |
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::Index - SQL::Translator index object |
28 | |
29 | =head1 SYNOPSIS |
30 | |
31 | use SQL::Translator::Schema::Index; |
32 | my $index = SQL::Translator::Schema::Index->new( |
33 | name => 'foo', |
34 | fields => [ id ], |
35 | type => 'unique', |
36 | ); |
37 | |
38 | =head1 DESCRIPTION |
39 | |
40 | C<SQL::Translator::Schema::Index> is the index object. |
41 | |
42 | Primary keys will be considered table constraints, not indices. |
43 | |
44 | =head1 METHODS |
45 | |
46 | =cut |
47 | |
48 | use strict; |
49 | use Class::Base; |
25868dc9 |
50 | use SQL::Translator::Schema::Constants; |
51 | use SQL::Translator::Utils 'parse_list_arg'; |
3c5de62a |
52 | |
53 | use base 'Class::Base'; |
54 | use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT); |
55 | |
56 | $VERSION = 1.00; |
57 | |
58 | use constant VALID_TYPE => { |
25868dc9 |
59 | UNIQUE, 1, |
60 | NORMAL, 1, |
61 | FULL_TEXT, 1, # MySQL only (?) |
3c5de62a |
62 | }; |
63 | |
64 | # ---------------------------------------------------------------------- |
65 | sub init { |
66 | |
67 | =pod |
68 | |
69 | =head2 new |
70 | |
71 | Object constructor. |
72 | |
73 | my $schema = SQL::Translator::Schema::Index->new; |
74 | |
75 | =cut |
76 | |
77 | my ( $self, $config ) = @_; |
25868dc9 |
78 | |
79 | for my $arg ( qw[ name type fields table ] ) { |
3c5de62a |
80 | next unless $config->{ $arg }; |
81 | $self->$arg( $config->{ $arg } ) or return; |
82 | } |
25868dc9 |
83 | |
3c5de62a |
84 | return $self; |
85 | } |
86 | |
87 | # ---------------------------------------------------------------------- |
88 | sub fields { |
89 | |
90 | =pod |
91 | |
92 | =head2 fields |
93 | |
25868dc9 |
94 | Gets and set the fields the constraint is on. Accepts a string, list or |
95 | arrayref; returns an array or array reference. Will unique the field |
96 | names and keep them in order by the first occurrence of a field name. |
3c5de62a |
97 | |
25868dc9 |
98 | $constraint->fields('id'); |
99 | $constraint->fields('id', 'name'); |
100 | $constraint->fields( 'id, name' ); |
101 | $constraint->fields( [ 'id', 'name' ] ); |
102 | $constraint->fields( qw[ id name ] ); |
103 | |
104 | my @fields = $constraint->fields; |
3c5de62a |
105 | |
106 | =cut |
107 | |
108 | my $self = shift; |
25868dc9 |
109 | my $fields = parse_list_arg( @_ ); |
3c5de62a |
110 | |
111 | if ( @$fields ) { |
25868dc9 |
112 | my ( %unique, @unique ); |
113 | for my $f ( @$fields ) { |
114 | next if $unique{ $f }; |
115 | $unique{ $f } = 1; |
116 | push @unique, $f; |
117 | } |
118 | |
119 | $self->{'fields'} = \@unique; |
3c5de62a |
120 | } |
121 | |
122 | return wantarray ? @{ $self->{'fields'} || [] } : $self->{'fields'}; |
123 | } |
124 | |
125 | # ---------------------------------------------------------------------- |
126 | sub name { |
127 | |
128 | =pod |
129 | |
130 | =head2 name |
131 | |
132 | Get or set the index's name. |
133 | |
134 | my $name = $index->name('foo'); |
135 | |
136 | =cut |
137 | |
138 | my $self = shift; |
139 | $self->{'name'} = shift if @_; |
140 | return $self->{'name'} || ''; |
141 | } |
142 | |
143 | # ---------------------------------------------------------------------- |
25868dc9 |
144 | sub options { |
145 | |
146 | =pod |
147 | |
148 | =head2 options |
149 | |
150 | Get or set the index's options (e.g., "using" or "where" for PG). Returns |
151 | an array or array reference. |
152 | |
153 | my @options = $index->options; |
154 | |
155 | =cut |
156 | |
157 | my $self = shift; |
158 | my $options = parse_list_arg( @_ ); |
159 | |
160 | push @{ $self->{'options'} }, @$options; |
161 | |
162 | if ( ref $self->{'options'} ) { |
163 | return wantarray ? @{ $self->{'options'} || [] } : $self->{'options'}; |
164 | } |
165 | else { |
166 | return wantarray ? () : []; |
167 | } |
168 | } |
169 | |
170 | # ---------------------------------------------------------------------- |
43b9dc7a |
171 | sub table { |
172 | |
173 | =pod |
174 | |
175 | =head2 table |
176 | |
177 | Get or set the index's table object. |
178 | |
179 | my $table = $index->table; |
180 | |
181 | =cut |
182 | |
183 | my $self = shift; |
184 | if ( my $arg = shift ) { |
185 | return $self->error('Not a table object') unless |
186 | UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' ); |
187 | $self->{'table'} = $arg; |
188 | } |
189 | |
190 | return $self->{'table'}; |
191 | } |
192 | |
193 | # ---------------------------------------------------------------------- |
3c5de62a |
194 | sub type { |
195 | |
196 | =pod |
197 | |
198 | =head2 type |
199 | |
200 | Get or set the index's type. |
201 | |
202 | my $type = $index->type('unique'); |
203 | |
204 | =cut |
205 | |
206 | my $self = shift; |
207 | |
208 | if ( my $type = shift ) { |
209 | return $self->error("Invalid index type: $type") |
210 | unless VALID_TYPE->{ $type }; |
211 | $self->{'type'} = $type; |
212 | } |
213 | |
25868dc9 |
214 | return $self->{'type'} || NORMAL; |
3c5de62a |
215 | } |
216 | |
217 | |
218 | # ---------------------------------------------------------------------- |
219 | sub is_valid { |
220 | |
221 | =pod |
222 | |
223 | =head2 is_valid |
224 | |
225 | Determine whether the index is valid or not. |
226 | |
227 | my $ok = $index->is_valid; |
228 | |
229 | =cut |
230 | |
25868dc9 |
231 | my $self = shift; |
232 | my $table = $self->table or return $self->error('No table'); |
233 | my @fields = $self->fields or return $self->error('No fields'); |
234 | |
235 | for my $field ( @fields ) { |
236 | return $self->error( |
237 | "Field '$field' does not exist in table '", $table->name, "'" |
238 | ) unless $table->get_field( $field ); |
239 | } |
240 | |
241 | return 1; |
242 | } |
243 | |
244 | # ---------------------------------------------------------------------- |
245 | sub DESTROY { |
3c5de62a |
246 | my $self = shift; |
25868dc9 |
247 | undef $self->{'table'}; # destroy cyclical reference |
3c5de62a |
248 | } |
249 | |
250 | 1; |
251 | |
252 | # ---------------------------------------------------------------------- |
253 | |
254 | =pod |
255 | |
256 | =head1 AUTHOR |
257 | |
258 | Ken Y. Clark E<lt>kclark@cpan.orgE<gt> |
259 | |
260 | =cut |