Commit | Line | Data |
3c5de62a |
1 | package SQL::Translator::Schema; |
2 | |
3 | # ---------------------------------------------------------------------- |
9480e70b |
4 | # $Id: Schema.pm,v 1.6 2003-06-09 04:18:23 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 - SQL::Translator schema object |
28 | |
29 | =head1 SYNOPSIS |
30 | |
31 | use SQL::Translator::Schema; |
76dce619 |
32 | my $schema = SQL::Translator::Schema->new; |
33 | my $table = $schema->add_table( name => 'foo' ); |
34 | my $view = $schema->add_view( name => 'bar', sql => '...' ); |
3c5de62a |
35 | |
36 | =head1 DESCSIPTION |
37 | |
38 | C<SQL::Translator::Schema> is the object that accepts, validates, and |
39 | returns the database structure. |
40 | |
41 | =head1 METHODS |
42 | |
43 | =cut |
44 | |
45 | use strict; |
46 | use Class::Base; |
9480e70b |
47 | use SQL::Translator::Schema::Constants; |
3c5de62a |
48 | use SQL::Translator::Schema::Table; |
49 | use SQL::Translator::Schema::View; |
50 | |
51 | use base 'Class::Base'; |
76dce619 |
52 | use vars qw[ $VERSION $TABLE_ORDER $VIEW_ORDER ]; |
3c5de62a |
53 | |
54 | $VERSION = 1.00; |
55 | |
56 | # ---------------------------------------------------------------------- |
57 | sub init { |
58 | |
59 | =pod |
60 | |
61 | =head2 new |
62 | |
63 | Object constructor. |
64 | |
99248301 |
65 | my $schema = SQL::Translator->new( |
66 | name => 'Foo', |
67 | database => 'MySQL', |
68 | ); |
3c5de62a |
69 | |
70 | =cut |
71 | |
72 | my ( $self, $config ) = @_; |
99248301 |
73 | $self->params( $config, qw[ name database ] ) || return undef; |
3c5de62a |
74 | return $self; |
75 | } |
76 | |
77 | # ---------------------------------------------------------------------- |
76dce619 |
78 | sub add_table { |
3c5de62a |
79 | |
80 | =pod |
81 | |
76dce619 |
82 | =head2 add_table |
3c5de62a |
83 | |
76dce619 |
84 | Add a table object. Returns the new SQL::Translator::Schema::Table object. |
99248301 |
85 | The "name" parameter is required. If you try to create a table with the |
86 | same name as an existing table, you will get an error and the table will |
87 | not be created. |
3c5de62a |
88 | |
68e8e2e1 |
89 | my $t1 = $schema->add_table( name => 'foo' ) or die $schema->error; |
90 | my $t2 = SQL::Translator::Schema::Table->new( name => 'bar' ); |
91 | $t2 = $schema->add_table( $table_bar ) or die $schema->error; |
3c5de62a |
92 | |
93 | =cut |
94 | |
99248301 |
95 | my $self = shift; |
96 | my $table_class = 'SQL::Translator::Schema::Table'; |
97 | my $table; |
98 | |
99 | if ( UNIVERSAL::isa( $_[0], $table_class ) ) { |
100 | $table = shift; |
101 | $table->schema( $self ); |
102 | } |
103 | else { |
104 | my %args = @_; |
105 | $args{'schema'} = $self; |
106 | $table = $table_class->new( \%args ) or return |
107 | $self->error( $table_class->error ); |
108 | } |
3c5de62a |
109 | |
d0b43695 |
110 | $table->order( ++$TABLE_ORDER ); |
99248301 |
111 | my $table_name = $table->name or return $self->error('No table name'); |
112 | |
113 | if ( defined $self->{'tables'}{ $table_name } ) { |
114 | return $self->error(qq[Can't create table: "$table_name" exists]); |
115 | } |
116 | else { |
117 | $self->{'tables'}{ $table_name } = $table; |
99248301 |
118 | } |
3c5de62a |
119 | |
120 | return $table; |
121 | } |
122 | |
123 | # ---------------------------------------------------------------------- |
76dce619 |
124 | sub add_view { |
3c5de62a |
125 | |
126 | =pod |
127 | |
76dce619 |
128 | =head2 add_view |
3c5de62a |
129 | |
76dce619 |
130 | Add a view object. Returns the new SQL::Translator::Schema::View object. |
99248301 |
131 | The "name" parameter is required. If you try to create a view with the |
132 | same name as an existing view, you will get an error and the view will |
133 | not be created. |
134 | |
68e8e2e1 |
135 | my $v1 = $schema->add_view( name => 'foo' ); |
136 | my $v2 = SQL::Translator::Schema::View->new( name => 'bar' ); |
137 | $v2 = $schema->add_view( $view_bar ) or die $schema->error; |
3c5de62a |
138 | |
139 | =cut |
140 | |
99248301 |
141 | my $self = shift; |
142 | my $view_class = 'SQL::Translator::Schema::View'; |
143 | my $view; |
144 | |
145 | if ( UNIVERSAL::isa( $_[0], $view_class ) ) { |
146 | $view = shift; |
147 | } |
148 | else { |
149 | my %args = @_; |
150 | return $self->error('No view name') unless $args{'name'}; |
151 | $view = $view_class->new( \%args ) or return $view_class->error; |
152 | } |
3c5de62a |
153 | |
d0b43695 |
154 | $view->order( ++$VIEW_ORDER ); |
99248301 |
155 | my $view_name = $view->name or return $self->error('No view name'); |
156 | |
157 | if ( defined $self->{'views'}{ $view_name } ) { |
158 | return $self->error(qq[Can't create view: "$view_name" exists]); |
159 | } |
160 | else { |
161 | $self->{'views'}{ $view_name } = $view; |
99248301 |
162 | } |
3c5de62a |
163 | |
76dce619 |
164 | return $view; |
3c5de62a |
165 | } |
166 | |
167 | # ---------------------------------------------------------------------- |
99248301 |
168 | sub database { |
169 | |
170 | =pod |
171 | |
172 | =head2 database |
173 | |
174 | Get or set the schema's database. (optional) |
175 | |
176 | my $database = $schema->database('PostgreSQL'); |
177 | |
178 | =cut |
179 | |
180 | my $self = shift; |
181 | $self->{'database'} = shift if @_; |
182 | return $self->{'database'} || ''; |
183 | } |
184 | |
185 | # ---------------------------------------------------------------------- |
76dce619 |
186 | sub is_valid { |
3c5de62a |
187 | |
188 | =pod |
189 | |
76dce619 |
190 | =head2 is_valid |
3c5de62a |
191 | |
76dce619 |
192 | Returns true if all the tables and views are valid. |
3c5de62a |
193 | |
76dce619 |
194 | my $ok = $schema->is_valid or die $schema->error; |
195 | |
196 | =cut |
197 | |
198 | my $self = shift; |
199 | |
200 | return $self->error('No tables') unless $self->get_tables; |
201 | |
202 | for my $object ( $self->get_tables, $self->get_views ) { |
203 | return $object->error unless $object->is_valid; |
204 | } |
205 | |
206 | return 1; |
207 | } |
208 | |
209 | # ---------------------------------------------------------------------- |
210 | sub get_table { |
211 | |
212 | =pod |
213 | |
214 | =head2 get_table |
215 | |
216 | Returns a table by the name provided. |
217 | |
218 | my $table = $schema->get_table('foo'); |
219 | |
220 | =cut |
221 | |
222 | my $self = shift; |
223 | my $table_name = shift or return $self->error('No table name'); |
99248301 |
224 | return $self->error( qq[Table "$table_name" does not exist] ) unless |
76dce619 |
225 | exists $self->{'tables'}{ $table_name }; |
226 | return $self->{'tables'}{ $table_name }; |
227 | } |
228 | |
229 | # ---------------------------------------------------------------------- |
230 | sub get_tables { |
231 | |
232 | =pod |
233 | |
234 | =head2 get_tables |
235 | |
236 | Returns all the tables as an array or array reference. |
237 | |
238 | my @tables = $schema->get_tables; |
239 | |
240 | =cut |
241 | |
242 | my $self = shift; |
d0b43695 |
243 | my @tables = |
244 | map { $_->[1] } |
245 | sort { $a->[0] <=> $b->[0] } |
246 | map { [ $_->order, $_ ] } |
76dce619 |
247 | values %{ $self->{'tables'} }; |
248 | |
249 | if ( @tables ) { |
250 | return wantarray ? @tables : \@tables; |
251 | } |
252 | else { |
253 | $self->error('No tables'); |
254 | return wantarray ? () : undef; |
255 | } |
256 | } |
257 | |
258 | # ---------------------------------------------------------------------- |
259 | sub get_view { |
260 | |
261 | =pod |
262 | |
263 | =head2 get_view |
264 | |
265 | Returns a view by the name provided. |
266 | |
267 | my $view = $schema->get_view('foo'); |
3c5de62a |
268 | |
269 | =cut |
270 | |
271 | my $self = shift; |
76dce619 |
272 | my $view_name = shift or return $self->error('No view name'); |
273 | return $self->error('View "$view_name" does not exist') unless |
274 | exists $self->{'views'}{ $view_name }; |
275 | return $self->{'views'}{ $view_name }; |
276 | } |
3c5de62a |
277 | |
76dce619 |
278 | # ---------------------------------------------------------------------- |
279 | sub get_views { |
3c5de62a |
280 | |
76dce619 |
281 | =pod |
282 | |
283 | =head2 get_views |
284 | |
285 | Returns all the views as an array or array reference. |
286 | |
287 | my @views = $schema->get_views; |
288 | |
289 | =cut |
290 | |
291 | my $self = shift; |
d0b43695 |
292 | my @views = |
293 | map { $_->[1] } |
294 | sort { $a->[0] <=> $b->[0] } |
295 | map { [ $_->order, $_ ] } |
99248301 |
296 | values %{ $self->{'views'} }; |
76dce619 |
297 | |
298 | if ( @views ) { |
299 | return wantarray ? @views : \@views; |
300 | } |
301 | else { |
302 | $self->error('No views'); |
303 | return wantarray ? () : undef; |
304 | } |
3c5de62a |
305 | } |
306 | |
99248301 |
307 | # ---------------------------------------------------------------------- |
9480e70b |
308 | sub make_natural_joins { |
309 | |
310 | =pod |
311 | |
312 | =head2 make_natural_joins |
313 | |
314 | Creates foriegn key relationships among like-named fields in different |
315 | tables. Accepts the following arguments: |
316 | |
317 | =over 4 |
318 | |
319 | =item * join_pk_only |
320 | |
321 | A True or False argument which determins whether or not to perform |
322 | the joins from primary keys to fields of the same name in other tables |
323 | |
324 | =item * skip_fields |
325 | |
326 | A list of fields to skip in the joins |
327 | |
328 | =back 4 |
329 | |
330 | $schema->make_natural_joins( |
331 | join_pk_only => 1, |
332 | skip_fields => 'name,department_id', |
333 | ); |
334 | |
335 | =cut |
336 | |
337 | my $self = shift; |
338 | my %args = @_; |
339 | my $join_pk_only = $args{'join_pk_only'} || 0; |
340 | my %skip_fields = map { $_, 1 } @{ parse_list_arg($args{'skip_fields'}) }; |
341 | |
342 | my ( %common_keys, %pk ); |
343 | for my $table ( $self->get_tables ) { |
344 | for my $field ( $table->get_fields ) { |
345 | my $field_name = $field->name or next; |
346 | next if $skip_fields{ $field_name }; |
347 | $pk{ $field_name } = 1 if $field->is_primary_key; |
348 | push @{ $common_keys{ $field_name } }, $table->name; |
349 | } |
350 | } |
351 | |
352 | for my $field ( keys %common_keys ) { |
353 | next if $join_pk_only and !defined $pk{ $field }; |
354 | |
355 | my @table_names = @{ $common_keys{ $field } }; |
356 | next unless scalar @table_names > 1; |
357 | |
358 | for my $i ( 0 .. $#table_names ) { |
359 | my $table1 = $self->get_table( $table_names[ $i ] ) or next; |
360 | |
361 | for my $j ( 1 .. $#table_names ) { |
362 | my $table2 = $self->get_table( $table_names[ $j ] ) or next; |
363 | next if $table1->name eq $table2->name; |
364 | |
365 | $table1->add_constraint( |
366 | type => FOREIGN_KEY, |
367 | fields => $field, |
368 | reference_table => $table2->name, |
369 | reference_fields => $field, |
370 | ); |
371 | } |
372 | } |
373 | } |
374 | |
375 | return 1; |
376 | } |
377 | |
378 | # ---------------------------------------------------------------------- |
99248301 |
379 | sub name { |
380 | |
381 | =pod |
382 | |
383 | =head2 name |
384 | |
385 | Get or set the schema's name. (optional) |
386 | |
387 | my $schema_name = $schema->name('Foo Database'); |
388 | |
389 | =cut |
390 | |
391 | my $self = shift; |
392 | $self->{'name'} = shift if @_; |
393 | return $self->{'name'} || ''; |
394 | } |
395 | |
d0b43695 |
396 | # ---------------------------------------------------------------------- |
397 | sub DESTROY { |
398 | my $self = shift; |
399 | undef $_ for values %{ $self->{'tables'} }; |
400 | undef $_ for values %{ $self->{'views'} }; |
401 | } |
402 | |
3c5de62a |
403 | 1; |
404 | |
405 | # ---------------------------------------------------------------------- |
406 | |
407 | =pod |
408 | |
409 | =head1 AUTHOR |
410 | |
411 | Ken Y. Clark E<lt>kclark@cpan.orgE<gt> |
412 | |
413 | =cut |