From: Mark Addison Date: Fri, 5 Nov 2004 15:03:11 +0000 (+0000) Subject: All Schema objects now have an extra attribute. Added parsing support (and X-Git-Tag: v0.11008~602 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FSQL-Translator.git;a=commitdiff_plain;h=b178940934ec79968ed16511ec2644f3736c92f2 All Schema objects now have an extra attribute. Added parsing support (and tests) for this to the SQLF XML parser. --- diff --git a/lib/SQL/Translator/Parser/XML/SQLFairy.pm b/lib/SQL/Translator/Parser/XML/SQLFairy.pm index 7baa517..7a12136 100644 --- a/lib/SQL/Translator/Parser/XML/SQLFairy.pm +++ b/lib/SQL/Translator/Parser/XML/SQLFairy.pm @@ -1,7 +1,7 @@ package SQL::Translator::Parser::XML::SQLFairy; # ------------------------------------------------------------------- -# $Id: SQLFairy.pm,v 1.11 2004-08-20 11:01:48 grommit Exp $ +# $Id: SQLFairy.pm,v 1.12 2004-11-05 15:03:09 grommit Exp $ # ------------------------------------------------------------------- # Copyright (C) 2003 Mark Addison , # @@ -100,7 +100,7 @@ To convert your old format files simply pass them through the translator :) use strict; use vars qw[ $DEBUG $VERSION @EXPORT_OK ]; -$VERSION = sprintf "%d.%02d", q$Revision: 1.11 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.12 $ =~ /(\d+)\.(\d+)/; $DEBUG = 0 unless defined $DEBUG; use Data::Dumper; @@ -137,7 +137,7 @@ sub parse { debug "Adding table:".$xp->findvalue('sqlf:name',$tblnode); my $table = $schema->add_table( - get_tagfields($xp, $tblnode, "sqlf:" => qw/name order/) + get_tagfields($xp, $tblnode, "sqlf:" => qw/name order extra/) ) or die $schema->error; # @@ -186,7 +186,7 @@ sub parse { foreach (@nodes) { my %data = get_tagfields($xp, $_, "sqlf:", qw/name type table fields reference_fields reference_table - match_type on_delete_do on_update_do/ + match_type on_delete_do on_update_do extra/ ); $table->add_constraint( %data ) or die $table->error; } @@ -197,7 +197,7 @@ sub parse { @nodes = $xp->findnodes('sqlf:indices/sqlf:index',$tblnode); foreach (@nodes) { my %data = get_tagfields($xp, $_, "sqlf:", - qw/name type fields options/); + qw/name type fields options extra/); $table->add_index( %data ) or die $table->error; } @@ -211,7 +211,7 @@ sub parse { ); foreach (@nodes) { my %data = get_tagfields($xp, $_, "sqlf:", - qw/name sql fields order/ + qw/name sql fields order extra/ ); $schema->add_view( %data ) or die $schema->error; } @@ -223,9 +223,10 @@ sub parse { '/sqlf:schema/sqlf:trigger|/sqlf:schema/sqlf:triggers/sqlf:trigger' ); foreach (@nodes) { - my %data = get_tagfields($xp, $_, "sqlf:", - qw/name perform_action_when database_event fields on_table action order/ - ); + my %data = get_tagfields($xp, $_, "sqlf:", qw/ + name perform_action_when database_event fields on_table action order + extra + /); $schema->add_trigger( %data ) or die $schema->error; } @@ -237,7 +238,7 @@ sub parse { ); foreach (@nodes) { my %data = get_tagfields($xp, $_, "sqlf:", - qw/name sql parameters owner comments order/ + qw/name sql parameters owner comments order extra/ ); $schema->add_procedure( %data ) or die $schema->error; } diff --git a/lib/SQL/Translator/Schema/Field.pm b/lib/SQL/Translator/Schema/Field.pm index 00d74e9..e87e121 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.21 2004-11-05 13:19:31 grommit Exp $ +# $Id: Field.pm,v 1.22 2004-11-05 15:03:10 grommit Exp $ # ---------------------------------------------------------------------- # Copyright (C) 2002-4 SQLFairy Authors # @@ -50,7 +50,7 @@ use base 'SQL::Translator::Schema::Object'; use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT); -$VERSION = sprintf "%d.%02d", q$Revision: 1.21 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.22 $ =~ /(\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 @@ -65,7 +65,7 @@ use overload __PACKAGE__->_attributes( qw/ table name data_type size is_primary_key is_nullable - is_auto_increment default_value comments extra is_foreign_key + is_auto_increment default_value comments is_foreign_key is_unique order /); @@ -157,8 +157,6 @@ assume an error like other methods. } # ---------------------------------------------------------------------- -sub extra { - =pod =head2 extra @@ -171,15 +169,6 @@ Accepts a hash(ref) of name/value pairs to store; returns a hash. =cut - my $self = shift; - my $args = ref $_[0] eq 'HASH' ? shift : { @_ }; - - while ( my ( $key, $value ) = each %$args ) { - $self->{'extra'}{ $key } = $value; - } - - return %{ $self->{'extra'} || {} }; -} # ---------------------------------------------------------------------- sub foreign_key_reference { diff --git a/lib/SQL/Translator/Schema/Object.pm b/lib/SQL/Translator/Schema/Object.pm index bff5fb3..51e2f08 100644 --- a/lib/SQL/Translator/Schema/Object.pm +++ b/lib/SQL/Translator/Schema/Object.pm @@ -1,7 +1,7 @@ package SQL::Translator::Schema::Object; # ---------------------------------------------------------------------- -# $Id: Object.pm,v 1.2 2004-11-05 13:19:31 grommit Exp $ +# $Id: Object.pm,v 1.3 2004-11-05 15:03:10 grommit Exp $ # ---------------------------------------------------------------------- # Copyright (C) 2002-4 SQLFairy Authors # @@ -42,7 +42,7 @@ use base 'Class::Base'; use vars qw[ $VERSION ]; -$VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.3 $ =~ /(\d+)\.(\d+)/; =head1 Construction @@ -83,7 +83,9 @@ API for the Schema objects. __PACKAGE__->mk_classdata("__attributes"); -__PACKAGE__->__attributes([]); + +# Define any global attributes here +__PACKAGE__->__attributes([qw/extra/]); # Set the classes attribute names. Multiple calls are cumulative. # We need to be careful to create a new ref so that all classes don't end up @@ -106,6 +108,35 @@ sub init { return $self; } +# ---------------------------------------------------------------------- +sub extra { + +=pod + +=head1 Global Attributes + +The following attributes are defined here, therefore all schema objects will +have them. + +=head2 extra + +Get or set the objects "extra" attibutes (e.g., "ZEROFILL" for MySQL fields). +Accepts a hash(ref) of name/value pairs to store; returns a hash. + + $field->extra( qualifier => 'ZEROFILL' ); + my %extra = $field->extra; + +=cut + + my $self = shift; + my $args = ref $_[0] eq 'HASH' ? shift : { @_ }; + + while ( my ( $key, $value ) = each %$args ) { + $self->{'extra'}{ $key } = $value; + } + + return %{ $self->{'extra'} || {} }; +} #============================================================================= diff --git a/lib/SQL/Translator/Schema/Table.pm b/lib/SQL/Translator/Schema/Table.pm index 6aa6fae..b9c1247 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.28 2004-11-05 13:19:31 grommit Exp $ +# $Id: Table.pm,v 1.29 2004-11-05 15:03:10 grommit Exp $ # ---------------------------------------------------------------------- # Copyright (C) 2002-4 SQLFairy Authors # @@ -51,7 +51,7 @@ use base 'SQL::Translator::Schema::Object'; use vars qw( $VERSION $FIELD_ORDER ); -$VERSION = sprintf "%d.%02d", q$Revision: 1.28 $ =~ /(\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 @@ -113,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 ); } # @@ -124,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; } diff --git a/lib/Test/SQL/Translator.pm b/lib/Test/SQL/Translator.pm index 329fc3c..7a9a475 100644 --- a/lib/Test/SQL/Translator.pm +++ b/lib/Test/SQL/Translator.pm @@ -1,7 +1,7 @@ package Test::SQL::Translator; # ---------------------------------------------------------------------- -# $Id: Translator.pm,v 1.6 2004-07-08 17:29:56 grommit Exp $ +# $Id: Translator.pm,v 1.7 2004-11-05 15:03:10 grommit Exp $ # ---------------------------------------------------------------------- # Copyright (C) 2003 The SQLFairy Authors # @@ -34,7 +34,7 @@ use warnings; use base qw(Exporter); use vars qw($VERSION @EXPORT @EXPORT_OK); -$VERSION = sprintf "%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/; @EXPORT = qw( schema_ok table_ok @@ -81,6 +81,7 @@ $ATTRIBUTES{constraint} = { on_update => '', reference_fields => [], reference_table => '', + extra => {}, }; $ATTRIBUTES{'index'} = { fields => [], @@ -88,12 +89,14 @@ $ATTRIBUTES{'index'} = { name => "", options => [], type => NORMAL, + extra => {}, }; $ATTRIBUTES{'view'} = { name => "", sql => "", fields => [], is_valid => 1, + extra => {}, }; $ATTRIBUTES{'trigger'} = { name => '', @@ -102,6 +105,7 @@ $ATTRIBUTES{'trigger'} = { on_table => undef, action => undef, is_valid => 1, + extra => {}, }; $ATTRIBUTES{'procedure'} = { name => '', @@ -109,6 +113,7 @@ $ATTRIBUTES{'procedure'} = { parameters => [], owner => '', comments => '', + extra => {}, }; $ATTRIBUTES{table} = { comments => undef, @@ -120,6 +125,7 @@ $ATTRIBUTES{table} = { constraints => undef, indices => undef, is_valid => 1, + extra => {}, }; $ATTRIBUTES{schema} = { name => '', @@ -129,6 +135,7 @@ $ATTRIBUTES{schema} = { triggers => undef, # [] when set views => undef, # [] when set is_valid => 1, + extra => {}, }; @@ -243,6 +250,8 @@ sub constraint_ok { is_deeply( [$obj->options], $test->{options}, "$t_name options are '".join(",",@{$test->{options}})."'" ); + + is_deeply( { $obj->extra }, $test->{extra}, "$t_name extra" ); } sub index_ok { @@ -262,6 +271,8 @@ sub index_ok { is_deeply( [$obj->options], $test->{options}, "$t_name options are '".join(",",@{$test->{options}})."'" ); + + is_deeply( { $obj->extra }, $test->{extra}, "$t_name extra" ); } sub trigger_ok { @@ -284,6 +295,8 @@ sub trigger_ok { "$t_name on_table is '$test->{on_table}'" ); is( $obj->action, $test->{action}, "$t_name action is '$test->{action}'" ); + + is_deeply( { $obj->extra }, $test->{extra}, "$t_name extra" ); } sub view_ok { @@ -302,6 +315,8 @@ sub view_ok { is_deeply( [$obj->fields], $test->{fields}, "$t_name fields are '".join(",",@{$test->{fields}})."'" ); + + is_deeply( { $obj->extra }, $test->{extra}, "$t_name extra" ); } sub procedure_ok { @@ -322,6 +337,8 @@ sub procedure_ok { "$t_name comments is '$test->{comments}'" ); is( $obj->owner, $test->{owner}, "$t_name owner is '$test->{owner}'" ); + + is_deeply( { $obj->extra }, $test->{extra}, "$t_name extra" ); } sub table_ok { @@ -336,6 +353,8 @@ sub table_ok { is_deeply( [$obj->options], $test->{options}, "$t_name options are '".join(",",@{$test->{options}})."'" ); + is_deeply( { $obj->extra }, $test->{extra}, "$t_name extra" ); + # Fields if ( $arg{fields} ) { my @fldnames = map {$_->{name}} @{$arg{fields}}; @@ -396,6 +415,8 @@ sub schema_ok { is( $obj->database, $test->{database}, "$t_name database is '$test->{database}'" ); + + is_deeply( { $obj->extra }, $test->{extra}, "$t_name extra" ); is( $obj->is_valid, $test->{is_valid}, "$t_name is ".($test->{is_valid} ? '' : 'not ').'valid' ); diff --git a/t/16xml-parser.t b/t/16xml-parser.t index ba3d6a0..a744296 100644 --- a/t/16xml-parser.t +++ b/t/16xml-parser.t @@ -27,7 +27,7 @@ use constant DEBUG => (exists $opt{d} ? 1 : 0); #============================================================================= BEGIN { - maybe_plan(142, 'SQL::Translator::Parser::XML::SQLFairy'); + maybe_plan(150, 'SQL::Translator::Parser::XML::SQLFairy'); } my $testschema = "$Bin/data/xml/schema.xml"; @@ -57,6 +57,11 @@ schema_ok( $scma, { tables => [ { name => "Basic", + extra => { + foo => "bar", + hello => "world", + bar => "baz", + }, fields => [ { name => "id", @@ -118,6 +123,11 @@ schema_ok( $scma, { { type => PRIMARY_KEY, fields => ["id"], + extra => { + foo => "bar", + hello => "world", + bar => "baz", + }, }, { name => 'emailuniqueindex', @@ -129,6 +139,11 @@ schema_ok( $scma, { { name => "titleindex", fields => ["title"], + extra => { + foo => "bar", + hello => "world", + bar => "baz", + }, }, ], } # end table Basic @@ -139,6 +154,11 @@ schema_ok( $scma, { name => 'email_list', sql => "SELECT email FROM Basic WHERE email IS NOT NULL", fields => ['email'], + extra => { + foo => "bar", + hello => "world", + bar => "baz", + }, }, ], @@ -149,6 +169,11 @@ schema_ok( $scma, { database_event => 'insert', on_table => 'foo', action => 'update modified=timestamp();', + extra => { + foo => "bar", + hello => "world", + bar => "baz", + }, }, ], @@ -159,6 +184,11 @@ schema_ok( $scma, { parameters => ['foo', 'bar'], owner => 'Nomar', comments => 'Go Sox!', + extra => { + foo => "bar", + hello => "world", + bar => "baz", + }, }, ], diff --git a/t/28xml-xmi-parser-sqlfairy.t b/t/28xml-xmi-parser-sqlfairy.t index b6071cd..69943eb 100644 --- a/t/28xml-xmi-parser-sqlfairy.t +++ b/t/28xml-xmi-parser-sqlfairy.t @@ -22,7 +22,7 @@ use SQL::Translator::Schema::Constants; #============================================================================= BEGIN { - maybe_plan(321, + maybe_plan(335, 'SQL::Translator::Parser::XML::XMI::SQLFairy', 'SQL::Translator::Producer::MySQL'); } diff --git a/t/data/xml/schema.xml b/t/data/xml/schema.xml index 3750076..7b8fa6d 100644 --- a/t/data/xml/schema.xml +++ b/t/data/xml/schema.xml @@ -5,7 +5,7 @@ Created on Fri Aug 15 15:08:18 2003 --> - + @@ -37,21 +37,28 @@ Created on Fri Aug 15 15:08:18 2003 - + + + + expression="" on_update="" on_delete=""> + + + +
SELECT email FROM Basic WHERE email IS NOT NULL + @@ -59,6 +66,7 @@ Created on Fri Aug 15 15:08:18 2003 update modified=timestamp(); + @@ -66,6 +74,7 @@ Created on Fri Aug 15 15:08:18 2003 select foo from bar Go Sox! +