Modfied fields() to return empty array when there are no fields
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Schema.pm
CommitLineData
3c5de62a 1package SQL::Translator::Schema;
2
97382c6d 3# vim: sw=4: ts=4:
4
3c5de62a 5# ----------------------------------------------------------------------
6a25a87d 6# $Id: Schema.pm,v 1.24 2005-06-27 22:02:50 duality72 Exp $
3c5de62a 7# ----------------------------------------------------------------------
977651a5 8# Copyright (C) 2002-4 SQLFairy Authors
3c5de62a 9#
10# This program is free software; you can redistribute it and/or
11# modify it under the terms of the GNU General Public License as
12# published by the Free Software Foundation; version 2.
13#
14# This program is distributed in the hope that it will be useful, but
15# WITHOUT ANY WARRANTY; without even the implied warranty of
16# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17# General Public License for more details.
18#
19# You should have received a copy of the GNU General Public License
20# along with this program; if not, write to the Free Software
21# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
22# 02111-1307 USA
23# -------------------------------------------------------------------
24
25=pod
26
27=head1 NAME
28
29SQL::Translator::Schema - SQL::Translator schema object
30
31=head1 SYNOPSIS
32
33 use SQL::Translator::Schema;
97382c6d 34 my $schema = SQL::Translator::Schema->new(
35 name => 'Foo',
36 database => 'MySQL',
37 );
38 my $table = $schema->add_table( name => 'foo' );
39 my $view = $schema->add_view( name => 'bar', sql => '...' );
40
3c5de62a 41
42=head1 DESCSIPTION
43
44C<SQL::Translator::Schema> is the object that accepts, validates, and
45returns the database structure.
46
47=head1 METHODS
48
49=cut
50
51use strict;
9480e70b 52use SQL::Translator::Schema::Constants;
daf24e05 53use SQL::Translator::Schema::Procedure;
3c5de62a 54use SQL::Translator::Schema::Table;
5974bee7 55use SQL::Translator::Schema::Trigger;
3c5de62a 56use SQL::Translator::Schema::View;
b046b0b9 57use SQL::Translator::Schema::Graph;
5974bee7 58use SQL::Translator::Utils 'parse_list_arg';
3c5de62a 59
b6a880d1 60use base 'SQL::Translator::Schema::Object';
daf24e05 61use vars qw[ $VERSION $TABLE_ORDER $VIEW_ORDER $TRIGGER_ORDER $PROC_ORDER ];
3c5de62a 62
6a25a87d 63$VERSION = sprintf "%d.%02d", q$Revision: 1.24 $ =~ /(\d+)\.(\d+)/;
9371be50 64
da8ab524 65__PACKAGE__->_attributes(qw/name database translator/);
3c5de62a 66
97382c6d 67# ----------------------------------------------------------------------
68sub as_graph {
69
3c5de62a 70=pod
71
97382c6d 72=head2 as_graph
3c5de62a 73
97382c6d 74Returns the schema as an L<SQL::Translator::Schema::Graph> object.
3c5de62a 75
76=cut
77
da8ab524 78 my $self = shift;
97382c6d 79 return SQL::Translator::Schema::Graph->new(
da8ab524 80 translator => $self->translator );
10f36920 81}
82
3c5de62a 83# ----------------------------------------------------------------------
76dce619 84sub add_table {
3c5de62a 85
86=pod
87
76dce619 88=head2 add_table
3c5de62a 89
76dce619 90Add a table object. Returns the new SQL::Translator::Schema::Table object.
99248301 91The "name" parameter is required. If you try to create a table with the
92same name as an existing table, you will get an error and the table will
93not be created.
3c5de62a 94
68e8e2e1 95 my $t1 = $schema->add_table( name => 'foo' ) or die $schema->error;
96 my $t2 = SQL::Translator::Schema::Table->new( name => 'bar' );
97 $t2 = $schema->add_table( $table_bar ) or die $schema->error;
3c5de62a 98
99=cut
100
99248301 101 my $self = shift;
102 my $table_class = 'SQL::Translator::Schema::Table';
103 my $table;
104
105 if ( UNIVERSAL::isa( $_[0], $table_class ) ) {
106 $table = shift;
da8ab524 107 $table->schema($self);
99248301 108 }
109 else {
110 my %args = @_;
111 $args{'schema'} = $self;
da8ab524 112 $table = $table_class->new( \%args )
113 or return $self->error( $table_class->error );
99248301 114 }
3c5de62a 115
d0b43695 116 $table->order( ++$TABLE_ORDER );
da8ab524 117
23044758 118 # We know we have a name as the Table->new above errors if none given.
119 my $table_name = $table->name;
99248301 120
da8ab524 121 if ( defined $self->{'tables'}{$table_name} ) {
99248301 122 return $self->error(qq[Can't create table: "$table_name" exists]);
123 }
124 else {
da8ab524 125 $self->{'tables'}{$table_name} = $table;
99248301 126 }
3c5de62a 127
128 return $table;
129}
130
131# ----------------------------------------------------------------------
650f87eb 132sub drop_table {
133
134=pod
135
136=head2 drop_table
137
138Remove a table from the schema. Returns the table object if the table was found
139and removed, an error otherwise. The single parameter can be either a table
140name or an C<SQL::Translator::Schema::Table> object. The "cascade" parameter
141can be set to 1 to also drop all triggers on the table, default is 0.
142
143 $schema->drop_table('mytable');
144 $schema->drop_table('mytable', cascade => 1);
145
146=cut
147
da8ab524 148 my $self = shift;
149 my $table_class = 'SQL::Translator::Schema::Table';
650f87eb 150 my $table_name;
151
152 if ( UNIVERSAL::isa( $_[0], $table_class ) ) {
153 $table_name = shift->name;
154 }
155 else {
156 $table_name = shift;
157 }
da8ab524 158 my %args = @_;
650f87eb 159 my $cascade = $args{'cascade'};
160
da8ab524 161 if ( !exists $self->{'tables'}{$table_name} ) {
650f87eb 162 return $self->error(qq[Can't drop table: $table_name" doesn't exist]);
163 }
164
da8ab524 165 my $table = delete $self->{'tables'}{$table_name};
166
167 if ($cascade) {
650f87eb 168
650f87eb 169 # Drop all triggers on this table
da8ab524 170 $self->drop_trigger()
171 for ( grep { $_->on_table eq $table_name } @{ $self->{'triggers'} } );
650f87eb 172 }
173 return $table;
174}
175
176# ----------------------------------------------------------------------
daf24e05 177sub add_procedure {
178
179=pod
180
181=head2 add_procedure
182
650f87eb 183Add a procedure object. Returns the new SQL::Translator::Schema::Procedure
184object. The "name" parameter is required. If you try to create a procedure
185with the same name as an existing procedure, you will get an error and the
186procedure will not be created.
daf24e05 187
188 my $p1 = $schema->add_procedure( name => 'foo' );
189 my $p2 = SQL::Translator::Schema::Procedure->new( name => 'bar' );
190 $p2 = $schema->add_procedure( $procedure_bar ) or die $schema->error;
191
192=cut
193
194 my $self = shift;
195 my $procedure_class = 'SQL::Translator::Schema::Procedure';
196 my $procedure;
197
198 if ( UNIVERSAL::isa( $_[0], $procedure_class ) ) {
199 $procedure = shift;
da8ab524 200 $procedure->schema($self);
daf24e05 201 }
202 else {
203 my %args = @_;
204 $args{'schema'} = $self;
205 return $self->error('No procedure name') unless $args{'name'};
da8ab524 206 $procedure = $procedure_class->new( \%args )
207 or return $self->error( $procedure_class->error );
daf24e05 208 }
209
210 $procedure->order( ++$PROC_ORDER );
da8ab524 211 my $procedure_name = $procedure->name
212 or return $self->error('No procedure name');
daf24e05 213
da8ab524 214 if ( defined $self->{'procedures'}{$procedure_name} ) {
daf24e05 215 return $self->error(
da8ab524 216 qq[Can't create procedure: "$procedure_name" exists] );
daf24e05 217 }
218 else {
da8ab524 219 $self->{'procedures'}{$procedure_name} = $procedure;
daf24e05 220 }
221
222 return $procedure;
223}
da8ab524 224
650f87eb 225# ----------------------------------------------------------------------
226sub drop_procedure {
227
228=pod
229
230=head2 drop_procedure
231
232Remove a procedure from the schema. Returns the procedure object if the
233procedure was found and removed, an error otherwise. The single parameter
234can be either a procedure name or an C<SQL::Translator::Schema::Procedure>
235object.
236
237 $schema->drop_procedure('myprocedure');
238
239=cut
240
da8ab524 241 my $self = shift;
242 my $proc_class = 'SQL::Translator::Schema::Procedure';
650f87eb 243 my $proc_name;
244
245 if ( UNIVERSAL::isa( $_[0], $proc_class ) ) {
246 $proc_name = shift->name;
247 }
248 else {
249 $proc_name = shift;
250 }
251
da8ab524 252 if ( !exists $self->{'procedures'}{$proc_name} ) {
253 return $self->error(
254 qq[Can't drop procedure: $proc_name" doesn't exist]);
650f87eb 255 }
256
da8ab524 257 my $proc = delete $self->{'procedures'}{$proc_name};
650f87eb 258
259 return $proc;
260}
daf24e05 261
262# ----------------------------------------------------------------------
5974bee7 263sub add_trigger {
264
265=pod
266
267=head2 add_trigger
268
269Add a trigger object. Returns the new SQL::Translator::Schema::Trigger object.
270The "name" parameter is required. If you try to create a trigger with the
271same name as an existing trigger, you will get an error and the trigger will
272not be created.
273
274 my $t1 = $schema->add_trigger( name => 'foo' );
275 my $t2 = SQL::Translator::Schema::Trigger->new( name => 'bar' );
276 $t2 = $schema->add_trigger( $trigger_bar ) or die $schema->error;
277
278=cut
279
280 my $self = shift;
281 my $trigger_class = 'SQL::Translator::Schema::Trigger';
282 my $trigger;
283
284 if ( UNIVERSAL::isa( $_[0], $trigger_class ) ) {
285 $trigger = shift;
da8ab524 286 $trigger->schema($self);
5974bee7 287 }
288 else {
289 my %args = @_;
daf24e05 290 $args{'schema'} = $self;
5974bee7 291 return $self->error('No trigger name') unless $args{'name'};
da8ab524 292 $trigger = $trigger_class->new( \%args )
293 or return $self->error( $trigger_class->error );
5974bee7 294 }
295
296 $trigger->order( ++$TRIGGER_ORDER );
297 my $trigger_name = $trigger->name or return $self->error('No trigger name');
298
da8ab524 299 if ( defined $self->{'triggers'}{$trigger_name} ) {
5974bee7 300 return $self->error(qq[Can't create trigger: "$trigger_name" exists]);
301 }
302 else {
da8ab524 303 $self->{'triggers'}{$trigger_name} = $trigger;
5974bee7 304 }
305
306 return $trigger;
307}
da8ab524 308
650f87eb 309# ----------------------------------------------------------------------
310sub drop_trigger {
311
312=pod
313
314=head2 drop_trigger
315
316Remove a trigger from the schema. Returns the trigger object if the trigger was
317found and removed, an error otherwise. The single parameter can be either a
318trigger name or an C<SQL::Translator::Schema::Trigger> object.
319
320 $schema->drop_trigger('mytrigger');
321
322=cut
323
da8ab524 324 my $self = shift;
325 my $trigger_class = 'SQL::Translator::Schema::Trigger';
650f87eb 326 my $trigger_name;
327
328 if ( UNIVERSAL::isa( $_[0], $trigger_class ) ) {
329 $trigger_name = shift->name;
330 }
331 else {
332 $trigger_name = shift;
333 }
334
da8ab524 335 if ( !exists $self->{'triggers'}{$trigger_name} ) {
336 return $self->error(
337 qq[Can't drop trigger: $trigger_name" doesn't exist]);
650f87eb 338 }
339
da8ab524 340 my $trigger = delete $self->{'triggers'}{$trigger_name};
650f87eb 341
342 return $trigger;
343}
5974bee7 344
345# ----------------------------------------------------------------------
76dce619 346sub add_view {
3c5de62a 347
348=pod
349
76dce619 350=head2 add_view
3c5de62a 351
76dce619 352Add a view object. Returns the new SQL::Translator::Schema::View object.
99248301 353The "name" parameter is required. If you try to create a view with the
354same name as an existing view, you will get an error and the view will
355not be created.
356
68e8e2e1 357 my $v1 = $schema->add_view( name => 'foo' );
358 my $v2 = SQL::Translator::Schema::View->new( name => 'bar' );
359 $v2 = $schema->add_view( $view_bar ) or die $schema->error;
3c5de62a 360
361=cut
362
da8ab524 363 my $self = shift;
99248301 364 my $view_class = 'SQL::Translator::Schema::View';
365 my $view;
366
367 if ( UNIVERSAL::isa( $_[0], $view_class ) ) {
368 $view = shift;
da8ab524 369 $view->schema($self);
99248301 370 }
371 else {
372 my %args = @_;
daf24e05 373 $args{'schema'} = $self;
99248301 374 return $self->error('No view name') unless $args{'name'};
375 $view = $view_class->new( \%args ) or return $view_class->error;
376 }
3c5de62a 377
d0b43695 378 $view->order( ++$VIEW_ORDER );
99248301 379 my $view_name = $view->name or return $self->error('No view name');
380
da8ab524 381 if ( defined $self->{'views'}{$view_name} ) {
99248301 382 return $self->error(qq[Can't create view: "$view_name" exists]);
383 }
384 else {
da8ab524 385 $self->{'views'}{$view_name} = $view;
99248301 386 }
3c5de62a 387
76dce619 388 return $view;
3c5de62a 389}
390
391# ----------------------------------------------------------------------
650f87eb 392sub drop_view {
393
394=pod
395
396=head2 drop_view
397
398Remove a view from the schema. Returns the view object if the view was found
399and removed, an error otherwise. The single parameter can be either a view
400name or an C<SQL::Translator::Schema::View> object.
401
402 $schema->drop_view('myview');
403
404=cut
405
da8ab524 406 my $self = shift;
407 my $view_class = 'SQL::Translator::Schema::View';
650f87eb 408 my $view_name;
409
410 if ( UNIVERSAL::isa( $_[0], $view_class ) ) {
411 $view_name = shift->name;
412 }
413 else {
414 $view_name = shift;
415 }
416
da8ab524 417 if ( !exists $self->{'views'}{$view_name} ) {
650f87eb 418 return $self->error(qq[Can't drop view: $view_name" doesn't exist]);
419 }
420
da8ab524 421 my $view = delete $self->{'views'}{$view_name};
650f87eb 422
423 return $view;
424}
425
426# ----------------------------------------------------------------------
99248301 427sub database {
428
429=pod
430
431=head2 database
432
433Get or set the schema's database. (optional)
434
435 my $database = $schema->database('PostgreSQL');
436
437=cut
438
439 my $self = shift;
440 $self->{'database'} = shift if @_;
441 return $self->{'database'} || '';
442}
443
444# ----------------------------------------------------------------------
76dce619 445sub is_valid {
3c5de62a 446
447=pod
448
76dce619 449=head2 is_valid
3c5de62a 450
76dce619 451Returns true if all the tables and views are valid.
3c5de62a 452
76dce619 453 my $ok = $schema->is_valid or die $schema->error;
454
455=cut
456
457 my $self = shift;
458
459 return $self->error('No tables') unless $self->get_tables;
460
461 for my $object ( $self->get_tables, $self->get_views ) {
462 return $object->error unless $object->is_valid;
463 }
464
465 return 1;
466}
467
468# ----------------------------------------------------------------------
daf24e05 469sub get_procedure {
470
471=pod
472
473=head2 get_procedure
474
475Returns a procedure by the name provided.
476
477 my $procedure = $schema->get_procedure('foo');
478
479=cut
480
da8ab524 481 my $self = shift;
daf24e05 482 my $procedure_name = shift or return $self->error('No procedure name');
da8ab524 483 return $self->error(qq[Table "$procedure_name" does not exist])
484 unless exists $self->{'procedures'}{$procedure_name};
485 return $self->{'procedures'}{$procedure_name};
daf24e05 486}
487
488# ----------------------------------------------------------------------
489sub get_procedures {
490
491=pod
492
493=head2 get_procedures
494
495Returns all the procedures as an array or array reference.
496
497 my @procedures = $schema->get_procedures;
498
499=cut
500
da8ab524 501 my $self = shift;
502 my @procedures =
503 map { $_->[1] }
504 sort { $a->[0] <=> $b->[0] }
505 map { [ $_->order, $_ ] } values %{ $self->{'procedures'} };
daf24e05 506
da8ab524 507 if (@procedures) {
daf24e05 508 return wantarray ? @procedures : \@procedures;
509 }
510 else {
511 $self->error('No procedures');
512 return wantarray ? () : undef;
513 }
514}
515
516# ----------------------------------------------------------------------
76dce619 517sub get_table {
518
519=pod
520
521=head2 get_table
522
523Returns a table by the name provided.
524
525 my $table = $schema->get_table('foo');
526
527=cut
528
da8ab524 529 my $self = shift;
76dce619 530 my $table_name = shift or return $self->error('No table name');
6a25a87d 531 my $case_insensitive = shift;
532 if ( $case_insensitive ) {
533 $table_name = uc($table_name);
534 foreach my $table ( keys %{$self->{tables}} ) {
535 return $self->{tables}{$table} if $table_name eq uc($table);
536 }
537 return $self->error(qq[Table "$table_name" does not exist]);
538 }
da8ab524 539 return $self->error(qq[Table "$table_name" does not exist])
540 unless exists $self->{'tables'}{$table_name};
541 return $self->{'tables'}{$table_name};
76dce619 542}
543
544# ----------------------------------------------------------------------
545sub get_tables {
546
547=pod
548
549=head2 get_tables
550
551Returns all the tables as an array or array reference.
552
553 my @tables = $schema->get_tables;
554
555=cut
556
557 my $self = shift;
da8ab524 558 my @tables =
559 map { $_->[1] }
560 sort { $a->[0] <=> $b->[0] }
561 map { [ $_->order, $_ ] } values %{ $self->{'tables'} };
76dce619 562
da8ab524 563 if (@tables) {
76dce619 564 return wantarray ? @tables : \@tables;
565 }
566 else {
567 $self->error('No tables');
568 return wantarray ? () : undef;
569 }
570}
571
572# ----------------------------------------------------------------------
daf24e05 573sub get_trigger {
574
575=pod
576
577=head2 get_trigger
578
579Returns a trigger by the name provided.
580
581 my $trigger = $schema->get_trigger('foo');
582
583=cut
584
da8ab524 585 my $self = shift;
daf24e05 586 my $trigger_name = shift or return $self->error('No trigger name');
da8ab524 587 return $self->error(qq[Table "$trigger_name" does not exist])
588 unless exists $self->{'triggers'}{$trigger_name};
589 return $self->{'triggers'}{$trigger_name};
daf24e05 590}
591
592# ----------------------------------------------------------------------
593sub get_triggers {
594
595=pod
596
597=head2 get_triggers
598
599Returns all the triggers as an array or array reference.
600
601 my @triggers = $schema->get_triggers;
602
603=cut
604
da8ab524 605 my $self = shift;
606 my @triggers =
607 map { $_->[1] }
608 sort { $a->[0] <=> $b->[0] }
609 map { [ $_->order, $_ ] } values %{ $self->{'triggers'} };
daf24e05 610
da8ab524 611 if (@triggers) {
daf24e05 612 return wantarray ? @triggers : \@triggers;
613 }
614 else {
615 $self->error('No triggers');
616 return wantarray ? () : undef;
617 }
618}
619
620# ----------------------------------------------------------------------
76dce619 621sub get_view {
622
623=pod
624
625=head2 get_view
626
627Returns a view by the name provided.
628
629 my $view = $schema->get_view('foo');
3c5de62a 630
631=cut
632
da8ab524 633 my $self = shift;
76dce619 634 my $view_name = shift or return $self->error('No view name');
da8ab524 635 return $self->error('View "$view_name" does not exist')
636 unless exists $self->{'views'}{$view_name};
637 return $self->{'views'}{$view_name};
76dce619 638}
3c5de62a 639
76dce619 640# ----------------------------------------------------------------------
641sub get_views {
3c5de62a 642
76dce619 643=pod
644
645=head2 get_views
646
647Returns all the views as an array or array reference.
648
649 my @views = $schema->get_views;
650
651=cut
652
653 my $self = shift;
da8ab524 654 my @views =
655 map { $_->[1] }
656 sort { $a->[0] <=> $b->[0] }
657 map { [ $_->order, $_ ] } values %{ $self->{'views'} };
76dce619 658
da8ab524 659 if (@views) {
76dce619 660 return wantarray ? @views : \@views;
661 }
662 else {
663 $self->error('No views');
664 return wantarray ? () : undef;
665 }
3c5de62a 666}
667
99248301 668# ----------------------------------------------------------------------
9480e70b 669sub make_natural_joins {
670
671=pod
672
673=head2 make_natural_joins
674
675Creates foriegn key relationships among like-named fields in different
676tables. Accepts the following arguments:
677
678=over 4
679
650f87eb 680=item * join_pk_only
9480e70b 681
682A True or False argument which determins whether or not to perform
683the joins from primary keys to fields of the same name in other tables
684
685=item * skip_fields
686
687A list of fields to skip in the joins
688
689=back 4
690
691 $schema->make_natural_joins(
692 join_pk_only => 1,
693 skip_fields => 'name,department_id',
694 );
695
696=cut
697
698 my $self = shift;
699 my %args = @_;
700 my $join_pk_only = $args{'join_pk_only'} || 0;
da8ab524 701 my %skip_fields =
702 map { s/^\s+|\s+$//g; $_, 1 } @{ parse_list_arg( $args{'skip_fields'} ) };
9480e70b 703
704 my ( %common_keys, %pk );
705 for my $table ( $self->get_tables ) {
706 for my $field ( $table->get_fields ) {
707 my $field_name = $field->name or next;
da8ab524 708 next if $skip_fields{$field_name};
709 $pk{$field_name} = 1 if $field->is_primary_key;
710 push @{ $common_keys{$field_name} }, $table->name;
9480e70b 711 }
da8ab524 712 }
713
9480e70b 714 for my $field ( keys %common_keys ) {
da8ab524 715 next if $join_pk_only and !defined $pk{$field};
9480e70b 716
da8ab524 717 my @table_names = @{ $common_keys{$field} };
9480e70b 718 next unless scalar @table_names > 1;
719
720 for my $i ( 0 .. $#table_names ) {
da8ab524 721 my $table1 = $self->get_table( $table_names[$i] ) or next;
9480e70b 722
723 for my $j ( 1 .. $#table_names ) {
da8ab524 724 my $table2 = $self->get_table( $table_names[$j] ) or next;
9480e70b 725 next if $table1->name eq $table2->name;
726
727 $table1->add_constraint(
728 type => FOREIGN_KEY,
729 fields => $field,
730 reference_table => $table2->name,
731 reference_fields => $field,
732 );
650f87eb 733 }
9480e70b 734 }
650f87eb 735 }
9480e70b 736
737 return 1;
738}
739
740# ----------------------------------------------------------------------
99248301 741sub name {
742
743=pod
744
745=head2 name
746
747Get or set the schema's name. (optional)
748
749 my $schema_name = $schema->name('Foo Database');
750
751=cut
752
753 my $self = shift;
754 $self->{'name'} = shift if @_;
755 return $self->{'name'} || '';
756}
757
97382c6d 758# ----------------------------------------------------------------------
759sub translator {
760
761=pod
762
10f36920 763=head2 translator
47fed978 764
97382c6d 765Get the SQL::Translator instance that instantiated the parser.
47fed978 766
767=cut
768
47fed978 769 my $self = shift;
10f36920 770 $self->{'translator'} = shift if @_;
771 return $self->{'translator'};
47fed978 772}
773
d0b43695 774# ----------------------------------------------------------------------
775sub DESTROY {
776 my $self = shift;
777 undef $_ for values %{ $self->{'tables'} };
da8ab524 778 undef $_ for values %{ $self->{'views'} };
d0b43695 779}
780
3c5de62a 7811;
782
783# ----------------------------------------------------------------------
784
785=pod
786
787=head1 AUTHOR
788
97382c6d 789Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
3c5de62a 790
791=cut
da8ab524 792