Modfied fields() to return empty array when there are no fields
[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Schema.pm
1 package SQL::Translator::Schema;
2
3 # vim: sw=4: ts=4:
4
5 # ----------------------------------------------------------------------
6 # $Id: Schema.pm,v 1.24 2005-06-27 22:02:50 duality72 Exp $
7 # ----------------------------------------------------------------------
8 # Copyright (C) 2002-4 SQLFairy Authors
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
29 SQL::Translator::Schema - SQL::Translator schema object
30
31 =head1 SYNOPSIS
32
33   use SQL::Translator::Schema;
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
41
42 =head1 DESCSIPTION
43
44 C<SQL::Translator::Schema> is the object that accepts, validates, and
45 returns the database structure.
46
47 =head1 METHODS
48
49 =cut
50
51 use strict;
52 use SQL::Translator::Schema::Constants;
53 use SQL::Translator::Schema::Procedure;
54 use SQL::Translator::Schema::Table;
55 use SQL::Translator::Schema::Trigger;
56 use SQL::Translator::Schema::View;
57 use SQL::Translator::Schema::Graph;
58 use SQL::Translator::Utils 'parse_list_arg';
59
60 use base 'SQL::Translator::Schema::Object';
61 use vars qw[ $VERSION $TABLE_ORDER $VIEW_ORDER $TRIGGER_ORDER $PROC_ORDER ];
62
63 $VERSION = sprintf "%d.%02d", q$Revision: 1.24 $ =~ /(\d+)\.(\d+)/;
64
65 __PACKAGE__->_attributes(qw/name database translator/);
66
67 # ----------------------------------------------------------------------
68 sub as_graph {
69
70 =pod
71
72 =head2 as_graph
73
74 Returns the schema as an L<SQL::Translator::Schema::Graph> object.
75
76 =cut
77
78     my $self = shift;
79     return SQL::Translator::Schema::Graph->new(
80         translator => $self->translator );
81 }
82
83 # ----------------------------------------------------------------------
84 sub add_table {
85
86 =pod
87
88 =head2 add_table
89
90 Add a table object.  Returns the new SQL::Translator::Schema::Table object.
91 The "name" parameter is required.  If you try to create a table with the
92 same name as an existing table, you will get an error and the table will 
93 not be created.
94
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;
98
99 =cut
100
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;
107         $table->schema($self);
108     }
109     else {
110         my %args = @_;
111         $args{'schema'} = $self;
112         $table = $table_class->new( \%args )
113           or return $self->error( $table_class->error );
114     }
115
116     $table->order( ++$TABLE_ORDER );
117
118     # We know we have a name as the Table->new above errors if none given.
119     my $table_name = $table->name;
120
121     if ( defined $self->{'tables'}{$table_name} ) {
122         return $self->error(qq[Can't create table: "$table_name" exists]);
123     }
124     else {
125         $self->{'tables'}{$table_name} = $table;
126     }
127
128     return $table;
129 }
130
131 # ----------------------------------------------------------------------
132 sub drop_table {
133
134 =pod
135
136 =head2 drop_table
137
138 Remove a table from the schema. Returns the table object if the table was found
139 and removed, an error otherwise. The single parameter can be either a table
140 name or an C<SQL::Translator::Schema::Table> object. The "cascade" parameter
141 can 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
148     my $self        = shift;
149     my $table_class = 'SQL::Translator::Schema::Table';
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     }
158     my %args    = @_;
159     my $cascade = $args{'cascade'};
160
161     if ( !exists $self->{'tables'}{$table_name} ) {
162         return $self->error(qq[Can't drop table: $table_name" doesn't exist]);
163     }
164
165     my $table = delete $self->{'tables'}{$table_name};
166
167     if ($cascade) {
168
169         # Drop all triggers on this table
170         $self->drop_trigger()
171           for ( grep { $_->on_table eq $table_name } @{ $self->{'triggers'} } );
172     }
173     return $table;
174 }
175
176 # ----------------------------------------------------------------------
177 sub add_procedure {
178
179 =pod
180
181 =head2 add_procedure
182
183 Add a procedure object.  Returns the new SQL::Translator::Schema::Procedure
184 object.  The "name" parameter is required.  If you try to create a procedure
185 with the same name as an existing procedure, you will get an error and the
186 procedure will not be created.
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;
200         $procedure->schema($self);
201     }
202     else {
203         my %args = @_;
204         $args{'schema'} = $self;
205         return $self->error('No procedure name') unless $args{'name'};
206         $procedure = $procedure_class->new( \%args )
207           or return $self->error( $procedure_class->error );
208     }
209
210     $procedure->order( ++$PROC_ORDER );
211     my $procedure_name = $procedure->name
212       or return $self->error('No procedure name');
213
214     if ( defined $self->{'procedures'}{$procedure_name} ) {
215         return $self->error(
216             qq[Can't create procedure: "$procedure_name" exists] );
217     }
218     else {
219         $self->{'procedures'}{$procedure_name} = $procedure;
220     }
221
222     return $procedure;
223 }
224
225 # ----------------------------------------------------------------------
226 sub drop_procedure {
227
228 =pod
229
230 =head2 drop_procedure
231
232 Remove a procedure from the schema. Returns the procedure object if the
233 procedure was found and removed, an error otherwise. The single parameter
234 can be either a procedure name or an C<SQL::Translator::Schema::Procedure>
235 object.
236
237   $schema->drop_procedure('myprocedure');
238
239 =cut
240
241     my $self       = shift;
242     my $proc_class = 'SQL::Translator::Schema::Procedure';
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
252     if ( !exists $self->{'procedures'}{$proc_name} ) {
253         return $self->error(
254             qq[Can't drop procedure: $proc_name" doesn't exist]);
255     }
256
257     my $proc = delete $self->{'procedures'}{$proc_name};
258
259     return $proc;
260 }
261
262 # ----------------------------------------------------------------------
263 sub add_trigger {
264
265 =pod
266
267 =head2 add_trigger
268
269 Add a trigger object.  Returns the new SQL::Translator::Schema::Trigger object.
270 The "name" parameter is required.  If you try to create a trigger with the
271 same name as an existing trigger, you will get an error and the trigger will 
272 not 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;
286         $trigger->schema($self);
287     }
288     else {
289         my %args = @_;
290         $args{'schema'} = $self;
291         return $self->error('No trigger name') unless $args{'name'};
292         $trigger = $trigger_class->new( \%args )
293           or return $self->error( $trigger_class->error );
294     }
295
296     $trigger->order( ++$TRIGGER_ORDER );
297     my $trigger_name = $trigger->name or return $self->error('No trigger name');
298
299     if ( defined $self->{'triggers'}{$trigger_name} ) {
300         return $self->error(qq[Can't create trigger: "$trigger_name" exists]);
301     }
302     else {
303         $self->{'triggers'}{$trigger_name} = $trigger;
304     }
305
306     return $trigger;
307 }
308
309 # ----------------------------------------------------------------------
310 sub drop_trigger {
311
312 =pod
313
314 =head2 drop_trigger
315
316 Remove a trigger from the schema. Returns the trigger object if the trigger was
317 found and removed, an error otherwise. The single parameter can be either a
318 trigger name or an C<SQL::Translator::Schema::Trigger> object.
319
320   $schema->drop_trigger('mytrigger');
321
322 =cut
323
324     my $self          = shift;
325     my $trigger_class = 'SQL::Translator::Schema::Trigger';
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
335     if ( !exists $self->{'triggers'}{$trigger_name} ) {
336         return $self->error(
337             qq[Can't drop trigger: $trigger_name" doesn't exist]);
338     }
339
340     my $trigger = delete $self->{'triggers'}{$trigger_name};
341
342     return $trigger;
343 }
344
345 # ----------------------------------------------------------------------
346 sub add_view {
347
348 =pod
349
350 =head2 add_view
351
352 Add a view object.  Returns the new SQL::Translator::Schema::View object.
353 The "name" parameter is required.  If you try to create a view with the
354 same name as an existing view, you will get an error and the view will 
355 not be created.
356
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;
360
361 =cut
362
363     my $self       = shift;
364     my $view_class = 'SQL::Translator::Schema::View';
365     my $view;
366
367     if ( UNIVERSAL::isa( $_[0], $view_class ) ) {
368         $view = shift;
369         $view->schema($self);
370     }
371     else {
372         my %args = @_;
373         $args{'schema'} = $self;
374         return $self->error('No view name') unless $args{'name'};
375         $view = $view_class->new( \%args ) or return $view_class->error;
376     }
377
378     $view->order( ++$VIEW_ORDER );
379     my $view_name = $view->name or return $self->error('No view name');
380
381     if ( defined $self->{'views'}{$view_name} ) {
382         return $self->error(qq[Can't create view: "$view_name" exists]);
383     }
384     else {
385         $self->{'views'}{$view_name} = $view;
386     }
387
388     return $view;
389 }
390
391 # ----------------------------------------------------------------------
392 sub drop_view {
393
394 =pod
395
396 =head2 drop_view
397
398 Remove a view from the schema. Returns the view object if the view was found
399 and removed, an error otherwise. The single parameter can be either a view
400 name or an C<SQL::Translator::Schema::View> object.
401
402   $schema->drop_view('myview');
403
404 =cut
405
406     my $self       = shift;
407     my $view_class = 'SQL::Translator::Schema::View';
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
417     if ( !exists $self->{'views'}{$view_name} ) {
418         return $self->error(qq[Can't drop view: $view_name" doesn't exist]);
419     }
420
421     my $view = delete $self->{'views'}{$view_name};
422
423     return $view;
424 }
425
426 # ----------------------------------------------------------------------
427 sub database {
428
429 =pod
430
431 =head2 database
432
433 Get 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 # ----------------------------------------------------------------------
445 sub is_valid {
446
447 =pod
448
449 =head2 is_valid
450
451 Returns true if all the tables and views are valid.
452
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 # ----------------------------------------------------------------------
469 sub get_procedure {
470
471 =pod
472
473 =head2 get_procedure
474
475 Returns a procedure by the name provided.
476
477   my $procedure = $schema->get_procedure('foo');
478
479 =cut
480
481     my $self = shift;
482     my $procedure_name = shift or return $self->error('No procedure name');
483     return $self->error(qq[Table "$procedure_name" does not exist])
484       unless exists $self->{'procedures'}{$procedure_name};
485     return $self->{'procedures'}{$procedure_name};
486 }
487
488 # ----------------------------------------------------------------------
489 sub get_procedures {
490
491 =pod
492
493 =head2 get_procedures
494
495 Returns all the procedures as an array or array reference.
496
497   my @procedures = $schema->get_procedures;
498
499 =cut
500
501     my $self       = shift;
502     my @procedures =
503       map  { $_->[1] }
504       sort { $a->[0] <=> $b->[0] }
505       map  { [ $_->order, $_ ] } values %{ $self->{'procedures'} };
506
507     if (@procedures) {
508         return wantarray ? @procedures : \@procedures;
509     }
510     else {
511         $self->error('No procedures');
512         return wantarray ? () : undef;
513     }
514 }
515
516 # ----------------------------------------------------------------------
517 sub get_table {
518
519 =pod
520
521 =head2 get_table
522
523 Returns a table by the name provided.
524
525   my $table = $schema->get_table('foo');
526
527 =cut
528
529     my $self = shift;
530     my $table_name = shift or return $self->error('No table name');
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     }
539     return $self->error(qq[Table "$table_name" does not exist])
540       unless exists $self->{'tables'}{$table_name};
541     return $self->{'tables'}{$table_name};
542 }
543
544 # ----------------------------------------------------------------------
545 sub get_tables {
546
547 =pod
548
549 =head2 get_tables
550
551 Returns all the tables as an array or array reference.
552
553   my @tables = $schema->get_tables;
554
555 =cut
556
557     my $self   = shift;
558     my @tables =
559       map  { $_->[1] }
560       sort { $a->[0] <=> $b->[0] }
561       map  { [ $_->order, $_ ] } values %{ $self->{'tables'} };
562
563     if (@tables) {
564         return wantarray ? @tables : \@tables;
565     }
566     else {
567         $self->error('No tables');
568         return wantarray ? () : undef;
569     }
570 }
571
572 # ----------------------------------------------------------------------
573 sub get_trigger {
574
575 =pod
576
577 =head2 get_trigger
578
579 Returns a trigger by the name provided.
580
581   my $trigger = $schema->get_trigger('foo');
582
583 =cut
584
585     my $self = shift;
586     my $trigger_name = shift or return $self->error('No trigger name');
587     return $self->error(qq[Table "$trigger_name" does not exist])
588       unless exists $self->{'triggers'}{$trigger_name};
589     return $self->{'triggers'}{$trigger_name};
590 }
591
592 # ----------------------------------------------------------------------
593 sub get_triggers {
594
595 =pod
596
597 =head2 get_triggers
598
599 Returns all the triggers as an array or array reference.
600
601   my @triggers = $schema->get_triggers;
602
603 =cut
604
605     my $self     = shift;
606     my @triggers =
607       map  { $_->[1] }
608       sort { $a->[0] <=> $b->[0] }
609       map  { [ $_->order, $_ ] } values %{ $self->{'triggers'} };
610
611     if (@triggers) {
612         return wantarray ? @triggers : \@triggers;
613     }
614     else {
615         $self->error('No triggers');
616         return wantarray ? () : undef;
617     }
618 }
619
620 # ----------------------------------------------------------------------
621 sub get_view {
622
623 =pod
624
625 =head2 get_view
626
627 Returns a view by the name provided.
628
629   my $view = $schema->get_view('foo');
630
631 =cut
632
633     my $self = shift;
634     my $view_name = shift or return $self->error('No view name');
635     return $self->error('View "$view_name" does not exist')
636       unless exists $self->{'views'}{$view_name};
637     return $self->{'views'}{$view_name};
638 }
639
640 # ----------------------------------------------------------------------
641 sub get_views {
642
643 =pod
644
645 =head2 get_views
646
647 Returns all the views as an array or array reference.
648
649   my @views = $schema->get_views;
650
651 =cut
652
653     my $self  = shift;
654     my @views =
655       map  { $_->[1] }
656       sort { $a->[0] <=> $b->[0] }
657       map  { [ $_->order, $_ ] } values %{ $self->{'views'} };
658
659     if (@views) {
660         return wantarray ? @views : \@views;
661     }
662     else {
663         $self->error('No views');
664         return wantarray ? () : undef;
665     }
666 }
667
668 # ----------------------------------------------------------------------
669 sub make_natural_joins {
670
671 =pod
672
673 =head2 make_natural_joins
674
675 Creates foriegn key relationships among like-named fields in different
676 tables.  Accepts the following arguments:
677
678 =over 4
679
680 =item * join_pk_only
681
682 A True or False argument which determins whether or not to perform 
683 the joins from primary keys to fields of the same name in other tables
684
685 =item * skip_fields
686
687 A 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;
701     my %skip_fields  =
702       map { s/^\s+|\s+$//g; $_, 1 } @{ parse_list_arg( $args{'skip_fields'} ) };
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;
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;
711         }
712     }
713
714     for my $field ( keys %common_keys ) {
715         next if $join_pk_only and !defined $pk{$field};
716
717         my @table_names = @{ $common_keys{$field} };
718         next unless scalar @table_names > 1;
719
720         for my $i ( 0 .. $#table_names ) {
721             my $table1 = $self->get_table( $table_names[$i] ) or next;
722
723             for my $j ( 1 .. $#table_names ) {
724                 my $table2 = $self->get_table( $table_names[$j] ) or next;
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                 );
733             }
734         }
735     }
736
737     return 1;
738 }
739
740 # ----------------------------------------------------------------------
741 sub name {
742
743 =pod
744
745 =head2 name
746
747 Get 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
758 # ----------------------------------------------------------------------
759 sub translator {
760
761 =pod
762
763 =head2 translator
764
765 Get the SQL::Translator instance that instantiated the parser.
766
767 =cut
768
769     my $self = shift;
770     $self->{'translator'} = shift if @_;
771     return $self->{'translator'};
772 }
773
774 # ----------------------------------------------------------------------
775 sub DESTROY {
776     my $self = shift;
777     undef $_ for values %{ $self->{'tables'} };
778     undef $_ for values %{ $self->{'views'} };
779 }
780
781 1;
782
783 # ----------------------------------------------------------------------
784
785 =pod
786
787 =head1 AUTHOR
788
789 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
790
791 =cut
792