X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FSchema%2FTable.pm;h=2e9f2531633cd459eb06c7e81d9568f099eed847;hb=f9c5e794de9710a4aa68716d49da47316834d8c8;hp=889e6d71ad9e6e78b2a4bfa5d534780c01c99e85;hpb=0f3cc5c0b8515724a77c0cdc7b816f41ca5f0aa0;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Schema/Table.pm b/lib/SQL/Translator/Schema/Table.pm index 889e6d7..2e9f253 100644 --- a/lib/SQL/Translator/Schema/Table.pm +++ b/lib/SQL/Translator/Schema/Table.pm @@ -1,7 +1,7 @@ package SQL::Translator::Schema::Table; # ---------------------------------------------------------------------- -# $Id: Table.pm,v 1.2 2003-05-03 04:07:09 kycl4rk Exp $ +# $Id: Table.pm,v 1.21 2003-09-25 17:28:37 allenday Exp $ # ---------------------------------------------------------------------- # Copyright (C) 2003 Ken Y. Clark # @@ -41,15 +41,17 @@ C is the table object. 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 'Class::Base'; use vars qw( $VERSION $FIELD_ORDER ); -$VERSION = 1.00; +$VERSION = sprintf "%d.%02d", q$Revision: 1.21 $ =~ /(\d+)\.(\d+)/; # ---------------------------------------------------------------------- sub init { @@ -60,31 +62,21 @@ sub init { Object constructor. - my $schema = SQL::Translator::Schema::Table->new( name => 'foo' ); + my $table = SQL::Translator::Schema::Table->new( + schema => $schema, + name => 'foo', + ); =cut my ( $self, $config ) = @_; - $self->params( $config, qw[ name ] ) || return undef; - return $self; -} - -# ---------------------------------------------------------------------- -sub name { - -=pod - -=head2 name - -Get or set the table's name. - - my $table_name = $table->name('foo'); - -=cut + + for my $arg ( qw[ schema name comments ] ) { + next unless defined $config->{ $arg }; + defined $self->$arg( $config->{ $arg } ) or return; + } - my $self = shift; - $self->{'name'} = shift if @_; - return $self->{'name'} || ''; + return $self; } # ---------------------------------------------------------------------- @@ -97,18 +89,76 @@ sub add_constraint { Add a constraint to the table. Returns the newly created C object. - my $constraint = $table->add_constraint( + my $c1 = $table->add_constraint( name => 'pk', - type => PRIMARY_KEY, + type => PRIMARY_KEY, fields => [ 'foo_id' ], ); + my $c2 = SQL::Translator::Schema::Constraint->new( name => 'uniq' ); + $c2 = $table->add_constraint( $constraint ); + =cut - my $self = shift; - my $constraint = SQL::Translator::Schema::Constraint->new( @_ ) or - return SQL::Translator::Schema::Constraint->error; - push @{ $self->{'constraints'} }, $constraint; + my $self = shift; + my $constraint_class = 'SQL::Translator::Schema::Constraint'; + my $constraint; + + if ( UNIVERSAL::isa( $_[0], $constraint_class ) ) { + $constraint = shift; + $constraint->table( $self ); + } + else { + my %args = @_; + $args{'table'} = $self; + $constraint = $constraint_class->new( \%args ) or + return $self->error( $constraint_class->error ); + } + + # + # If we're trying to add a PK when one is already defined, + # then just add the fields to the existing definition. + # + my $ok = 1; + my $pk = $self->primary_key; + if ( $pk && $constraint->type eq PRIMARY_KEY ) { + $self->primary_key( $constraint->fields ); + $constraint = $pk; + $ok = 0; + } + elsif ( $constraint->type eq PRIMARY_KEY ) { + for my $fname ( $constraint->fields ) { + if ( my $f = $self->get_field( $fname ) ) { + $f->is_primary_key( 1 ); + } + } + } + # + # See if another constraint of the same type + # covers the same fields. + # + 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; + } + return $constraint; } @@ -122,17 +172,32 @@ sub add_index { Add an index to the table. Returns the newly created C object. - my $index = $table->add_index( + my $i1 = $table->add_index( name => 'name', fields => [ 'name' ], type => 'normal', ); + my $i2 = SQL::Translator::Schema::Index->new( name => 'id' ); + $i2 = $table->add_index( $index ); + =cut - my $self = shift; - my $index = SQL::Translator::Schema::Index->new( @_ ) or return - SQL::Translator::Schema::Index->error; + my $self = shift; + my $index_class = 'SQL::Translator::Schema::Index'; + my $index; + + if ( UNIVERSAL::isa( $_[0], $index_class ) ) { + $index = shift; + $index->table( $self ); + } + else { + my %args = @_; + $args{'table'} = $self; + $index = $index_class->new( \%args ) or return + $self->error( $index_class->error ); + } + push @{ $self->{'indices'} }, $index; return $index; } @@ -144,28 +209,91 @@ sub add_field { =head2 add_field -Add an field to the table. Returns the newly created -C object. +Add an field to the table. Returns the newly created +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 $field = $table->add_field( + my $f1 = $table->add_field( name => 'foo_id', data_type => 'integer', size => 11, ); + my $f2 = SQL::Translator::Schema::Field->new( + name => 'name', + table => $table, + ); + $f2 = $table->add_field( $field2 ) or die $table->error; + =cut - my $self = shift; - my %args = @_; - return $self->error('No name') unless $args{'name'}; - my $field = SQL::Translator::Schema::Field->new( \%args ) or return; - SQL::Translator::Schema::Field->error; - $self->{'fields'}{ $field->name } = $field; - $self->{'fields'}{ $field->name }{'order'} = ++$FIELD_ORDER; + my $self = shift; + my $field_class = 'SQL::Translator::Schema::Field'; + my $field; + + if ( UNIVERSAL::isa( $_[0], $field_class ) ) { + $field = shift; + $field->table( $self ); + } + else { + my %args = @_; + $args{'table'} = $self; + $field = $field_class->new( \%args ) or return + $self->error( $field_class->error ); + } + + $field->order( ++$FIELD_ORDER ); + my $field_name = $field->name or return $self->error('No name'); + + if ( exists $self->{'fields'}{ $field_name } ) { + return $self->error(qq[Can't create field: "$field_name" exists]); + } + else { + $self->{'fields'}{ $field_name } = $field; + } + return $field; } # ---------------------------------------------------------------------- +sub comments { + +=pod + +=head2 comments + +Get or set the comments on a table. May be called several times to +set and it will accumulate the comments. Called in an array context, +returns each comment individually; called in a scalar context, returns +all the comments joined on newlines. + + $table->comments('foo'); + $table->comments('bar'); + print join( ', ', $table->comments ); # prints "foo, bar" + +=cut + + my $self = shift; + my @comments = ref $_[0] ? @{ $_[0] } : @_; + + for my $arg ( @comments ) { + $arg = $arg->[0] if ref $arg; + push @{ $self->{'comments'} }, $arg if defined $arg && $arg; + } + + if ( @{ $self->{'comments'} || [] } ) { + return wantarray + ? @{ $self->{'comments'} } + : join( "\n", @{ $self->{'comments'} } ) + ; + } + else { + return wantarray ? () : undef; + } +} + +# ---------------------------------------------------------------------- sub get_constraints { =pod @@ -217,6 +345,26 @@ Returns all the index objects as an array or array reference. } # ---------------------------------------------------------------------- +sub get_field { + +=pod + +=head2 get_field + +Returns a field by the name provided. + + my $field = $table->get_field('foo'); + +=cut + + my $self = shift; + my $field_name = shift or return $self->error('No field name'); + return $self->error( qq[Field "$field_name" does not exist] ) unless + exists $self->{'fields'}{ $field_name }; + return $self->{'fields'}{ $field_name }; +} + +# ---------------------------------------------------------------------- sub get_fields { =pod @@ -231,7 +379,9 @@ Returns all the field objects as an array or array reference. my $self = shift; my @fields = - sort { $a->{'order'} <=> $b->{'order'} } + map { $_->[1] } + sort { $a->[0] <=> $b->[0] } + map { [ $_->order, $_ ] } values %{ $self->{'fields'} || {} }; if ( @fields ) { @@ -257,7 +407,7 @@ Determine whether the view is valid or not. =cut my $self = shift; - return $self->error('No name') unless $self->name; + return $self->error('No name') unless $self->name; return $self->error('No fields') unless $self->get_fields; for my $object ( @@ -269,14 +419,338 @@ Determine whether the view is valid or not. return 1; } +# ---------------------------------------------------------------------- +sub is_trivial_link { + +=pod + +=head2 is_data + +=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}++; + } + + 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 + +=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 + +=head2 can_link + +Determine whether the table can link two arg tables via many-to-many. + + my $ok = $table->can_link($table1,$table2); + +=cut + + my ( $self, $table1, $table2 ) = @_; + + return $self->{'can_link'}{ $table1->name }{ $table2->name } + if defined $self->{'can_link'}{ $table1->name }{ $table2->name }; + + 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 }; + } + + my %fk = (); + + foreach my $field ( $self->get_fields ) { + if ( $field->is_foreign_key ) { + push @{ $fk{ $field->foreign_key_reference->reference_table } }, + $field->foreign_key_reference; + } + } + + 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 }; + } + + # 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]; + } + + return $self->{'can_link'}{ $table1->name }{ $table2->name }; +} + +# ---------------------------------------------------------------------- +sub name { + +=pod + +=head2 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. + + my $table_name = $table->name('foo'); + +=cut + + my $self = shift; + + if ( my $arg = shift ) { + if ( my $schema = $self->schema ) { + return $self->error( qq[Can't use table name "$arg": table exists] ) + if $schema->get_table( $arg ); + } + $self->{'name'} = $arg; + } + + return $self->{'name'} || ''; +} + +# ---------------------------------------------------------------------- +sub schema { + +=pod + +=head2 schema + +Get or set the table's schema object. + + my $schema = $table->schema; + +=cut + + my $self = shift; + if ( my $arg = shift ) { + return $self->error('Not a schema object') unless + UNIVERSAL::isa( $arg, 'SQL::Translator::Schema' ); + $self->{'schema'} = $arg; + } + + return $self->{'schema'}; +} + +# ---------------------------------------------------------------------- +sub primary_key { + +=pod + +=head2 primary_key + +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). +Returns the C object representing +the primary key. + +These are eqivalent: + + $table->primary_key('id'); + $table->primary_key(['name']); + $table->primary_key('id','name']); + $table->primary_key(['id','name']); + $table->primary_key('id,name'); + $table->primary_key(qw[ id name ]); + + my $pk = $table->primary_key; + +=cut + + my $self = shift; + my $fields = parse_list_arg( @_ ); + + my $constraint; + if ( @$fields ) { + for my $f ( @$fields ) { + return $self->error(qq[Invalid field "$f"]) unless + $self->get_field($f); + } + + my $has_pk; + for my $c ( $self->get_constraints ) { + if ( $c->type eq PRIMARY_KEY ) { + $has_pk = 1; + $c->fields( @{ $c->fields }, @$fields ); + $constraint = $c; + } + } + + unless ( $has_pk ) { + $constraint = $self->add_constraint( + type => PRIMARY_KEY, + fields => $fields, + ) or return; + } + } + + if ( $constraint ) { + return $constraint; + } + else { + for my $c ( $self->get_constraints ) { + return $c if $c->type eq PRIMARY_KEY; + } + } + + return; +} + +# ---------------------------------------------------------------------- +sub options { + +=pod + +=head2 options + +Get or set the table's options (e.g., table types for MySQL). Returns +an array or array reference. + + my @options = $table->options; + +=cut + + my $self = shift; + my $options = parse_list_arg( @_ ); + + push @{ $self->{'options'} }, @$options; + + if ( ref $self->{'options'} ) { + return wantarray ? @{ $self->{'options'} || [] } : $self->{'options'}; + } + else { + return wantarray ? () : []; + } +} + +# ---------------------------------------------------------------------- +sub order { + +=pod + +=head2 order + +Get or set the table's order. + + my $order = $table->order(3); + +=cut + + my ( $self, $arg ) = @_; + + if ( defined $arg && $arg =~ /^\d+$/ ) { + $self->{'order'} = $arg; + } + + return $self->{'order'} || 0; +} + +# ---------------------------------------------------------------------- +sub DESTROY { + my $self = shift; + undef $self->{'schema'}; # destroy cyclical reference + undef $_ for @{ $self->{'constraints'} }; + undef $_ for @{ $self->{'indices'} }; + undef $_ for values %{ $self->{'fields'} }; +} + 1; # ---------------------------------------------------------------------- =pod -=head1 AUTHOR +=head1 AUTHORS -Ken Y. Clark Ekclark@cpan.orgE +Ken Y. Clark Ekclark@cpan.orgE, +Allen Day Eallenday@ucla.eduE. =cut