X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FSchema%2FTable.pm;h=b9c1247d9f73630982e8d1b16f787d28c9d2f2c1;hb=b178940934ec79968ed16511ec2644f3736c92f2;hp=047699288ffa34e6461a14f2523ba4a7b0939cfe;hpb=69c7a62f38fa4519a8cdb14bed4af37f2c6206ff;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Schema/Table.pm b/lib/SQL/Translator/Schema/Table.pm index 0476992..b9c1247 100644 --- a/lib/SQL/Translator/Schema/Table.pm +++ b/lib/SQL/Translator/Schema/Table.pm @@ -1,9 +1,9 @@ package SQL::Translator::Schema::Table; # ---------------------------------------------------------------------- -# $Id: Table.pm,v 1.15 2003-08-29 05:38:56 allenday Exp $ +# $Id: Table.pm,v 1.29 2004-11-05 15:03:10 grommit Exp $ # ---------------------------------------------------------------------- -# Copyright (C) 2003 Ken Y. Clark +# Copyright (C) 2002-4 SQLFairy Authors # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License as @@ -40,20 +40,32 @@ C is the table object. =cut use strict; -use Class::Base; use SQL::Translator::Utils 'parse_list_arg'; use SQL::Translator::Schema::Constants; use SQL::Translator::Schema::Constraint; use SQL::Translator::Schema::Field; use SQL::Translator::Schema::Index; +use Data::Dumper; + +use base 'SQL::Translator::Schema::Object'; -use base 'Class::Base'; use vars qw( $VERSION $FIELD_ORDER ); -$VERSION = sprintf "%d.%02d", q$Revision: 1.15 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.29 $ =~ /(\d+)\.(\d+)/; + + +# Stringify to our name, being careful not to pass any args through so we don't +# accidentally set it to undef. We also have to tweak bool so the object is +# still true when it doesn't have a name (which shouldn't happen!). +use overload + '""' => sub { shift->name }, + 'bool' => sub { $_[0]->name || $_[0] }, + fallback => 1, +; # ---------------------------------------------------------------------- -sub init { + +__PACKAGE__->_attributes( qw/schema name comments options order/ ); =pod @@ -68,16 +80,6 @@ Object constructor. =cut - my ( $self, $config ) = @_; - - for my $arg ( qw[ schema name comments ] ) { - next unless defined $config->{ $arg }; - defined $self->$arg( $config->{ $arg } ) or return; - } - - return $self; -} - # ---------------------------------------------------------------------- sub add_constraint { @@ -88,10 +90,10 @@ sub add_constraint { Add a constraint to the table. Returns the newly created C object. - my $c1 = $table->add_constraint( - name => 'pk', - type => PRIMARY_KEY, - fields => [ 'foo_id' ], + my $c1 = $table->add_constraint( + name => 'pk', + type => PRIMARY_KEY, + fields => [ 'foo_id' ], ); my $c2 = SQL::Translator::Schema::Constraint->new( name => 'uniq' ); @@ -111,7 +113,7 @@ C object. my %args = @_; $args{'table'} = $self; $constraint = $constraint_class->new( \%args ) or - return $self->error( $constraint_class->error ); + return $self->error( $constraint_class->error ); } # @@ -122,6 +124,9 @@ C object. my $pk = $self->primary_key; if ( $pk && $constraint->type eq PRIMARY_KEY ) { $self->primary_key( $constraint->fields ); + $pk->name($constraint->name) if $constraint->name; + my %extra = $constraint->extra; + $pk->extra(%extra) if keys %extra; $constraint = $pk; $ok = 0; } @@ -134,25 +139,25 @@ C object. } # # See if another constraint of the same type - # covers the same fields. + # covers the same fields. -- This doesn't work! ky # - elsif ( $constraint->type ne CHECK_C ) { - my @field_names = $constraint->fields; - for my $c ( - grep { $_->type eq $constraint->type } - $self->get_constraints - ) { - my %fields = map { $_, 1 } $c->fields; - for my $field_name ( @field_names ) { - if ( $fields{ $field_name } ) { - $constraint = $c; - $ok = 0; - last; - } - } - last unless $ok; - } - } +# elsif ( $constraint->type ne CHECK_C ) { +# my @field_names = $constraint->fields; +# for my $c ( +# grep { $_->type eq $constraint->type } +# $self->get_constraints +# ) { +# my %fields = map { $_, 1 } $c->fields; +# for my $field_name ( @field_names ) { +# if ( $fields{ $field_name } ) { +# $constraint = $c; +# $ok = 0; +# last; +# } +# } +# last unless $ok; +# } +# } if ( $ok ) { push @{ $self->{'constraints'} }, $constraint; @@ -171,7 +176,7 @@ sub add_index { Add an index to the table. Returns the newly created C object. - my $i1 = $table->add_index( + my $i1 = $table->add_index( name => 'name', fields => [ 'name' ], type => 'normal', @@ -213,17 +218,17 @@ C object. The "name" parameter is required. If you try to create a field with the same name as an existing field, you will get an error and the field will not be created. - my $f1 = $table->add_field( + my $f1 = $table->add_field( name => 'foo_id', data_type => 'integer', size => 11, ); - my $f2 = SQL::Translator::Schema::Field->new( + my $f2 = SQL::Translator::Schema::Field->new( name => 'name', table => $table, ); - $f2 = $table->add_field( $field2 ) or die $table->error; + $f2 = $table->add_field( $field2 ) or die $table->error; =cut @@ -243,10 +248,11 @@ existing field, you will get an error and the field will not be created. } $field->order( ++$FIELD_ORDER ); - my $field_name = $field->name or return $self->error('No name'); + # We know we have a name as the Field->new above errors if none given. + my $field_name = $field->name; if ( exists $self->{'fields'}{ $field_name } ) { - return $self->error(qq[Can\'t create field: "$field_name" exists]); + return $self->error(qq[Can't create field: "$field_name" exists]); } else { $self->{'fields'}{ $field_name } = $field; @@ -418,22 +424,67 @@ Determine whether the view is valid or not. return 1; } -sub is_data { - my $self = shift; - return $self->{'is_data'} if defined $self->{'is_data'}; +# ---------------------------------------------------------------------- +sub is_trivial_link { + +=pod - $self->{'is_data'} = 0; +=head2 is_trivial_link - foreach my $field ($self->get_fields){ - if(!$field->is_primary_key or !$field->is_foreign_key){ - $self->{'is_data'} = 1; - return $self->{'is_data'} +True if table has no data (non-key) fields and only uses single key joins. + +=cut + + my $self = shift; + return 0 if $self->is_data; + return $self->{'is_trivial_link'} if defined $self->{'is_trivial_link'}; + + $self->{'is_trivial_link'} = 1; + + my %fk = (); + + foreach my $field ( $self->get_fields ) { + next unless $field->is_foreign_key; + $fk{$field->foreign_key_reference->reference_table}++; } - } - return $self->{'is_data'}; + foreach my $referenced (keys %fk){ + if($fk{$referenced} > 1){ + $self->{'is_trivial_link'} = 0; + last; + } + } + + return $self->{'is_trivial_link'}; + +} + +sub is_data { + +=pod + +=head2 is_data + +Returns true if the table has some non-key fields. + +=cut + + my $self = shift; + return $self->{'is_data'} if defined $self->{'is_data'}; + + $self->{'is_data'} = 0; + + foreach my $field ( $self->get_fields ) { + if ( !$field->is_primary_key and !$field->is_foreign_key ) { + $self->{'is_data'} = 1; + return $self->{'is_data'}; + } + } + + return $self->{'is_data'}; } +# ---------------------------------------------------------------------- sub can_link { =pod @@ -446,42 +497,83 @@ Determine whether the table can link two arg tables via many-to-many. =cut - my($self,$table1,$table2) = @_; + my ( $self, $table1, $table2 ) = @_; + + return $self->{'can_link'}{ $table1->name }{ $table2->name } + if defined $self->{'can_link'}{ $table1->name }{ $table2->name }; - #get tables in abc order - ($table1,$table2) = sort {$a->name cmp $b->name} ($table1,$table2); + if ( $self->is_data == 1 ) { + $self->{'can_link'}{ $table1->name }{ $table2->name } = [0]; + $self->{'can_link'}{ $table2->name }{ $table1->name } = [0]; + return $self->{'can_link'}{ $table1->name }{ $table2->name }; + } - return $self->{'can_link'}{$table1->name}{$table2->name} if defined $self->{'can_link'}{$table1->name}{$table2->name}; + my %fk = (); - if($self->is_data == 1){ - $self->{'can_link'}{$table1->name}{$table2->name} = 0; - return $self->{'can_link'}{$table1->name}{$table2->name}; - } + foreach my $field ( $self->get_fields ) { + if ( $field->is_foreign_key ) { + push @{ $fk{ $field->foreign_key_reference->reference_table } }, + $field->foreign_key_reference; + } + } - my %fk = (); + if ( !defined( $fk{ $table1->name } ) or !defined( $fk{ $table2->name } ) ) + { + $self->{'can_link'}{ $table1->name }{ $table2->name } = [0]; + $self->{'can_link'}{ $table2->name }{ $table1->name } = [0]; + return $self->{'can_link'}{ $table1->name }{ $table2->name }; + } - foreach my $field ($self->get_fields){ - #if the table has non-key fields, it can't be a link - if(!$field->is_primary_key or !$field->is_foreign_key){ - $self->{'can_link'}{$table1->name}{$table2->name} = 0; - return $self->{'can_link'}{$table1->name}{$table2->name}; + # trivial traversal, only one way to link the two tables + if ( scalar( @{ $fk{ $table1->name } } == 1 ) + and scalar( @{ $fk{ $table2->name } } == 1 ) ) + { + $self->{'can_link'}{ $table1->name }{ $table2->name } = + [ 'one2one', $fk{ $table1->name }, $fk{ $table2->name } ]; + $self->{'can_link'}{ $table1->name }{ $table2->name } = + [ 'one2one', $fk{ $table2->name }, $fk{ $table1->name } ]; + + # non-trivial traversal. one way to link table2, + # many ways to link table1 + } + elsif ( scalar( @{ $fk{ $table1->name } } > 1 ) + and scalar( @{ $fk{ $table2->name } } == 1 ) ) + { + $self->{'can_link'}{ $table1->name }{ $table2->name } = + [ 'many2one', $fk{ $table1->name }, $fk{ $table2->name } ]; + $self->{'can_link'}{ $table2->name }{ $table1->name } = + [ 'one2many', $fk{ $table2->name }, $fk{ $table1->name } ]; + + # non-trivial traversal. one way to link table1, + # many ways to link table2 + } + elsif ( scalar( @{ $fk{ $table1->name } } == 1 ) + and scalar( @{ $fk{ $table2->name } } > 1 ) ) + { + $self->{'can_link'}{ $table1->name }{ $table2->name } = + [ 'one2many', $fk{ $table1->name }, $fk{ $table2->name } ]; + $self->{'can_link'}{ $table2->name }{ $table1->name } = + [ 'many2one', $fk{ $table2->name }, $fk{ $table1->name } ]; + + # non-trivial traversal. many ways to link table1 and table2 + } + elsif ( scalar( @{ $fk{ $table1->name } } > 1 ) + and scalar( @{ $fk{ $table2->name } } > 1 ) ) + { + $self->{'can_link'}{ $table1->name }{ $table2->name } = + [ 'many2many', $fk{ $table1->name }, $fk{ $table2->name } ]; + $self->{'can_link'}{ $table2->name }{ $table1->name } = + [ 'many2many', $fk{ $table2->name }, $fk{ $table1->name } ]; + + # one of the tables didn't export a key + # to this table, no linking possible + } + else { + $self->{'can_link'}{ $table1->name }{ $table2->name } = [0]; + $self->{'can_link'}{ $table2->name }{ $table1->name } = [0]; + } - #otherwise, count up how many fields refer to each FK table.field - } elsif($field->is_foreign_key){ - $fk{$field->foreign_key_reference->reference_table->name}++; - } - } - - if($fk{ $table1->name } == 1 - and - $fk{ $table2->name } == 1 - ){ - $self->{'can_link'}{$table1->name}{$table2->name} = 1; - } else { - $self->{'can_link'}{$table1->name}{$table2->name} = 0; - } - - return $self->{'can_link'}{$table1->name}{$table2->name}; + return $self->{'can_link'}{ $table1->name }{ $table2->name }; } # ---------------------------------------------------------------------- @@ -491,10 +583,13 @@ sub name { =head2 name -Get or set the table\'s name. +Get or set the table's name. -If provided an argument, checks the schema object for a table of -that name and disallows the change if one exists. +Errors ("No table name") if you try to set a blank name. + +If provided an argument, checks the schema object for a table of +that name and disallows the change if one exists (setting the error to +"Can't use table name "%s": table exists"). my $table_name = $table->name('foo'); @@ -502,9 +597,10 @@ that name and disallows the change if one exists. my $self = shift; - if ( my $arg = shift ) { + if ( @_ ) { + my $arg = shift || return $self->error( "No table name" ); if ( my $schema = $self->schema ) { - return $self->error( qq[Can\'t use table name "$arg": table exists] ) + return $self->error( qq[Can't use table name "$arg": table exists] ) if $schema->get_table( $arg ); } $self->{'name'} = $arg; @@ -520,7 +616,7 @@ sub schema { =head2 schema -Get or set the table\'s schema object. +Get or set the table's schema object. my $schema = $table->schema; @@ -541,9 +637,9 @@ sub primary_key { =pod -=head2 options +=head2 primary_key -Gets or sets the table\'s primary key(s). Takes one or more field +Gets or sets the table's primary key(s). Takes one or more field names (as a string, list or array[ref]) as an argument. If the field names are present, it will create a new PK if none exists, or it will add to the fields of an existing PK (and will unique the field names). @@ -609,7 +705,7 @@ sub options { =head2 options -Get or set the table\'s options (e.g., table types for MySQL). Returns +Get or set the table's options (e.g., table types for MySQL). Returns an array or array reference. my @options = $table->options; @@ -636,7 +732,7 @@ sub order { =head2 order -Get or set the table\'s order. +Get or set the table's order. my $order = $table->order(3); @@ -652,6 +748,128 @@ Get or set the table\'s order. } # ---------------------------------------------------------------------- +sub field_names { + +=head2 field_names + +Read-only method to return a list or array ref of the field names. Returns undef +or an empty list if the table has no fields set. Usefull if you want to +avoid the overload magic of the Field objects returned by the get_fields method. + + my @names = $constraint->field_names; + +=cut + + my $self = shift; + my @fields = + map { $_->name } + sort { $a->order <=> $b->order } + values %{ $self->{'fields'} || {} }; + + if ( @fields ) { + return wantarray ? @fields : \@fields; + } + else { + $self->error('No fields'); + return wantarray ? () : undef; + } +} + +# ---------------------------------------------------------------------- + +=head1 LOOKUP METHODS + +The following are a set of shortcut methods for getting commonly used lists of +fields and constraints. They all return lists or array refs of Field or +Constraint objects. + +=over 4 + +=item pkey_fields + +The primary key fields. + +=item fkey_fields + +All foreign key fields. + +=item nonpkey_fields + +All the fields except the primary key. + +=item data_fields + +All non key fields. + +=item unique_fields + +All fields with unique constraints. + +=item unique_constraints + +All this tables unique constraints. + +=item fkey_constraints + +All this tables foreign key constraints. (See primary_key method to get the +primary key constraint) + +=back + +=cut + +sub pkey_fields { + my $me = shift; + my @fields = grep { $_->is_primary_key } $me->get_fields; + return wantarray ? @fields : \@fields; +} + +# ---------------------------------------------------------------------- +sub fkey_fields { + my $me = shift; + my @fields; + push @fields, $_->fields foreach $me->fkey_constraints; + return wantarray ? @fields : \@fields; +} + +# ---------------------------------------------------------------------- +sub nonpkey_fields { + my $me = shift; + my @fields = grep { !$_->is_primary_key } $me->get_fields; + return wantarray ? @fields : \@fields; +} + +# ---------------------------------------------------------------------- +sub data_fields { + my $me = shift; + my @fields = + grep { !$_->is_foreign_key and !$_->is_primary_key } $me->get_fields; + return wantarray ? @fields : \@fields; +} + +# ---------------------------------------------------------------------- +sub unique_fields { + my $me = shift; + my @fields; + push @fields, $_->fields foreach $me->unique_constraints; + return wantarray ? @fields : \@fields; +} + +# ---------------------------------------------------------------------- +sub unique_constraints { + my $me = shift; + my @cons = grep { $_->type eq UNIQUE } $me->get_constraints; + return wantarray ? @cons : \@cons; +} + +# ---------------------------------------------------------------------- +sub fkey_constraints { + my $me = shift; + my @cons = grep { $_->type eq FOREIGN_KEY } $me->get_constraints; + return wantarray ? @cons : \@cons; +} + +# ---------------------------------------------------------------------- sub DESTROY { my $self = shift; undef $self->{'schema'}; # destroy cyclical reference @@ -666,8 +884,9 @@ sub DESTROY { =pod -=head1 AUTHOR +=head1 AUTHORS -Ken Y. Clark Ekclark@cpan.orgE +Ken Y. Clark Ekclark@cpan.orgE, +Allen Day Eallenday@ucla.eduE. =cut