Fixed problem with rendering atoms in Turnkey Producer.
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Schema.pm
CommitLineData
3c5de62a 1package SQL::Translator::Schema;
2
3# ----------------------------------------------------------------------
42624697 4# $Id: Schema.pm,v 1.12 2003-10-08 18:35:15 phrrngtn 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
27SQL::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
38C<SQL::Translator::Schema> is the object that accepts, validates, and
39returns the database structure.
40
41=head1 METHODS
42
43=cut
44
45use strict;
46use Class::Base;
9480e70b 47use SQL::Translator::Schema::Constants;
daf24e05 48use SQL::Translator::Schema::Procedure;
3c5de62a 49use SQL::Translator::Schema::Table;
5974bee7 50use SQL::Translator::Schema::Trigger;
3c5de62a 51use SQL::Translator::Schema::View;
5974bee7 52use SQL::Translator::Utils 'parse_list_arg';
3c5de62a 53
54use base 'Class::Base';
daf24e05 55use vars qw[ $VERSION $TABLE_ORDER $VIEW_ORDER $TRIGGER_ORDER $PROC_ORDER ];
3c5de62a 56
42624697 57$VERSION = sprintf "%d.%02d", q$Revision: 1.12 $ =~ /(\d+)\.(\d+)/;
3c5de62a 58
59# ----------------------------------------------------------------------
60sub init {
61
62=pod
63
64=head2 new
65
66Object constructor.
67
99248301 68 my $schema = SQL::Translator->new(
69 name => 'Foo',
70 database => 'MySQL',
71 );
3c5de62a 72
73=cut
74
75 my ( $self, $config ) = @_;
99248301 76 $self->params( $config, qw[ name database ] ) || return undef;
3c5de62a 77 return $self;
78}
79
80# ----------------------------------------------------------------------
76dce619 81sub add_table {
3c5de62a 82
83=pod
84
76dce619 85=head2 add_table
3c5de62a 86
76dce619 87Add a table object. Returns the new SQL::Translator::Schema::Table object.
99248301 88The "name" parameter is required. If you try to create a table with the
89same name as an existing table, you will get an error and the table will
90not be created.
3c5de62a 91
68e8e2e1 92 my $t1 = $schema->add_table( name => 'foo' ) or die $schema->error;
93 my $t2 = SQL::Translator::Schema::Table->new( name => 'bar' );
94 $t2 = $schema->add_table( $table_bar ) or die $schema->error;
3c5de62a 95
96=cut
97
99248301 98 my $self = shift;
99 my $table_class = 'SQL::Translator::Schema::Table';
100 my $table;
101
102 if ( UNIVERSAL::isa( $_[0], $table_class ) ) {
103 $table = shift;
104 $table->schema( $self );
105 }
106 else {
107 my %args = @_;
108 $args{'schema'} = $self;
109 $table = $table_class->new( \%args ) or return
110 $self->error( $table_class->error );
111 }
3c5de62a 112
d0b43695 113 $table->order( ++$TABLE_ORDER );
99248301 114 my $table_name = $table->name or return $self->error('No table name');
115
116 if ( defined $self->{'tables'}{ $table_name } ) {
117 return $self->error(qq[Can't create table: "$table_name" exists]);
118 }
119 else {
120 $self->{'tables'}{ $table_name } = $table;
99248301 121 }
3c5de62a 122
123 return $table;
124}
125
126# ----------------------------------------------------------------------
daf24e05 127sub add_procedure {
128
129=pod
130
131=head2 add_procedure
132
133Add a procedure object. Returns the new
134SQL::Translator::Schema::Procedure object. The "name" parameter is
135required. If you try to create a procedure with the same name as an
136existing procedure, you will get an error and the procedure will not
137be created.
138
139 my $p1 = $schema->add_procedure( name => 'foo' );
140 my $p2 = SQL::Translator::Schema::Procedure->new( name => 'bar' );
141 $p2 = $schema->add_procedure( $procedure_bar ) or die $schema->error;
142
143=cut
144
145 my $self = shift;
146 my $procedure_class = 'SQL::Translator::Schema::Procedure';
147 my $procedure;
148
149 if ( UNIVERSAL::isa( $_[0], $procedure_class ) ) {
150 $procedure = shift;
151 $procedure->schema( $self );
152 }
153 else {
154 my %args = @_;
155 $args{'schema'} = $self;
156 return $self->error('No procedure name') unless $args{'name'};
157 $procedure = $procedure_class->new( \%args ) or
158 return $self->error( $procedure_class->error );
159 }
160
161 $procedure->order( ++$PROC_ORDER );
162 my $procedure_name = $procedure->name or return
163 $self->error('No procedure name');
164
165 if ( defined $self->{'procedures'}{ $procedure_name } ) {
166 return $self->error(
167 qq[Can't create procedure: "$procedure_name" exists]
168 );
169 }
170 else {
171 $self->{'procedures'}{ $procedure_name } = $procedure;
172 }
173
174 return $procedure;
175}
176
177# ----------------------------------------------------------------------
5974bee7 178sub add_trigger {
179
180=pod
181
182=head2 add_trigger
183
184Add a trigger object. Returns the new SQL::Translator::Schema::Trigger object.
185The "name" parameter is required. If you try to create a trigger with the
186same name as an existing trigger, you will get an error and the trigger will
187not be created.
188
189 my $t1 = $schema->add_trigger( name => 'foo' );
190 my $t2 = SQL::Translator::Schema::Trigger->new( name => 'bar' );
191 $t2 = $schema->add_trigger( $trigger_bar ) or die $schema->error;
192
193=cut
194
195 my $self = shift;
196 my $trigger_class = 'SQL::Translator::Schema::Trigger';
197 my $trigger;
198
199 if ( UNIVERSAL::isa( $_[0], $trigger_class ) ) {
200 $trigger = shift;
daf24e05 201 $trigger->schema( $self );
5974bee7 202 }
203 else {
204 my %args = @_;
daf24e05 205 $args{'schema'} = $self;
5974bee7 206 return $self->error('No trigger name') unless $args{'name'};
207 $trigger = $trigger_class->new( \%args ) or
208 return $self->error( $trigger_class->error );
209 }
210
211 $trigger->order( ++$TRIGGER_ORDER );
212 my $trigger_name = $trigger->name or return $self->error('No trigger name');
213
214 if ( defined $self->{'triggers'}{ $trigger_name } ) {
215 return $self->error(qq[Can't create trigger: "$trigger_name" exists]);
216 }
217 else {
218 $self->{'triggers'}{ $trigger_name } = $trigger;
219 }
220
221 return $trigger;
222}
223
224# ----------------------------------------------------------------------
76dce619 225sub add_view {
3c5de62a 226
227=pod
228
76dce619 229=head2 add_view
3c5de62a 230
76dce619 231Add a view object. Returns the new SQL::Translator::Schema::View object.
99248301 232The "name" parameter is required. If you try to create a view with the
233same name as an existing view, you will get an error and the view will
234not be created.
235
68e8e2e1 236 my $v1 = $schema->add_view( name => 'foo' );
237 my $v2 = SQL::Translator::Schema::View->new( name => 'bar' );
238 $v2 = $schema->add_view( $view_bar ) or die $schema->error;
3c5de62a 239
240=cut
241
99248301 242 my $self = shift;
243 my $view_class = 'SQL::Translator::Schema::View';
244 my $view;
245
246 if ( UNIVERSAL::isa( $_[0], $view_class ) ) {
247 $view = shift;
daf24e05 248 $view->schema( $self );
99248301 249 }
250 else {
251 my %args = @_;
daf24e05 252 $args{'schema'} = $self;
99248301 253 return $self->error('No view name') unless $args{'name'};
254 $view = $view_class->new( \%args ) or return $view_class->error;
255 }
3c5de62a 256
d0b43695 257 $view->order( ++$VIEW_ORDER );
99248301 258 my $view_name = $view->name or return $self->error('No view name');
259
260 if ( defined $self->{'views'}{ $view_name } ) {
261 return $self->error(qq[Can't create view: "$view_name" exists]);
262 }
263 else {
264 $self->{'views'}{ $view_name } = $view;
99248301 265 }
3c5de62a 266
76dce619 267 return $view;
3c5de62a 268}
269
270# ----------------------------------------------------------------------
99248301 271sub database {
272
273=pod
274
275=head2 database
276
277Get or set the schema's database. (optional)
278
279 my $database = $schema->database('PostgreSQL');
280
281=cut
282
283 my $self = shift;
284 $self->{'database'} = shift if @_;
285 return $self->{'database'} || '';
286}
287
288# ----------------------------------------------------------------------
76dce619 289sub is_valid {
3c5de62a 290
291=pod
292
76dce619 293=head2 is_valid
3c5de62a 294
76dce619 295Returns true if all the tables and views are valid.
3c5de62a 296
76dce619 297 my $ok = $schema->is_valid or die $schema->error;
298
299=cut
300
301 my $self = shift;
302
303 return $self->error('No tables') unless $self->get_tables;
304
305 for my $object ( $self->get_tables, $self->get_views ) {
306 return $object->error unless $object->is_valid;
307 }
308
309 return 1;
310}
311
312# ----------------------------------------------------------------------
daf24e05 313sub get_procedure {
314
315=pod
316
317=head2 get_procedure
318
319Returns a procedure by the name provided.
320
321 my $procedure = $schema->get_procedure('foo');
322
323=cut
324
325 my $self = shift;
326 my $procedure_name = shift or return $self->error('No procedure name');
327 return $self->error( qq[Table "$procedure_name" does not exist] ) unless
328 exists $self->{'procedures'}{ $procedure_name };
329 return $self->{'procedures'}{ $procedure_name };
330}
331
332# ----------------------------------------------------------------------
333sub get_procedures {
334
335=pod
336
337=head2 get_procedures
338
339Returns all the procedures as an array or array reference.
340
341 my @procedures = $schema->get_procedures;
342
343=cut
344
345 my $self = shift;
346 my @procedures =
347 map { $_->[1] }
348 sort { $a->[0] <=> $b->[0] }
349 map { [ $_->order, $_ ] }
350 values %{ $self->{'procedures'} };
351
352 if ( @procedures ) {
353 return wantarray ? @procedures : \@procedures;
354 }
355 else {
356 $self->error('No procedures');
357 return wantarray ? () : undef;
358 }
359}
360
361# ----------------------------------------------------------------------
76dce619 362sub get_table {
363
364=pod
365
366=head2 get_table
367
368Returns a table by the name provided.
369
370 my $table = $schema->get_table('foo');
371
372=cut
373
374 my $self = shift;
375 my $table_name = shift or return $self->error('No table name');
99248301 376 return $self->error( qq[Table "$table_name" does not exist] ) unless
76dce619 377 exists $self->{'tables'}{ $table_name };
378 return $self->{'tables'}{ $table_name };
379}
380
381# ----------------------------------------------------------------------
382sub get_tables {
383
384=pod
385
386=head2 get_tables
387
388Returns all the tables as an array or array reference.
389
390 my @tables = $schema->get_tables;
391
392=cut
393
394 my $self = shift;
d0b43695 395 my @tables =
396 map { $_->[1] }
397 sort { $a->[0] <=> $b->[0] }
398 map { [ $_->order, $_ ] }
76dce619 399 values %{ $self->{'tables'} };
400
401 if ( @tables ) {
402 return wantarray ? @tables : \@tables;
403 }
404 else {
405 $self->error('No tables');
406 return wantarray ? () : undef;
407 }
408}
409
410# ----------------------------------------------------------------------
daf24e05 411sub get_trigger {
412
413=pod
414
415=head2 get_trigger
416
417Returns a trigger by the name provided.
418
419 my $trigger = $schema->get_trigger('foo');
420
421=cut
422
423 my $self = shift;
424 my $trigger_name = shift or return $self->error('No trigger name');
425 return $self->error( qq[Table "$trigger_name" does not exist] ) unless
426 exists $self->{'triggers'}{ $trigger_name };
427 return $self->{'triggers'}{ $trigger_name };
428}
429
430# ----------------------------------------------------------------------
431sub get_triggers {
432
433=pod
434
435=head2 get_triggers
436
437Returns all the triggers as an array or array reference.
438
439 my @triggers = $schema->get_triggers;
440
441=cut
442
443 my $self = shift;
444 my @triggers =
445 map { $_->[1] }
446 sort { $a->[0] <=> $b->[0] }
447 map { [ $_->order, $_ ] }
448 values %{ $self->{'triggers'} };
449
450 if ( @triggers ) {
451 return wantarray ? @triggers : \@triggers;
452 }
453 else {
454 $self->error('No triggers');
455 return wantarray ? () : undef;
456 }
457}
458
459# ----------------------------------------------------------------------
76dce619 460sub get_view {
461
462=pod
463
464=head2 get_view
465
466Returns a view by the name provided.
467
468 my $view = $schema->get_view('foo');
3c5de62a 469
470=cut
471
472 my $self = shift;
76dce619 473 my $view_name = shift or return $self->error('No view name');
474 return $self->error('View "$view_name" does not exist') unless
475 exists $self->{'views'}{ $view_name };
476 return $self->{'views'}{ $view_name };
477}
3c5de62a 478
76dce619 479# ----------------------------------------------------------------------
480sub get_views {
3c5de62a 481
76dce619 482=pod
483
484=head2 get_views
485
486Returns all the views as an array or array reference.
487
488 my @views = $schema->get_views;
489
490=cut
491
492 my $self = shift;
d0b43695 493 my @views =
494 map { $_->[1] }
495 sort { $a->[0] <=> $b->[0] }
496 map { [ $_->order, $_ ] }
99248301 497 values %{ $self->{'views'} };
76dce619 498
499 if ( @views ) {
500 return wantarray ? @views : \@views;
501 }
502 else {
503 $self->error('No views');
504 return wantarray ? () : undef;
505 }
3c5de62a 506}
507
99248301 508# ----------------------------------------------------------------------
9480e70b 509sub make_natural_joins {
510
511=pod
512
513=head2 make_natural_joins
514
515Creates foriegn key relationships among like-named fields in different
516tables. Accepts the following arguments:
517
518=over 4
519
520=item * join_pk_only
521
522A True or False argument which determins whether or not to perform
523the joins from primary keys to fields of the same name in other tables
524
525=item * skip_fields
526
527A list of fields to skip in the joins
528
529=back 4
530
531 $schema->make_natural_joins(
532 join_pk_only => 1,
533 skip_fields => 'name,department_id',
534 );
535
536=cut
537
538 my $self = shift;
539 my %args = @_;
540 my $join_pk_only = $args{'join_pk_only'} || 0;
40c522c6 541 my %skip_fields = map { s/^\s+|\s+$//g; $_, 1 } @{
542 parse_list_arg( $args{'skip_fields'} )
543 };
9480e70b 544
545 my ( %common_keys, %pk );
546 for my $table ( $self->get_tables ) {
547 for my $field ( $table->get_fields ) {
548 my $field_name = $field->name or next;
549 next if $skip_fields{ $field_name };
550 $pk{ $field_name } = 1 if $field->is_primary_key;
551 push @{ $common_keys{ $field_name } }, $table->name;
552 }
553 }
554
555 for my $field ( keys %common_keys ) {
556 next if $join_pk_only and !defined $pk{ $field };
557
558 my @table_names = @{ $common_keys{ $field } };
559 next unless scalar @table_names > 1;
560
561 for my $i ( 0 .. $#table_names ) {
562 my $table1 = $self->get_table( $table_names[ $i ] ) or next;
563
564 for my $j ( 1 .. $#table_names ) {
565 my $table2 = $self->get_table( $table_names[ $j ] ) or next;
566 next if $table1->name eq $table2->name;
567
568 $table1->add_constraint(
569 type => FOREIGN_KEY,
570 fields => $field,
571 reference_table => $table2->name,
572 reference_fields => $field,
573 );
574 }
575 }
576 }
577
578 return 1;
579}
580
581# ----------------------------------------------------------------------
99248301 582sub name {
583
584=pod
585
586=head2 name
587
588Get or set the schema's name. (optional)
589
590 my $schema_name = $schema->name('Foo Database');
591
592=cut
593
594 my $self = shift;
595 $self->{'name'} = shift if @_;
596 return $self->{'name'} || '';
597}
598
d0b43695 599# ----------------------------------------------------------------------
600sub DESTROY {
601 my $self = shift;
602 undef $_ for values %{ $self->{'tables'} };
603 undef $_ for values %{ $self->{'views'} };
604}
605
3c5de62a 6061;
607
608# ----------------------------------------------------------------------
609
610=pod
611
612=head1 AUTHOR
613
614Ken Y. Clark E<lt>kclark@cpan.orgE<gt>
615
616=cut