1 package SQL::Translator::Schema;
3 # ----------------------------------------------------------------------
4 # Copyright (C) 2002-2009 SQLFairy Authors
6 # This program is free software; you can redistribute it and/or
7 # modify it under the terms of the GNU General Public License as
8 # published by the Free Software Foundation; version 2.
10 # This program is distributed in the hope that it will be useful, but
11 # WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 # General Public License for more details.
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
19 # -------------------------------------------------------------------
25 SQL::Translator::Schema - SQL::Translator schema object
29 use SQL::Translator::Schema;
30 my $schema = SQL::Translator::Schema->new(
34 my $table = $schema->add_table( name => 'foo' );
35 my $view = $schema->add_view( name => 'bar', sql => '...' );
40 C<SQL::Translator::Schema> is the object that accepts, validates, and
41 returns the database structure.
48 use SQL::Translator::Schema::Constants;
49 use SQL::Translator::Schema::Procedure;
50 use SQL::Translator::Schema::Table;
51 use SQL::Translator::Schema::Trigger;
52 use SQL::Translator::Schema::View;
54 use SQL::Translator::Utils 'parse_list_arg';
56 use base 'SQL::Translator::Schema::Object';
57 use vars qw[ $VERSION ];
61 __PACKAGE__->_attributes(qw/name database translator/);
65 my $self = $class->SUPER::new (@_)
68 $self->{_order} = { map { $_ => 0 } qw/
84 Returns the schema as an L<SQL::Translator::Schema::Graph> object.
87 require SQL::Translator::Schema::Graph;
91 return SQL::Translator::Schema::Graph->new(
92 translator => $self->translator );
101 Returns a Graph::Directed object with the table names for nodes.
105 require Graph::Directed;
108 my $g = Graph::Directed->new;
110 for my $table ( $self->get_tables ) {
111 my $tname = $table->name;
112 $g->add_vertex( $tname );
114 for my $field ( $table->get_fields ) {
115 if ( $field->is_foreign_key ) {
116 my $fktable = $field->foreign_key_reference->reference_table;
118 $g->add_edge( $fktable, $tname );
132 Add a table object. Returns the new SQL::Translator::Schema::Table object.
133 The "name" parameter is required. If you try to create a table with the
134 same name as an existing table, you will get an error and the table will
137 my $t1 = $schema->add_table( name => 'foo' ) or die $schema->error;
138 my $t2 = SQL::Translator::Schema::Table->new( name => 'bar' );
139 $t2 = $schema->add_table( $table_bar ) or die $schema->error;
144 my $table_class = 'SQL::Translator::Schema::Table';
147 if ( UNIVERSAL::isa( $_[0], $table_class ) ) {
149 $table->schema($self);
152 my %args = ref $_[0] eq 'HASH' ? %{ $_[0] } : @_;
153 $args{'schema'} = $self;
154 $table = $table_class->new( \%args )
155 or return $self->error( $table_class->error );
158 $table->order( ++$self->{_order}{table} );
160 # We know we have a name as the Table->new above errors if none given.
161 my $table_name = $table->name;
163 if ( defined $self->{'tables'}{$table_name} ) {
164 return $self->error(qq[Can't create table: "$table_name" exists]);
167 $self->{'tables'}{$table_name} = $table;
179 Remove a table from the schema. Returns the table object if the table was found
180 and removed, an error otherwise. The single parameter can be either a table
181 name or an C<SQL::Translator::Schema::Table> object. The "cascade" parameter
182 can be set to 1 to also drop all triggers on the table, default is 0.
184 $schema->drop_table('mytable');
185 $schema->drop_table('mytable', cascade => 1);
190 my $table_class = 'SQL::Translator::Schema::Table';
193 if ( UNIVERSAL::isa( $_[0], $table_class ) ) {
194 $table_name = shift->name;
200 my $cascade = $args{'cascade'};
202 if ( !exists $self->{'tables'}{$table_name} ) {
203 return $self->error(qq[Can't drop table: $table_name" doesn't exist]);
206 my $table = delete $self->{'tables'}{$table_name};
210 # Drop all triggers on this table
211 $self->drop_trigger()
212 for ( grep { $_->on_table eq $table_name } @{ $self->{'triggers'} } );
223 Add a procedure object. Returns the new SQL::Translator::Schema::Procedure
224 object. The "name" parameter is required. If you try to create a procedure
225 with the same name as an existing procedure, you will get an error and the
226 procedure will not be created.
228 my $p1 = $schema->add_procedure( name => 'foo' );
229 my $p2 = SQL::Translator::Schema::Procedure->new( name => 'bar' );
230 $p2 = $schema->add_procedure( $procedure_bar ) or die $schema->error;
235 my $procedure_class = 'SQL::Translator::Schema::Procedure';
238 if ( UNIVERSAL::isa( $_[0], $procedure_class ) ) {
240 $procedure->schema($self);
243 my %args = ref $_[0] eq 'HASH' ? %{ $_[0] } : @_;
244 $args{'schema'} = $self;
245 return $self->error('No procedure name') unless $args{'name'};
246 $procedure = $procedure_class->new( \%args )
247 or return $self->error( $procedure_class->error );
250 $procedure->order( ++$self->{_order}{proc} );
251 my $procedure_name = $procedure->name
252 or return $self->error('No procedure name');
254 if ( defined $self->{'procedures'}{$procedure_name} ) {
256 qq[Can't create procedure: "$procedure_name" exists] );
259 $self->{'procedures'}{$procedure_name} = $procedure;
269 =head2 drop_procedure
271 Remove a procedure from the schema. Returns the procedure object if the
272 procedure was found and removed, an error otherwise. The single parameter
273 can be either a procedure name or an C<SQL::Translator::Schema::Procedure>
276 $schema->drop_procedure('myprocedure');
281 my $proc_class = 'SQL::Translator::Schema::Procedure';
284 if ( UNIVERSAL::isa( $_[0], $proc_class ) ) {
285 $proc_name = shift->name;
291 if ( !exists $self->{'procedures'}{$proc_name} ) {
293 qq[Can't drop procedure: $proc_name" doesn't exist]);
296 my $proc = delete $self->{'procedures'}{$proc_name};
307 Add a trigger object. Returns the new SQL::Translator::Schema::Trigger object.
308 The "name" parameter is required. If you try to create a trigger with the
309 same name as an existing trigger, you will get an error and the trigger will
312 my $t1 = $schema->add_trigger( name => 'foo' );
313 my $t2 = SQL::Translator::Schema::Trigger->new( name => 'bar' );
314 $t2 = $schema->add_trigger( $trigger_bar ) or die $schema->error;
319 my $trigger_class = 'SQL::Translator::Schema::Trigger';
322 if ( UNIVERSAL::isa( $_[0], $trigger_class ) ) {
324 $trigger->schema($self);
327 my %args = ref $_[0] eq 'HASH' ? %{ $_[0] } : @_;
328 $args{'schema'} = $self;
329 return $self->error('No trigger name') unless $args{'name'};
330 $trigger = $trigger_class->new( \%args )
331 or return $self->error( $trigger_class->error );
334 $trigger->order( ++$self->{_order}{trigger} );
336 my $trigger_name = $trigger->name or return $self->error('No trigger name');
337 if ( defined $self->{'triggers'}{$trigger_name} ) {
338 return $self->error(qq[Can't create trigger: "$trigger_name" exists]);
341 $self->{'triggers'}{$trigger_name} = $trigger;
353 Remove a trigger from the schema. Returns the trigger object if the trigger was
354 found and removed, an error otherwise. The single parameter can be either a
355 trigger name or an C<SQL::Translator::Schema::Trigger> object.
357 $schema->drop_trigger('mytrigger');
362 my $trigger_class = 'SQL::Translator::Schema::Trigger';
365 if ( UNIVERSAL::isa( $_[0], $trigger_class ) ) {
366 $trigger_name = shift->name;
369 $trigger_name = shift;
372 if ( !exists $self->{'triggers'}{$trigger_name} ) {
374 qq[Can't drop trigger: $trigger_name" doesn't exist]);
377 my $trigger = delete $self->{'triggers'}{$trigger_name};
388 Add a view object. Returns the new SQL::Translator::Schema::View object.
389 The "name" parameter is required. If you try to create a view with the
390 same name as an existing view, you will get an error and the view will
393 my $v1 = $schema->add_view( name => 'foo' );
394 my $v2 = SQL::Translator::Schema::View->new( name => 'bar' );
395 $v2 = $schema->add_view( $view_bar ) or die $schema->error;
400 my $view_class = 'SQL::Translator::Schema::View';
403 if ( UNIVERSAL::isa( $_[0], $view_class ) ) {
405 $view->schema($self);
408 my %args = ref $_[0] eq 'HASH' ? %{ $_[0] } : @_;
409 $args{'schema'} = $self;
410 return $self->error('No view name') unless $args{'name'};
411 $view = $view_class->new( \%args ) or return $view_class->error;
414 $view->order( ++$self->{_order}{view} );
415 my $view_name = $view->name or return $self->error('No view name');
417 if ( defined $self->{'views'}{$view_name} ) {
418 return $self->error(qq[Can't create view: "$view_name" exists]);
421 $self->{'views'}{$view_name} = $view;
433 Remove a view from the schema. Returns the view object if the view was found
434 and removed, an error otherwise. The single parameter can be either a view
435 name or an C<SQL::Translator::Schema::View> object.
437 $schema->drop_view('myview');
442 my $view_class = 'SQL::Translator::Schema::View';
445 if ( UNIVERSAL::isa( $_[0], $view_class ) ) {
446 $view_name = shift->name;
452 if ( !exists $self->{'views'}{$view_name} ) {
453 return $self->error(qq[Can't drop view: $view_name" doesn't exist]);
456 my $view = delete $self->{'views'}{$view_name};
467 Get or set the schema's database. (optional)
469 my $database = $schema->database('PostgreSQL');
474 $self->{'database'} = shift if @_;
475 return $self->{'database'} || '';
484 Returns true if all the tables and views are valid.
486 my $ok = $schema->is_valid or die $schema->error;
492 return $self->error('No tables') unless $self->get_tables;
494 for my $object ( $self->get_tables, $self->get_views ) {
495 return $object->error unless $object->is_valid;
507 Returns a procedure by the name provided.
509 my $procedure = $schema->get_procedure('foo');
514 my $procedure_name = shift or return $self->error('No procedure name');
515 return $self->error(qq[Table "$procedure_name" does not exist])
516 unless exists $self->{'procedures'}{$procedure_name};
517 return $self->{'procedures'}{$procedure_name};
524 =head2 get_procedures
526 Returns all the procedures as an array or array reference.
528 my @procedures = $schema->get_procedures;
535 sort { $a->[0] <=> $b->[0] }
536 map { [ $_->order, $_ ] } values %{ $self->{'procedures'} };
539 return wantarray ? @procedures : \@procedures;
542 $self->error('No procedures');
543 return wantarray ? () : undef;
553 Returns a table by the name provided.
555 my $table = $schema->get_table('foo');
560 my $table_name = shift or return $self->error('No table name');
561 my $case_insensitive = shift;
562 if ( $case_insensitive ) {
563 $table_name = uc($table_name);
564 foreach my $table ( keys %{$self->{tables}} ) {
565 return $self->{tables}{$table} if $table_name eq uc($table);
567 return $self->error(qq[Table "$table_name" does not exist]);
569 return $self->error(qq[Table "$table_name" does not exist])
570 unless exists $self->{'tables'}{$table_name};
571 return $self->{'tables'}{$table_name};
580 Returns all the tables as an array or array reference.
582 my @tables = $schema->get_tables;
589 sort { $a->[0] <=> $b->[0] }
590 map { [ $_->order, $_ ] } values %{ $self->{'tables'} };
593 return wantarray ? @tables : \@tables;
596 $self->error('No tables');
597 return wantarray ? () : undef;
607 Returns a trigger by the name provided.
609 my $trigger = $schema->get_trigger('foo');
614 my $trigger_name = shift or return $self->error('No trigger name');
615 return $self->error(qq[Table "$trigger_name" does not exist])
616 unless exists $self->{'triggers'}{$trigger_name};
617 return $self->{'triggers'}{$trigger_name};
626 Returns all the triggers as an array or array reference.
628 my @triggers = $schema->get_triggers;
635 sort { $a->[0] <=> $b->[0] }
636 map { [ $_->order, $_ ] } values %{ $self->{'triggers'} };
639 return wantarray ? @triggers : \@triggers;
642 $self->error('No triggers');
643 return wantarray ? () : undef;
653 Returns a view by the name provided.
655 my $view = $schema->get_view('foo');
660 my $view_name = shift or return $self->error('No view name');
661 return $self->error('View "$view_name" does not exist')
662 unless exists $self->{'views'}{$view_name};
663 return $self->{'views'}{$view_name};
672 Returns all the views as an array or array reference.
674 my @views = $schema->get_views;
681 sort { $a->[0] <=> $b->[0] }
682 map { [ $_->order, $_ ] } values %{ $self->{'views'} };
685 return wantarray ? @views : \@views;
688 $self->error('No views');
689 return wantarray ? () : undef;
693 sub make_natural_joins {
697 =head2 make_natural_joins
699 Creates foriegn key relationships among like-named fields in different
700 tables. Accepts the following arguments:
706 A True or False argument which determins whether or not to perform
707 the joins from primary keys to fields of the same name in other tables
711 A list of fields to skip in the joins
715 $schema->make_natural_joins(
717 skip_fields => 'name,department_id',
724 my $join_pk_only = $args{'join_pk_only'} || 0;
726 map { s/^\s+|\s+$//g; $_, 1 } @{ parse_list_arg( $args{'skip_fields'} ) };
728 my ( %common_keys, %pk );
729 for my $table ( $self->get_tables ) {
730 for my $field ( $table->get_fields ) {
731 my $field_name = $field->name or next;
732 next if $skip_fields{$field_name};
733 $pk{$field_name} = 1 if $field->is_primary_key;
734 push @{ $common_keys{$field_name} }, $table->name;
738 for my $field ( keys %common_keys ) {
739 next if $join_pk_only and !defined $pk{$field};
741 my @table_names = @{ $common_keys{$field} };
742 next unless scalar @table_names > 1;
744 for my $i ( 0 .. $#table_names ) {
745 my $table1 = $self->get_table( $table_names[$i] ) or next;
747 for my $j ( 1 .. $#table_names ) {
748 my $table2 = $self->get_table( $table_names[$j] ) or next;
749 next if $table1->name eq $table2->name;
751 $table1->add_constraint(
754 reference_table => $table2->name,
755 reference_fields => $field,
770 Get or set the schema's name. (optional)
772 my $schema_name = $schema->name('Foo Database');
777 $self->{'name'} = shift if @_;
778 return $self->{'name'} || '';
787 Get the SQL::Translator instance that instantiated the parser.
792 $self->{'translator'} = shift if @_;
793 return $self->{'translator'};
798 undef $_ for values %{ $self->{'tables'} };
799 undef $_ for values %{ $self->{'views'} };
808 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.