From: Ken Youens-Clark Date: Mon, 5 May 2003 04:32:39 +0000 (+0000) Subject: Too many changes to mention. X-Git-Tag: v0.02~146 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=43b9dc7ab0953ab9f4cbadf7810509d63d2ed87a;p=dbsrgits%2FSQL-Translator.git Too many changes to mention. --- diff --git a/lib/SQL/Translator/Schema/Constants.pm b/lib/SQL/Translator/Schema/Constants.pm index 15799df..5caf975 100644 --- a/lib/SQL/Translator/Schema/Constants.pm +++ b/lib/SQL/Translator/Schema/Constants.pm @@ -1,7 +1,7 @@ package SQL::Translator::Schema::Constants; # ---------------------------------------------------------------------- -# $Id: Constants.pm,v 1.1 2003-05-03 04:07:09 kycl4rk Exp $ +# $Id: Constants.pm,v 1.2 2003-05-05 04:32:39 kycl4rk Exp $ # ---------------------------------------------------------------------- # Copyright (C) 2003 Ken Y. Clark # @@ -43,13 +43,31 @@ use strict; use base qw( Exporter ); use vars qw( @EXPORT $VERSION ); require Exporter; -$VERSION = (qw$Revision: 1.1 $)[-1]; +$VERSION = (qw$Revision: 1.2 $)[-1]; @EXPORT = qw[ + CHECK_C + FOREIGN_KEY + NOT_NULL + NULL PRIMARY_KEY + UNIQUE ]; -use constant PRIMARY_KEY => 'primary_key'; +# +# Because "CHECK" is a Perl keyword +# +use constant CHECK_C => 'CHECK'; + +use constant FOREIGN_KEY => 'FOREIGN_KEY'; + +use constant NOT_NULL => 'NOT_NULL'; + +use constant NULL => 'NULL'; + +use constant PRIMARY_KEY => 'PRIMARY_KEY'; + +use constant UNIQUE => 'UNIQUE'; 1; diff --git a/lib/SQL/Translator/Schema/Constraint.pm b/lib/SQL/Translator/Schema/Constraint.pm index b091de0..372a599 100644 --- a/lib/SQL/Translator/Schema/Constraint.pm +++ b/lib/SQL/Translator/Schema/Constraint.pm @@ -1,7 +1,7 @@ package SQL::Translator::Schema::Constraint; # ---------------------------------------------------------------------- -# $Id: Constraint.pm,v 1.1 2003-05-01 04:24:59 kycl4rk Exp $ +# $Id: Constraint.pm,v 1.2 2003-05-05 04:32:39 kycl4rk Exp $ # ---------------------------------------------------------------------- # Copyright (C) 2003 Ken Y. Clark # @@ -32,7 +32,7 @@ SQL::Translator::Schema::Constraint - SQL::Translator constraint object my $constraint = SQL::Translator::Schema::Constraint->new( name => 'foo', fields => [ id ], - type => 'primary_key', + type => PRIMARY_KEY, ); =head1 DESCRIPTION @@ -45,6 +45,7 @@ C is the constraint object. use strict; use Class::Base; +use SQL::Translator::Schema::Constants; use base 'Class::Base'; use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT); @@ -52,10 +53,10 @@ use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT); $VERSION = 1.00; use constant VALID_TYPE => { - primary_key => 1, - unique => 1, - check => 1, - foreign_key => 1, + PRIMARY_KEY, 1, + UNIQUE, 1, + CHECK_C, 1, + FOREIGN_KEY, 1, }; # ---------------------------------------------------------------------- @@ -68,6 +69,7 @@ sub init { Object constructor. my $schema = SQL::Translator::Schema::Constraint->new( + table => $table, # the table to which it belongs type => 'foreign_key', # type of table constraint name => 'fk_phone_id', # the name of the constraint fields => 'phone_id', # the field in the referring table @@ -81,9 +83,8 @@ Object constructor. =cut my ( $self, $config ) = @_; -# reference_fields reference_table # match_type on_delete_do on_update_do - my @fields = qw[ name type fields ]; + my @fields = qw[ name type fields reference_fields reference_table table ]; for my $arg ( @fields ) { next unless $config->{ $arg }; @@ -94,24 +95,151 @@ Object constructor. } # ---------------------------------------------------------------------- +sub deferrable { + +=pod + +=head2 deferrable + +Get or set the whether the constraint is deferrable. If not defined, +then returns "1." The argument is evaluated by Perl for True or +False, so the following are eqivalent: + + $deferrable = $field->deferrable(0); + $deferrable = $field->deferrable(''); + $deferrable = $field->deferrable('0'); + +=cut + + my ( $self, $arg ) = @_; + + if ( defined $arg ) { + $self->{'deferrable'} = $arg ? 1 : 0; + } + + return defined $self->{'deferrable'} ? $self->{'deferrable'} : 1; +} + +# ---------------------------------------------------------------------- +sub expression { + +=pod + +=head2 expression + +Gets and set the expression used in a CHECK constraint. + + my $expression = $constraint->expression('...'); + +=cut + + my $self = shift; + + if ( my $arg = shift ) { + # check arg here? + $self->{'expression'} = $arg; + } + + return $self->{'expression'} || ''; +} + +# ---------------------------------------------------------------------- +sub is_valid { + +=pod + +=head2 is_valid + +Determine whether the constraint is valid or not. + + my $ok = $constraint->is_valid; + +=cut + + my $self = shift; + my $type = $self->type or return $self->error('No type'); + my $table = $self->table or return $self->error('No table'); + my @fields = $self->fields or return $self->error('No fields'); + my $table_name = $table->name or return $self->error('No table name'); + + for my $f ( @fields ) { + next if $table->get_field( $f ); + return $self->error( + "Constraint references non-existent field '$f' ", + "in table '$table_name'" + ); + } + + my $schema = $table->schema or return $self->error( + 'Table ', $table->name, ' has no schema object' + ); + + if ( $type eq FOREIGN_KEY ) { + return $self->error('Only one field allowed for foreign key') + if scalar @fields > 1; + + my $ref_table_name = $self->reference_table or + return $self->error('No reference table'); + + my $ref_table = $schema->get_table( $ref_table_name ) or + return $self->error("No table named '$ref_table_name' in schema"); + + my @ref_fields = $self->reference_fields or return; + + return $self->error('Only one field allowed for foreign key reference') + if scalar @ref_fields > 1; + + for my $ref_field ( @ref_fields ) { + next if $ref_table->get_field( $ref_field ); + return $self->error( + "Constraint from field(s) ", + join(', ', map {qq['$table_name.$_']} @fields), + " to non-existent field '$ref_table_name.$ref_field'" + ); + } + } + elsif ( $type eq CHECK_C ) { + return $self->error('No expression for CHECK') unless + $self->expression; + } + + return 1; +} + +# ---------------------------------------------------------------------- sub fields { =pod =head2 fields -Gets and set the fields the constraint is on. Accepts a list or arrayref, -return both, too. +Gets and set the fields the constraint is on. Accepts a string, list or +arrayref; returns an array or array reference. Will unique the field +names and keep them in order by the first occurrence of a field name. + + $constraint->fields('id'); + $constraint->fields('id', 'name'); + $constraint->fields( 'id, name' ); + $constraint->fields( [ 'id', 'name' ] ); + $constraint->fields( qw[ id name ] ); - my @fields = $constraint->fields( 'id' ); + my @fields = $constraint->fields; =cut my $self = shift; - my $fields = ref $_[0] eq 'ARRAY' ? shift : [ @_ ]; + my $fields = UNIVERSAL::isa( $_[0], 'ARRAY' ) + ? shift : [ map { s/^\s+|\s+$//g; $_ } map { split /,/ } @_ ]; if ( @$fields ) { - $self->{'fields'} = $fields; + my ( %unique, @unique ); + for my $f ( @$fields ) { + next if $unique{ $f }; + $unique{ $f } = 1; + push @unique, $f; + } + + $self->{'fields'} = \@unique; } return wantarray ? @{ $self->{'fields'} || [] } : $self->{'fields'}; @@ -136,6 +264,128 @@ Get or set the constraint's name. } # ---------------------------------------------------------------------- +sub on_delete { + +=pod + +=head2 on_delete + +Get or set the constraint's "on delete" action. + + my $action = $constraint->on_delete('cascade'); + +=cut + + my $self = shift; + + if ( my $arg = shift ) { + # validate $arg? + $self->{'on_delete'} = $arg; + } + + return $self->{'on_delete'} || ''; +} + +# ---------------------------------------------------------------------- +sub on_update { + +=pod + +=head2 on_update + +Get or set the constraint's "on update" action. + + my $action = $constraint->on_update('no action'); + +=cut + + my $self = shift; + + if ( my $arg = shift ) { + # validate $arg? + $self->{'on_update'} = $arg; + } + + return $self->{'on_update'} || ''; +} + +# ---------------------------------------------------------------------- +sub reference_fields { + +=pod + +=head2 reference_fields + +Gets and set the fields in the referred table. Accepts a string, list or +arrayref; returns an array or array reference. + + $constraint->reference_fields('id'); + $constraint->reference_fields('id', 'name'); + $constraint->reference_fields( 'id, name' ); + $constraint->reference_fields( [ 'id', 'name' ] ); + $constraint->reference_fields( qw[ id name ] ); + + my @reference_fields = $constraint->reference_fields; + +=cut + + my $self = shift; + my $fields = UNIVERSAL::isa( $_[0], 'ARRAY' ) + ? shift : [ map { s/^\s+|\s+$//g; $_ } map { split /,/ } @_ ]; + + if ( @$fields ) { + $self->{'reference_fields'} = $fields; + } + + unless ( ref $self->{'reference_fields'} ) { + my $table = $self->table or return $self->error('No table'); + my $schema = $table->schema or return $self->error('No schema'); + my $ref_table_name = $self->reference_table or + return $self->error('No table'); + my $ref_table = $schema->get_table( $ref_table_name ) or + return $self->error("Can't find table '$ref_table_name'"); + + if ( my $constraint = $ref_table->primary_key ) { + $self->{'reference_fields'} = [ $constraint->fields ]; + } + else { + $self->error( + 'No reference fields defined and cannot find primary key in ', + "reference table '$ref_table_name'" + ); + } + } + + if ( ref $self->{'reference_fields'} ) { + return wantarray + ? @{ $self->{'reference_fields'} || [] } + : $self->{'reference_fields'}; + } + else { + return wantarray ? () : []; + } +} + +# ---------------------------------------------------------------------- +sub reference_table { + +=pod + +=head2 reference_table + +Get or set the table referred to by the constraint. + + my $reference_table = $constraint->reference_table('foo'); + +=cut + + my $self = shift; + $self->{'reference_table'} = shift if @_; + return $self->{'reference_table'} || ''; +} + + +# ---------------------------------------------------------------------- sub type { =pod @@ -144,7 +394,7 @@ sub type { Get or set the constraint's type. - my $type = $constraint->type('primary_key'); + my $type = $constraint->type( PRIMARY_KEY ); =cut @@ -161,20 +411,55 @@ Get or set the constraint's type. # ---------------------------------------------------------------------- -sub is_valid { +sub table { =pod -=head2 is_valid +=head2 table -Determine whether the constraint is valid or not. +Get or set the field's table object. - my $ok = $constraint->is_valid; + my $table = $field->table; =cut my $self = shift; - return ( $self->name && $self->{'type'} && @{ $self->fields } ) ? 1 : 0; + if ( my $arg = shift ) { + return $self->error('Not a table object') unless + UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' ); + $self->{'table'} = $arg; + } + + return $self->{'table'}; +} + +# ---------------------------------------------------------------------- +sub options { + +=pod + +=head2 options + +Gets or adds to the constraints's options (e.g., "INITIALLY IMMEDIATE"). +Returns an array or array reference. + + $constraint->options('NORELY'); + my @options = $constraint->options; + +=cut + + my $self = shift; + my $options = UNIVERSAL::isa( $_[0], 'ARRAY' ) + ? shift : [ map { s/^\s+|\s+$//g; $_ } map { split /,/ } @_ ]; + + push @{ $self->{'options'} }, @$options; + + if ( ref $self->{'options'} ) { + return wantarray ? @{ $self->{'options'} || [] } : $self->{'options'}; + } + else { + return wantarray ? () : []; + } } 1; diff --git a/lib/SQL/Translator/Schema/Field.pm b/lib/SQL/Translator/Schema/Field.pm index 06af839..c31e075 100644 --- a/lib/SQL/Translator/Schema/Field.pm +++ b/lib/SQL/Translator/Schema/Field.pm @@ -1,7 +1,7 @@ package SQL::Translator::Schema::Field; # ---------------------------------------------------------------------- -# $Id: Field.pm,v 1.2 2003-05-03 15:42:59 kycl4rk Exp $ +# $Id: Field.pm,v 1.3 2003-05-05 04:32:39 kycl4rk Exp $ # ---------------------------------------------------------------------- # Copyright (C) 2003 Ken Y. Clark # @@ -44,6 +44,7 @@ C is the field object. use strict; use Class::Base; +use SQL::Translator::Schema::Constants; use base 'Class::Base'; use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT); @@ -64,7 +65,11 @@ Object constructor. =cut my ( $self, $config ) = @_; - $self->params( $config, qw[ name data_type size is_primary_key ] ); + + for my $arg ( qw[ name data_type size is_primary_key nullable table ] ) { + next unless defined $config->{ $arg }; + $self->$arg( $config->{ $arg } ) or return; + } return $self; } @@ -75,7 +80,7 @@ sub data_type { =head2 data_type -Get or set the field's data_type. +Get or set the field's data type. my $data_type = $field->data_type('integer'); @@ -87,13 +92,68 @@ Get or set the field's data_type. } # ---------------------------------------------------------------------- +sub default_value { + +=pod + +=head2 default_value + +Get or set the field's default value. Will return undef if not defined +and could return the empty string (it's a valid default value), so don't +assume an error like other methods. + + my $default = $field->default_value('foo'); + +=cut + + my ( $self, $arg ) = @_; + $self->{'default_value'} = $arg if defined $arg; + return $self->{'default_value'}; +} + +# ---------------------------------------------------------------------- +sub is_auto_increment { + +=pod + +=head2 is_auto_increment + +Get or set the field's C attribute. + + my $is_pk = $field->is_auto_increment(1); + +=cut + + my ( $self, $arg ) = @_; + + if ( defined $arg ) { + $self->{'is_auto_increment'} = $arg ? 1 : 0; + } + + unless ( defined $self->{'is_auto_increment'} ) { + if ( my $table = $self->table ) { + if ( my $schema = $table->schema ) { + if ( + $schema->database eq 'PostgreSQL' && + $self->data_type eq 'serial' + ) { + $self->{'is_auto_increment'} = 1; + } + } + } + } + + return $self->{'is_auto_increment'} || 0; +} + +# ---------------------------------------------------------------------- sub is_primary_key { =pod =head2 is_primary_key -Get or set the field's is_primary_key attribute. +Get or set the field's C attribute. my $is_pk = $field->is_primary_key(1); @@ -105,6 +165,18 @@ Get or set the field's is_primary_key attribute. $self->{'is_primary_key'} = $arg ? 1 : 0; } + unless ( defined $self->{'is_primary_key'} ) { + if ( my $table = $self->table ) { + if ( my $pk = $table->primary_key ) { + my %fields = map { $_, 1 } $pk->fields; + $self->{'is_primary_key'} = $fields{ $self->name } || 0; + } + else { + $self->{'is_primary_key'} = 0; + } + } + } + return $self->{'is_primary_key'} || 0; } @@ -122,30 +194,80 @@ Get or set the field's name. =cut my $self = shift; - $self->{'name'} = shift if @_; + + if ( my $arg = shift ) { + if ( my $table = $self->table ) { + return $self->error( qq[Can't use field name "$arg": table exists] ) + if $table->get_field( $arg ); + } + + $self->{'name'} = $arg; + } + return $self->{'name'} || ''; } # ---------------------------------------------------------------------- -sub size { +sub nullable { =pod -=head2 size +=head2 nullable -Get or set the field's size. +Get or set the whether the field can be null. If not defined, then +returns "1" (assumes the field can be null). The argument is evaluated +by Perl for True or False, so the following are eqivalent: - my $size = $field->size('25'); + $nullable = $field->nullable(0); + $nullable = $field->nullable(''); + $nullable = $field->nullable('0'); =cut my ( $self, $arg ) = @_; - if ( $arg && $arg =~ m/^\d+(?:\.\d+)?$/ ) { - $self->{'size'} = $arg; + if ( defined $arg ) { + $self->{'nullable'} = $arg ? 1 : 0; } - return $self->{'size'} || 0; + return defined $self->{'nullable'} ? $self->{'nullable'} : 1; +} + +# ---------------------------------------------------------------------- +sub size { + +=pod + +=head2 size + +Get or set the field's size. Accepts a string, array or arrayref of +numbers and returns a string. + + $field->size( 30 ); + $field->size( [ 255 ] ); + $size = $field->size( 10, 2 ); + print $size; # prints "10,2" + + $size = $field->size( '10, 2' ); + print $size; # prints "10,2" + +=cut + + my $self = shift; + my $numbers = UNIVERSAL::isa( $_[0], 'ARRAY' ) + ? shift : [ map { split /,/ } @_ ]; + + if ( @$numbers ) { + my @new; + for my $num ( @$numbers ) { + if ( defined $num && $num =~ m/^\d+(?:\.\d+)?$/ ) { + push @new, $num; + } + } + $self->{'size'} = \@new if @new; # only set if all OK + } + + return join( ',', @{ $self->{'size'} || [0] } ); } # ---------------------------------------------------------------------- @@ -162,7 +284,33 @@ Determine whether the field is valid or not. =cut my $self = shift; - return 1 if $self->name && $self->data_type; + return $self->error('No name') unless $self->name; + return $self->error('No data type') unless $self->data_type; + return $self->error('No table object') unless $self->table; + return 1; +} + +# ---------------------------------------------------------------------- +sub table { + +=pod + +=head2 table + +Get or set the field's table object. + + my $table = $field->table; + +=cut + + my $self = shift; + if ( my $arg = shift ) { + return $self->error('Not a table object') unless + UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' ); + $self->{'table'} = $arg; + } + + return $self->{'table'}; } 1; diff --git a/lib/SQL/Translator/Schema/Index.pm b/lib/SQL/Translator/Schema/Index.pm index 3ee0e4c..f11f32e 100644 --- a/lib/SQL/Translator/Schema/Index.pm +++ b/lib/SQL/Translator/Schema/Index.pm @@ -1,7 +1,7 @@ package SQL::Translator::Schema::Index; # ---------------------------------------------------------------------- -# $Id: Index.pm,v 1.1 2003-05-01 04:25:00 kycl4rk Exp $ +# $Id: Index.pm,v 1.2 2003-05-05 04:32:39 kycl4rk Exp $ # ---------------------------------------------------------------------- # Copyright (C) 2003 Ken Y. Clark # @@ -123,6 +123,29 @@ Get or set the index's name. } # ---------------------------------------------------------------------- +sub table { + +=pod + +=head2 table + +Get or set the index's table object. + + my $table = $index->table; + +=cut + + my $self = shift; + if ( my $arg = shift ) { + return $self->error('Not a table object') unless + UNIVERSAL::isa( $arg, 'SQL::Translator::Schema::Table' ); + $self->{'table'} = $arg; + } + + return $self->{'table'}; +} + +# ---------------------------------------------------------------------- sub type { =pod diff --git a/lib/SQL/Translator/Schema/Table.pm b/lib/SQL/Translator/Schema/Table.pm index 889e6d7..02e7599 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.3 2003-05-05 04:32:39 kycl4rk Exp $ # ---------------------------------------------------------------------- # Copyright (C) 2003 Ken Y. Clark # @@ -60,12 +60,20 @@ 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; + + for my $arg ( qw[ schema name ] ) { + next unless defined $config->{ $arg }; + $self->$arg( $config->{ $arg } ) or return; + } + return $self; } @@ -78,12 +86,23 @@ sub 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; - $self->{'name'} = shift if @_; + + 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'} || ''; } @@ -97,17 +116,32 @@ sub add_constraint { Add a constraint to the table. Returns the newly created C object. - my $constraint = $table->add_constraint( - name => 'pk', - type => PRIMARY_KEY, - fields => [ 'foo_id' ], + my $constraint1 = $table->add_constraint( + name => 'pk', + type => PRIMARY_KEY, + fields => [ 'foo_id' ], ); + my $constraint2 = SQL::Translator::Schema::Constraint->new( name => 'uniq' ); + $constraint2 = $table->add_constraint( $constraint ); + =cut - my $self = shift; - my $constraint = SQL::Translator::Schema::Constraint->new( @_ ) or - return SQL::Translator::Schema::Constraint->error; + 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 ); + } + push @{ $self->{'constraints'} }, $constraint; return $constraint; } @@ -122,17 +156,32 @@ sub add_index { Add an index to the table. Returns the newly created C object. - my $index = $table->add_index( + my $index1 = $table->add_index( name => 'name', fields => [ 'name' ], type => 'normal', ); + my $index2 = SQL::Translator::Schema::Index->new( name => 'id' ); + $index2 = $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,24 +193,50 @@ 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 $field1 = $table->add_field( name => 'foo_id', data_type => 'integer', size => 11, ); + my $field2 = SQL::Translator::Schema::Field->new( + name => 'name', + table => $table, + ); + $field2 = $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 $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 ); + } + + 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; + $self->{'fields'}{ $field_name }{'order'} = ++$FIELD_ORDER; + } + return $field; } @@ -217,6 +292,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 @@ -257,7 +352,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,6 +364,110 @@ Determine whether the view is valid or not. return 1; } +# ---------------------------------------------------------------------- +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 options + +Gets or sets the table's primary key(s). Takes one or more field names +(as a string, list or arrayref) and returns an array or arrayref. + + $table->primary_key('id'); + $table->primary_key(['id']); + $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 = UNIVERSAL::isa( $_[0], 'ARRAY' ) + ? shift : [ map { s/^\s+|\s+$//g; $_ } map { split /,/ } @_ ]; + + 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 ); + } + } + + unless ( $has_pk ) { + $self->add_constraint( + type => PRIMARY_KEY, + fields => $fields, + ); + } + } + + for my $c ( $self->get_constraints ) { + return $c if $c->type eq PRIMARY_KEY; + } + + return $self->error('No primary key'); +} + +# ---------------------------------------------------------------------- +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 = UNIVERSAL::isa( $_[0], 'ARRAY' ) + ? shift : [ map { s/^\s+|\s+$//g; $_ } map { split /,/ } @_ ]; + + push @{ $self->{'options'} }, @$options; + + if ( ref $self->{'options'} ) { + return wantarray ? @{ $self->{'options'} || [] } : $self->{'options'}; + } + else { + return wantarray ? () : []; + } +} + 1; # ----------------------------------------------------------------------