From: Jess Robinson Date: Tue, 18 Aug 2009 06:57:49 +0000 (+0000) Subject: Changes + Reverts for 0.11000, see Changes file for info X-Git-Tag: v0.11008~99 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=11ad2df91bcc0674faa8fb5b6bab52c9e4a73762;p=dbsrgits%2FSQL-Translator.git Changes + Reverts for 0.11000, see Changes file for info --- diff --git a/Changes b/Changes index 5b7c789..ec22524 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,12 @@ + +# ---------------------------------------------------------- +# 0.11000 2009-08-18 +# ---------------------------------------------------------- +* Re-add version numbers to files, else cpan's "upgrade" gets very confused +* Replaced code using Readonly, since most of the rest uses constant, and thats already a dep +* Moved YAML and XML::LibXML back to recommends, the tests for both now skip if not installed +* Bumped to 0.11000 to supercede 0.10 which has incorrect numbering scheme + # ---------------------------------------------------------- # 0.10 2009-08-13 # ---------------------------------------------------------- diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP index d4202f4..76e012b 100644 --- a/MANIFEST.SKIP +++ b/MANIFEST.SKIP @@ -48,3 +48,15 @@ Build$ # Test::Kwalitee cache files. ^Debian_CPANTS\.txt +# Old tarballs etc +^SQL-Translator + +# patch and diff files +\.diff +\.patch +\.orig$ +\.rej$ + +# junk +\.log$ +\.tmp$ diff --git a/Makefile.PL b/Makefile.PL index cf7f04b..c7d12d0 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -18,8 +18,6 @@ my $deps = { 'File::ShareDir' => 1.0, 'File::Spec' => 0, 'XML::Writer' => 0.500, - 'XML::LibXML' => 1.69, - 'YAML' => 0.66, }, recommends => { 'Template' => 2.10, @@ -29,6 +27,8 @@ my $deps = { 'Spreadsheet::ParseExcel' => 0.41, 'Text::ParseWords' => 0, 'Text::RecordParser' => 0.02, + 'XML::LibXML' => 1.69, + 'YAML' => 0.66, }, test_requires => { 'File::Basename' => 0, diff --git a/README b/README index edc834d..7076ba5 100644 --- a/README +++ b/README @@ -18,26 +18,20 @@ parsed data via the built-in object model. Presently only the definition parts of SQL are handled (CREATE, ALTER), not the manipulation of data (INSERT, UPDATE, DELETE). -As of version 0.10, parsers exist for the following: +As of version 0.06, parsers exist for the following: Databases: - Access - DB2 - DBI-DB2 - DBI-MySQL - DBI-Oracle - DBI-PostgreSQL - DBI-SQLServer - DBI-SQLite - DBI-Sybase MySQL Oracle PostgreSQL - SQLServer SQLite - Storable Sybase + DBI-MySQL + DBI-PostgreSQL + DBI-SQLite + DBI-Sybase + Other: xSV : arbitrarily delimited text files Excel : Microsoft Excel spreadsheets @@ -47,27 +41,20 @@ As of version 0.10, parsers exist for the following: And the following producers exist: Databases: - DB2 MySQL Oracle PostgreSQL - SQLServer SQLite - Storable Sybase Code Generators: ClassDBI : Class::DBI classes - Dumper : create a "mysqldump"-like dumper for database - DBIx-Class : see the DBIx::Class distribution Documentation: Diagram : quasi-ER diagrams using libgd GraphViz : ER diagrams using GraphViz HTML : HTML documentation of schema POD : Plain Old Documenation of schema - Latex : self-explanatory - DiaUml : ditto Serialization: Storable : using Perl's Storable module @@ -81,12 +68,12 @@ Included in this distribution are a few scripts designed to be user interfaces for the actual SQL::Translator modules. In the "bin" directory, you will find: -* sqlt : command-line interface for text-to-text translations -* sqlt-diagram : interface to Diagram producer -* sqlt-diff : diff two schemas to generate schema mutation file -* sqlt-graph : interface to GraphViz producer -* sqlt-dumper : create a data dumper script from a schema -* sqlt.cgi : CGI interface for all SQLFairy functions +* sqlt-diagram: interface to Diagram producer +* sqlt-diff : diff two schemas to generate schema mutation file +* sqlt-graph : interface to GraphViz producer +* sqlt-dumper : create a data dumper script from a schema +* sqlt : command-line interface for text-to-text translations +* sqlt.cgi : CGI interface for all SQLFairy functions All scripts not ending in ".cgi" are meant to be run from the command line with various switches to control the input and output of the @@ -108,9 +95,11 @@ manipulate the SQL::Translator::Schema objects. INSTALLATION - $ perl Makefile.PL - $ make && make test - $ sudo make install + $ perl Build.PL + $ ./Build + $ ./Build test + $ su + # ./Build install MANUAL diff --git a/lib/SQL/Translator.pm b/lib/SQL/Translator.pm index 86fccc0..7981e67 100644 --- a/lib/SQL/Translator.pm +++ b/lib/SQL/Translator.pm @@ -24,15 +24,16 @@ use base 'Class::Base'; require 5.005; -$VERSION = '0.10000'; -$DEBUG = 0 unless defined $DEBUG; -$ERROR = ""; +$VERSION = '0.11000'; +$DEBUG = 0 unless defined $DEBUG; +$ERROR = ""; use Carp qw(carp); + use Data::Dumper; -use File::Basename qw(dirname); use File::Find; use File::Spec::Functions qw(catfile); +use File::Basename qw(dirname); use IO::Dir; use SQL::Translator::Producer; use SQL::Translator::Schema; diff --git a/lib/SQL/Translator/Diff.pm b/lib/SQL/Translator/Diff.pm index ff61b8d..91b8c1a 100644 --- a/lib/SQL/Translator/Diff.pm +++ b/lib/SQL/Translator/Diff.pm @@ -1,17 +1,15 @@ package SQL::Translator::Diff; + ## SQLT schema diffing code use strict; use warnings; + use Data::Dumper; use SQL::Translator::Schema::Constants; use base 'Class::Accessor::Fast'; -use vars qw[ $VERSION ]; - -$VERSION = 1.60; - # Input/option accessors __PACKAGE__->mk_accessors(qw/ ignore_index_names ignore_constraint_names ignore_view_sql diff --git a/lib/SQL/Translator/Filter/DefaultExtra.pm b/lib/SQL/Translator/Filter/DefaultExtra.pm index 405cfe8..21ebec8 100644 --- a/lib/SQL/Translator/Filter/DefaultExtra.pm +++ b/lib/SQL/Translator/Filter/DefaultExtra.pm @@ -51,14 +51,14 @@ objects. use strict; use vars qw/$VERSION/; -$VERSION = '1.60'; +$VERSION = '1.59'; sub filter { my $schema = shift; my %args = { +shift }; # Tables - for ( $schema->get_tables ) { + foreach ( $schema->get_tables ) { my %extra = $_->extra; $extra{label} ||= ucfirst($_->name); @@ -66,7 +66,7 @@ sub filter { } # Fields - for ( map { $_->get_fields } $schema->get_tables ) { + foreach ( map { $_->get_fields } $schema->get_tables ) { my %extra = $_->extra; $extra{label} ||= ucfirst($_->name); @@ -80,15 +80,17 @@ __END__ =head1 DESCRIPTION -Maybe I'm trying to do too much in one go. Args set a match and then -an update, if you want to set lots of things, use lots of filters! +Maybe I'm trying to do too much in one go. Args set a match and then an update, +if you want to set lots of things, use lots of filters! =head1 SEE ALSO L, L -=head1 AUTHOR +=head1 BUGS + +=head1 TODO -Unknown. +=head1 AUTHOR =cut diff --git a/lib/SQL/Translator/Filter/Globals.pm b/lib/SQL/Translator/Filter/Globals.pm index a3d3c4a..e1ead93 100644 --- a/lib/SQL/Translator/Filter/Globals.pm +++ b/lib/SQL/Translator/Filter/Globals.pm @@ -56,7 +56,7 @@ SQL::Translator::Filter::Globals - Add global fields and indices to all tables. use strict; use vars qw/$VERSION/; -$VERSION = '1.60'; +$VERSION = '1.59'; sub filter { my $schema = shift; @@ -147,22 +147,21 @@ __END__ =head1 DESCRIPTION -Adds global fields, indices and constraints to all tables in the -schema. The globals to add can either be defined in the filter args -or using a _GLOBAL_ table (see below). +Adds global fields, indices and constraints to all tables in the schema. +The globals to add can either be defined in the filter args or using a _GLOBAL_ +table (see below). -If a table already contains a field with the same name as a global -then it is skipped for that table. +If a table already contains a field with the same name as a global then it is +skipped for that table. =head2 The _GLOBAL_ Table -An alternative to using the args is to add a table called C<_GLOBAL_> -to the schema and then just use the filter. Any fields and indices -defined on this table will be added to all the tables in the schema -and the _GLOBAL_ table removed. +An alternative to using the args is to add a table called C<_GLOBAL_> to the +schema and then just use the filter. Any fields and indices defined on this table +will be added to all the tables in the schema and the _GLOBAL_ table removed. -The name of the global can be changed using a C arg to -the filter. +The name of the global can be changed using a C arg to the +filter. =head1 SEE ALSO @@ -170,16 +169,16 @@ L, L =head1 BUGS -Will generate duplicate indices if an index already exists on a table -the same as one added globally. +Will generate duplicate indices if an index already exists on a table the same +as one added globally. -Will generate duplicate constraints if a constraint already exists on -a table the same as one added globally. +Will generate duplicate constraints if a constraint already exists on a table +the same as one added globally. =head1 TODO -Some extra data values that can be used to control the global -addition. e.g. 'skip_global'. +Some extra data values that can be used to control the global addition. e.g. +'skip_global'. =head1 AUTHOR diff --git a/lib/SQL/Translator/Filter/Names.pm b/lib/SQL/Translator/Filter/Names.pm index cafa72c..afa0f1f 100644 --- a/lib/SQL/Translator/Filter/Names.pm +++ b/lib/SQL/Translator/Filter/Names.pm @@ -47,7 +47,7 @@ SQL::Translator::Filter::Names - Tweak the names of schema objects. use strict; use vars qw/$VERSION/; -$VERSION = '1.60'; +$VERSION = '1.59'; sub filter { my $schema = shift; @@ -99,17 +99,15 @@ sub _getfunc { # The name munging functions -# ------------------------------------------------------------------------- -# Get called with name to munge as first arg and return the new name. Die -# on errors. +#============================================================================= +# Get called with name to munge as first arg and return the new name. Die on +# errors. sub lc { lc shift; } sub uc { uc shift; } sub ucfirst { ucfirst shift; } -1; - -# ------------------------------------------------------------------------- +1; #========================================================================== __END__ @@ -119,6 +117,8 @@ __END__ L, L +=head1 BUGS + =head1 TODO =over 4 @@ -165,6 +165,4 @@ code it into the filter it's self. =head1 AUTHOR -Unknown. - =cut diff --git a/lib/SQL/Translator/Manual.pod b/lib/SQL/Translator/Manual.pod index 4b9b1df..4774437 100644 --- a/lib/SQL/Translator/Manual.pod +++ b/lib/SQL/Translator/Manual.pod @@ -540,4 +540,4 @@ See L for more details. =head1 AUTHOR -Ken Youens-Clark Ekclark@cpan.orgE. +Ken Y. Clark Ekclark@cpan.orgE. diff --git a/lib/SQL/Translator/Parser/Access.pm b/lib/SQL/Translator/Parser/Access.pm index 5e812e7..696ebcb 100644 --- a/lib/SQL/Translator/Parser/Access.pm +++ b/lib/SQL/Translator/Parser/Access.pm @@ -39,7 +39,7 @@ something similar to the output of mdbtools (http://mdbtools.sourceforge.net/). use strict; use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ]; -$VERSION = '1.60'; +$VERSION = '1.59'; $DEBUG = 0 unless defined $DEBUG; use Data::Dumper; @@ -472,7 +472,7 @@ sub parse { =head1 AUTHOR -Ken Youens-Clark Ekclark@cpan.orgE. +Ken Y. Clark Ekclark@cpan.orgE. =head1 SEE ALSO diff --git a/lib/SQL/Translator/Parser/DB2.pm b/lib/SQL/Translator/Parser/DB2.pm index fc2b18a..55032dc 100644 --- a/lib/SQL/Translator/Parser/DB2.pm +++ b/lib/SQL/Translator/Parser/DB2.pm @@ -1,13 +1,9 @@ package SQL::Translator::Parser::DB2; - use Data::Dumper; use SQL::Translator::Parser::DB2::Grammar; use Exporter; use base qw(Exporter); -use vars qw[ $VERSION ]; -$VERSION = '1.60'; - @EXPORT_OK = qw(parse); # Enable warnings within the Parse::RecDescent module. diff --git a/lib/SQL/Translator/Parser/DB2/Grammar.pm b/lib/SQL/Translator/Parser/DB2/Grammar.pm index 1c6017f..4452df2 100644 --- a/lib/SQL/Translator/Parser/DB2/Grammar.pm +++ b/lib/SQL/Translator/Parser/DB2/Grammar.pm @@ -1,8 +1,4 @@ package SQL::Translator::Parser::DB2::Grammar; - -use vars qw[ $VERSION ]; -$VERSION = '1.60'; - use Parse::RecDescent; { my $ERRORS; @@ -47956,4 +47952,4 @@ package SQL::Translator::Parser::DB2::Grammar; sub new { my $self = bless( { }, 'Parse::RecDescent::Rule' ) } }, 'Parse::RecDescent' ); -} +} \ No newline at end of file diff --git a/lib/SQL/Translator/Parser/DBI.pm b/lib/SQL/Translator/Parser/DBI.pm index 139f84c..1d0219d 100644 --- a/lib/SQL/Translator/Parser/DBI.pm +++ b/lib/SQL/Translator/Parser/DBI.pm @@ -119,7 +119,7 @@ query Oracle directly and skip the parsing of a text file, too. use strict; use DBI; use vars qw($VERSION @EXPORT); -$VERSION = '1.60'; +$VERSION = '1.59'; use constant DRIVERS => { mysql => 'MySQL', @@ -191,7 +191,7 @@ sub parse { =head1 AUTHOR -Ken Youens-Clark Ekclark@cpan.orgE. +Ken Y. Clark Ekclark@cpan.orgE. =head1 SEE ALSO diff --git a/lib/SQL/Translator/Parser/DBI/DB2.pm b/lib/SQL/Translator/Parser/DBI/DB2.pm index ab8d41f..9dcf35e 100644 --- a/lib/SQL/Translator/Parser/DBI/DB2.pm +++ b/lib/SQL/Translator/Parser/DBI/DB2.pm @@ -22,7 +22,7 @@ use SQL::Translator::Parser::DB2; use SQL::Translator::Schema::Constants; use vars qw[ $DEBUG $VERSION @EXPORT_OK ]; -$VERSION = '1.60'; +# $VERSION = '1.59'; $DEBUG = 0 unless defined $DEBUG; # ------------------------------------------------------------------- diff --git a/lib/SQL/Translator/Parser/DBI/MySQL.pm b/lib/SQL/Translator/Parser/DBI/MySQL.pm index d1f8868..dcabb1b 100644 --- a/lib/SQL/Translator/Parser/DBI/MySQL.pm +++ b/lib/SQL/Translator/Parser/DBI/MySQL.pm @@ -41,7 +41,7 @@ use SQL::Translator::Schema::Constants; use SQL::Translator::Parser::MySQL; use vars qw[ $DEBUG $VERSION @EXPORT_OK ]; -$VERSION = '1.60'; +$VERSION = '1.59'; $DEBUG = 0 unless defined $DEBUG; # ------------------------------------------------------------------- diff --git a/lib/SQL/Translator/Parser/DBI/Oracle.pm b/lib/SQL/Translator/Parser/DBI/Oracle.pm index ca4cd75..d111387 100644 --- a/lib/SQL/Translator/Parser/DBI/Oracle.pm +++ b/lib/SQL/Translator/Parser/DBI/Oracle.pm @@ -40,8 +40,7 @@ use SQL::Translator::Schema::Table; use SQL::Translator::Schema::Field; use SQL::Translator::Schema::Constraint; -use vars qw[ $VERSION ]; -$VERSION = '1.60'; +our $VERSION = '1.59'; # ------------------------------------------------------------------- sub parse { diff --git a/lib/SQL/Translator/Parser/DBI/PostgreSQL.pm b/lib/SQL/Translator/Parser/DBI/PostgreSQL.pm index a34263e..9606651 100644 --- a/lib/SQL/Translator/Parser/DBI/PostgreSQL.pm +++ b/lib/SQL/Translator/Parser/DBI/PostgreSQL.pm @@ -38,7 +38,7 @@ use Data::Dumper; use SQL::Translator::Schema::Constants; use vars qw[ $DEBUG $VERSION @EXPORT_OK ]; -$VERSION = '1.60'; +$VERSION = '1.59'; $DEBUG = 0 unless defined $DEBUG; my $actions = {c => 'cascade', diff --git a/lib/SQL/Translator/Parser/DBI/SQLServer.pm b/lib/SQL/Translator/Parser/DBI/SQLServer.pm index 37dd7fd..267e6f8 100644 --- a/lib/SQL/Translator/Parser/DBI/SQLServer.pm +++ b/lib/SQL/Translator/Parser/DBI/SQLServer.pm @@ -38,7 +38,7 @@ use SQL::Translator::Schema; use Data::Dumper; use vars qw[ $DEBUG $VERSION @EXPORT_OK ]; -$VERSION = '1.60'; +$VERSION = '1.59'; $DEBUG = 0 unless defined $DEBUG; no strict 'refs'; diff --git a/lib/SQL/Translator/Parser/DBI/SQLite.pm b/lib/SQL/Translator/Parser/DBI/SQLite.pm index c319f05..a95630e 100644 --- a/lib/SQL/Translator/Parser/DBI/SQLite.pm +++ b/lib/SQL/Translator/Parser/DBI/SQLite.pm @@ -43,7 +43,7 @@ use SQL::Translator::Parser::SQLite; use Data::Dumper; use vars qw[ $DEBUG $VERSION @EXPORT_OK ]; -$VERSION = '1.60'; +$VERSION = '1.59'; $DEBUG = 0 unless defined $DEBUG; # ------------------------------------------------------------------- @@ -74,7 +74,7 @@ sub parse { =head1 AUTHOR -Ken Youens-Clark Ekclark@cpan.orgE. +Ken Y. Clark Ekclark@cpan.orgE. =head1 SEE ALSO diff --git a/lib/SQL/Translator/Parser/DBI/Sybase.pm b/lib/SQL/Translator/Parser/DBI/Sybase.pm index 18ab6fe..d800fe0 100644 --- a/lib/SQL/Translator/Parser/DBI/Sybase.pm +++ b/lib/SQL/Translator/Parser/DBI/Sybase.pm @@ -38,7 +38,7 @@ use SQL::Translator::Schema; use Data::Dumper; use vars qw[ $DEBUG $VERSION @EXPORT_OK ]; -$VERSION = '1.60'; +$VERSION = '1.59'; $DEBUG = 0 unless defined $DEBUG; no strict 'refs'; diff --git a/lib/SQL/Translator/Parser/Excel.pm b/lib/SQL/Translator/Parser/Excel.pm index 2eed0dc..0d98f6b 100644 --- a/lib/SQL/Translator/Parser/Excel.pm +++ b/lib/SQL/Translator/Parser/Excel.pm @@ -49,7 +49,7 @@ and field sizes. True by default. use strict; use vars qw($DEBUG $VERSION @EXPORT_OK); $DEBUG = 0 unless defined $DEBUG; -$VERSION = '1.60'; +$VERSION = '1.59'; use Spreadsheet::ParseExcel; use Exporter; @@ -212,7 +212,7 @@ sub ET_to_ST { Mike Mellilo , darren chamberlain Edlc@users.sourceforge.netE, -Ken Youens-Clark Ekclark@cpan.orgE. +Ken Y. Clark Ekclark@cpan.orgE. =head1 SEE ALSO diff --git a/lib/SQL/Translator/Parser/MySQL.pm b/lib/SQL/Translator/Parser/MySQL.pm index 5383f74..38b062b 100644 --- a/lib/SQL/Translator/Parser/MySQL.pm +++ b/lib/SQL/Translator/Parser/MySQL.pm @@ -147,7 +147,7 @@ More information about the MySQL comment-syntax: Lkclark@cpan.orgE, +Ken Y. Clark Ekclark@cpan.orgE, Allen Day Eallenday@ucla.eduE. =head1 SEE ALSO diff --git a/lib/SQL/Translator/Parser/SQLServer.pm b/lib/SQL/Translator/Parser/SQLServer.pm index 21d443e..98c7fe1 100644 --- a/lib/SQL/Translator/Parser/SQLServer.pm +++ b/lib/SQL/Translator/Parser/SQLServer.pm @@ -37,7 +37,7 @@ should probably be considered a work in progress. use strict; use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ]; -$VERSION = '1.60'; +$VERSION = '1.59'; $DEBUG = 0 unless defined $DEBUG; use Data::Dumper; diff --git a/lib/SQL/Translator/Parser/SQLite.pm b/lib/SQL/Translator/Parser/SQLite.pm index 9b72e76..c4c2fe1 100644 --- a/lib/SQL/Translator/Parser/SQLite.pm +++ b/lib/SQL/Translator/Parser/SQLite.pm @@ -150,7 +150,7 @@ like-op::= use strict; use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ]; -$VERSION = '1.60'; +$VERSION = '1.59'; $DEBUG = 0 unless defined $DEBUG; use Data::Dumper; diff --git a/lib/SQL/Translator/Parser/Storable.pm b/lib/SQL/Translator/Parser/Storable.pm index f3e9392..d50cf88 100644 --- a/lib/SQL/Translator/Parser/Storable.pm +++ b/lib/SQL/Translator/Parser/Storable.pm @@ -40,7 +40,7 @@ the data into a database tables or graphs. use strict; use vars qw($DEBUG $VERSION @EXPORT_OK); $DEBUG = 0 unless defined $DEBUG; -$VERSION = '1.60'; +$VERSION = '1.59'; use Storable; use Exporter; diff --git a/lib/SQL/Translator/Parser/Sybase.pm b/lib/SQL/Translator/Parser/Sybase.pm index 4ea0850..9b7814c 100644 --- a/lib/SQL/Translator/Parser/Sybase.pm +++ b/lib/SQL/Translator/Parser/Sybase.pm @@ -38,7 +38,7 @@ DBI-Sybase parser included with SQL::Translator. use strict; use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ]; -$VERSION = '1.60'; +$VERSION = '1.59'; $DEBUG = 0 unless defined $DEBUG; use Data::Dumper; @@ -416,7 +416,7 @@ sub parse { =head1 AUTHOR -Ken Youens-Clark Ekclark@cpan.orgE. +Ken Y. Clark Ekclark@cpan.orgE. =head1 SEE ALSO diff --git a/lib/SQL/Translator/Parser/XML.pm b/lib/SQL/Translator/Parser/XML.pm index bb8f176..2cec293 100644 --- a/lib/SQL/Translator/Parser/XML.pm +++ b/lib/SQL/Translator/Parser/XML.pm @@ -34,7 +34,7 @@ SQL::Translator::Parser::XML::SQLFairy. =head1 AUTHOR -Ken Youens-Clark Ekclark@cpan.orgE. +Ken Y. Clark Ekclark@cpan.orgE. =cut @@ -42,7 +42,7 @@ Ken Youens-Clark Ekclark@cpan.orgE. use strict; use vars qw[ $VERSION $DEBUG ]; -$VERSION = '1.60'; +$VERSION = '1.59'; $DEBUG = 1 unless defined $DEBUG; use SQL::Translator::Parser::XML::SQLFairy; diff --git a/lib/SQL/Translator/Parser/XML/SQLFairy.pm b/lib/SQL/Translator/Parser/XML/SQLFairy.pm index 3f681ae..390a4ca 100644 --- a/lib/SQL/Translator/Parser/XML/SQLFairy.pm +++ b/lib/SQL/Translator/Parser/XML/SQLFairy.pm @@ -1,7 +1,6 @@ package SQL::Translator::Parser::XML::SQLFairy; # ------------------------------------------------------------------- -# Copyright (C) 2002-2009 The SQLFairy Authors, # Copyright (C) 2003 Mark Addison , # Copyright (C) 2009 Jonathan Yu # @@ -100,7 +99,7 @@ To convert your old format files simply pass them through the translator :) use strict; use vars qw[ $DEBUG $VERSION @EXPORT_OK ]; -$VERSION = '1.60'; +$VERSION = '1.59'; $DEBUG = 0 unless defined $DEBUG; use Data::Dumper; diff --git a/lib/SQL/Translator/Parser/YAML.pm b/lib/SQL/Translator/Parser/YAML.pm index 1cc9fa1..4170d1f 100644 --- a/lib/SQL/Translator/Parser/YAML.pm +++ b/lib/SQL/Translator/Parser/YAML.pm @@ -20,7 +20,7 @@ package SQL::Translator::Parser::YAML; use strict; use vars qw($VERSION); -$VERSION = '1.60'; +$VERSION = '1.59'; use SQL::Translator::Schema; use SQL::Translator::Utils qw(header_comment); @@ -154,4 +154,4 @@ C parses a schema serialized with YAML. =head1 AUTHORS Darren Chamberlain Edarren@cpan.orgE, -Ken Youens-Clark Ekclark@cpan.orgE. +Ken Y. Clark Ekclark@cpan.orgE. diff --git a/lib/SQL/Translator/Parser/xSV.pm b/lib/SQL/Translator/Parser/xSV.pm index 0006b46..3ab2f12 100644 --- a/lib/SQL/Translator/Parser/xSV.pm +++ b/lib/SQL/Translator/Parser/xSV.pm @@ -65,7 +65,7 @@ C. use strict; use vars qw($VERSION @EXPORT); -$VERSION = '1.60'; +$VERSION = '1.59'; use Exporter; use Text::ParseWords qw(quotewords); @@ -189,7 +189,7 @@ sub parse { =head1 AUTHORS Darren Chamberlain Edarren@cpan.orgE, -Ken Youens-Clark Ekclark@cpan.orgE. +Ken Y. Clark Ekclark@cpan.orgE. =head1 SEE ALSO diff --git a/lib/SQL/Translator/Producer.pm b/lib/SQL/Translator/Producer.pm index 86e5c55..b2ba10e 100644 --- a/lib/SQL/Translator/Producer.pm +++ b/lib/SQL/Translator/Producer.pm @@ -1,7 +1,7 @@ package SQL::Translator::Producer; # ------------------------------------------------------------------- -# Copyright (C) 2002-2009 SQLFairy Authors +# 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 @@ -20,7 +20,7 @@ package SQL::Translator::Producer; use strict; use vars qw($VERSION); -$VERSION = '1.60'; +$VERSION = '1.59'; sub produce { "" } @@ -105,7 +105,7 @@ by the parser. It is expected to return a string. =head1 AUTHORS Darren Chamberlain Edarren@cpan.orgE, -Ken Youens-Clark Ekclark@cpan.orgE. +Ken Y. Clark Ekclark@cpan.orgE. =head1 SEE ALSO diff --git a/lib/SQL/Translator/Producer/ClassDBI.pm b/lib/SQL/Translator/Producer/ClassDBI.pm index 61e731d..e6ecd40 100644 --- a/lib/SQL/Translator/Producer/ClassDBI.pm +++ b/lib/SQL/Translator/Producer/ClassDBI.pm @@ -20,7 +20,7 @@ package SQL::Translator::Producer::ClassDBI; use strict; use vars qw[ $VERSION $DEBUG ]; -$VERSION = '1.60'; +$VERSION = '1.59'; $DEBUG = 1 unless defined $DEBUG; use SQL::Translator::Schema::Constants; diff --git a/lib/SQL/Translator/Producer/DB2.pm b/lib/SQL/Translator/Producer/DB2.pm index e71e9e7..a343674 100644 --- a/lib/SQL/Translator/Producer/DB2.pm +++ b/lib/SQL/Translator/Producer/DB2.pm @@ -37,7 +37,7 @@ Creates an SQL DDL suitable for DB2. use warnings; use strict; use vars qw[ $VERSION $DEBUG $WARN ]; -$VERSION = '1.60'; +$VERSION = '1.59'; $DEBUG = 0 unless defined $DEBUG; use SQL::Translator::Schema::Constants; diff --git a/lib/SQL/Translator/Producer/DiaUml.pm b/lib/SQL/Translator/Producer/DiaUml.pm index 8230cfe..7c02d33 100644 --- a/lib/SQL/Translator/Producer/DiaUml.pm +++ b/lib/SQL/Translator/Producer/DiaUml.pm @@ -57,7 +57,7 @@ automatically arrange them horizontally or vertically. use strict; use vars qw[ $DEBUG $VERSION @EXPORT_OK ]; -$VERSION = '1.60'; +$VERSION = '1.59'; $DEBUG = 0 unless defined $DEBUG; use File::ShareDir qw/dist_dir/; diff --git a/lib/SQL/Translator/Producer/Diagram.pm b/lib/SQL/Translator/Producer/Diagram.pm index 20085bb..93b67c8 100644 --- a/lib/SQL/Translator/Producer/Diagram.pm +++ b/lib/SQL/Translator/Producer/Diagram.pm @@ -40,7 +40,7 @@ use SQL::Translator::Schema::Constants; use SQL::Translator::Utils qw(debug); use vars qw[ $VERSION $DEBUG ]; -$VERSION = '1.60'; +$VERSION = '1.59'; $DEBUG = 0 unless defined $DEBUG; use constant VALID_FONT_SIZE => { diff --git a/lib/SQL/Translator/Producer/Dumper.pm b/lib/SQL/Translator/Producer/Dumper.pm index bba9974..b24b78b 100644 --- a/lib/SQL/Translator/Producer/Dumper.pm +++ b/lib/SQL/Translator/Producer/Dumper.pm @@ -1,7 +1,7 @@ package SQL::Translator::Producer::Dumper; # ------------------------------------------------------------------- -# Copyright (C) 2002-2009 SQLFairy Authors +# Copyright (C) 2002-2006 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 @@ -59,7 +59,7 @@ use vars qw($VERSION); use Data::Dumper; -$VERSION = '1.60'; +$VERSION = '1.59'; sub produce { my $t = shift; diff --git a/lib/SQL/Translator/Producer/GraphViz.pm b/lib/SQL/Translator/Producer/GraphViz.pm index 518872d..a360e4c 100644 --- a/lib/SQL/Translator/Producer/GraphViz.pm +++ b/lib/SQL/Translator/Producer/GraphViz.pm @@ -233,7 +233,7 @@ use SQL::Translator::Utils qw(debug); use Scalar::Util qw/openhandle/; use vars qw[ $VERSION $DEBUG ]; -$VERSION = '1.60'; +$VERSION = '1.59'; $DEBUG = 0 unless defined $DEBUG; sub produce { @@ -631,11 +631,12 @@ sub produce { =head1 AUTHOR -Ken Youens-Clark Ekclark@cpan.orgE, -Jonathan Yu Efrequency@cpan.orgE. +Ken Youens-Clark Ekclark@cpan.orgE + +Jonathan Yu Efrequency@cpan.orgE =head1 SEE ALSO -SQL::Translator, GraphViz. +SQL::Translator, GraphViz =cut diff --git a/lib/SQL/Translator/Producer/HTML.pm b/lib/SQL/Translator/Producer/HTML.pm index 79e70a8..6659fb3 100644 --- a/lib/SQL/Translator/Producer/HTML.pm +++ b/lib/SQL/Translator/Producer/HTML.pm @@ -22,7 +22,7 @@ use strict; use Data::Dumper; use vars qw($VERSION $NOWRAP $NOLINKTABLE $NAME); -$VERSION = '1.60'; +$VERSION = '1.59'; $NAME = __PACKAGE__; $NOWRAP = 0 unless defined $NOWRAP; diff --git a/lib/SQL/Translator/Producer/Latex.pm b/lib/SQL/Translator/Producer/Latex.pm index 5bb031e..c2bbf79 100644 --- a/lib/SQL/Translator/Producer/Latex.pm +++ b/lib/SQL/Translator/Producer/Latex.pm @@ -1,7 +1,7 @@ package SQL::Translator::Producer::Latex; # ------------------------------------------------------------------- -# Copyright (C) 2002-2009 SQLFairy Authors +# Copyright (C) 2002-6 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 @@ -57,7 +57,7 @@ automatically arrange them horizontally or vertically. use strict; use vars qw[ $DEBUG $VERSION @EXPORT_OK ]; -$VERSION = '1.60'; +$VERSION = '1.59'; $DEBUG = 0 unless defined $DEBUG; use SQL::Translator::Utils 'debug'; @@ -112,7 +112,7 @@ sub latex { =head1 AUTHOR -Chris Mungall. +Chris Mungall =head1 SEE ALSO diff --git a/lib/SQL/Translator/Producer/MySQL.pm b/lib/SQL/Translator/Producer/MySQL.pm index 924a7f1..a7ebb05 100644 --- a/lib/SQL/Translator/Producer/MySQL.pm +++ b/lib/SQL/Translator/Producer/MySQL.pm @@ -100,7 +100,7 @@ Set the fields charater set and collation order. use strict; use warnings; use vars qw[ $VERSION $DEBUG %used_names ]; -$VERSION = '1.60'; +$VERSION = '1.59'; $DEBUG = 0 unless defined $DEBUG; # Maximum length for most identifiers is 64, according to: diff --git a/lib/SQL/Translator/Producer/Oracle.pm b/lib/SQL/Translator/Producer/Oracle.pm index 00a9e2e..2ae0f3f 100644 --- a/lib/SQL/Translator/Producer/Oracle.pm +++ b/lib/SQL/Translator/Producer/Oracle.pm @@ -98,7 +98,7 @@ context the slash will be still there to ensure compatibility with SQLPlus. use strict; use vars qw[ $VERSION $DEBUG $WARN ]; -$VERSION = '1.60'; +$VERSION = '1.59'; $DEBUG = 0 unless defined $DEBUG; use SQL::Translator::Schema::Constants; diff --git a/lib/SQL/Translator/Producer/POD.pm b/lib/SQL/Translator/Producer/POD.pm index f1b7b70..e7a1e75 100644 --- a/lib/SQL/Translator/Producer/POD.pm +++ b/lib/SQL/Translator/Producer/POD.pm @@ -40,7 +40,7 @@ interesting formats using Pod::POM or Template::Toolkit's POD plugin. use strict; use vars qw[ $VERSION ]; -$VERSION = '1.60'; +$VERSION = '1.59'; use SQL::Translator::Schema::Constants; use SQL::Translator::Utils qw(header_comment); diff --git a/lib/SQL/Translator/Producer/PostgreSQL.pm b/lib/SQL/Translator/Producer/PostgreSQL.pm index aa90309..ae37a83 100644 --- a/lib/SQL/Translator/Producer/PostgreSQL.pm +++ b/lib/SQL/Translator/Producer/PostgreSQL.pm @@ -37,7 +37,7 @@ producer. use strict; use warnings; use vars qw[ $DEBUG $WARN $VERSION %used_names ]; -$VERSION = '1.60'; +$VERSION = '1.59'; $DEBUG = 0 unless defined $DEBUG; use base qw(SQL::Translator::Producer); diff --git a/lib/SQL/Translator/Producer/SQLServer.pm b/lib/SQL/Translator/Producer/SQLServer.pm index 8ac2ed9..11cee5f 100644 --- a/lib/SQL/Translator/Producer/SQLServer.pm +++ b/lib/SQL/Translator/Producer/SQLServer.pm @@ -54,7 +54,7 @@ List of values for an enum field. use strict; use vars qw[ $DEBUG $WARN $VERSION ]; -$VERSION = '1.60'; +$VERSION = '1.59'; $DEBUG = 1 unless defined $DEBUG; use Data::Dumper; diff --git a/lib/SQL/Translator/Producer/SQLite.pm b/lib/SQL/Translator/Producer/SQLite.pm index d03112c..f85b360 100644 --- a/lib/SQL/Translator/Producer/SQLite.pm +++ b/lib/SQL/Translator/Producer/SQLite.pm @@ -40,15 +40,14 @@ use warnings; use Data::Dumper; use SQL::Translator::Schema::Constants; use SQL::Translator::Utils qw(debug header_comment); -use Readonly; use vars qw[ $VERSION $DEBUG $WARN ]; -$VERSION = '1.60'; -$DEBUG = 0 if !defined $DEBUG; -$WARN = 0 if !defined $WARN; +$VERSION = '1.59'; +$DEBUG = 0 unless defined $DEBUG; +$WARN = 0 unless defined $WARN; -Readonly my $MAX_ID_LENGTH => 30; +our $max_id_length = 30; my %global_names; sub produce { @@ -107,8 +106,8 @@ sub mk_name { if ( my $prev = $scope->{ $name } ) { my $name_orig = $name; $name .= sprintf( "%02d", ++$prev ); - substr($name, $MAX_ID_LENGTH - 3) = "00" - if length( $name ) > $MAX_ID_LENGTH; + substr($name, $max_id_length - 3) = "00" + if length( $name ) > $max_id_length; warn "The name '$name_orig' has been changed to ", "'$name' to make it unique.\n" if $WARN; @@ -526,7 +525,7 @@ SQL::Translator, http://www.sqlite.org/. =head1 AUTHOR -Ken Youens-Clark Ekclark@cpan.orgE. +Ken Youens-Clark C<< >>. Diff code added by Ash Berlin C<< >>. diff --git a/lib/SQL/Translator/Producer/Storable.pm b/lib/SQL/Translator/Producer/Storable.pm index 6cf84be..3c918c0 100644 --- a/lib/SQL/Translator/Producer/Storable.pm +++ b/lib/SQL/Translator/Producer/Storable.pm @@ -41,7 +41,7 @@ takes a long time. use strict; use vars qw($DEBUG $VERSION @EXPORT_OK); $DEBUG = 0 unless defined $DEBUG; -$VERSION = '1.60'; +$VERSION = '1.59'; use Storable; use Exporter; diff --git a/lib/SQL/Translator/Producer/Sybase.pm b/lib/SQL/Translator/Producer/Sybase.pm index 1ba6970..5755cfc 100644 --- a/lib/SQL/Translator/Producer/Sybase.pm +++ b/lib/SQL/Translator/Producer/Sybase.pm @@ -37,7 +37,7 @@ This module will produce text output of the schema suitable for Sybase. use strict; use vars qw[ $DEBUG $WARN $VERSION ]; -$VERSION = '1.60'; +$VERSION = '1.59'; $DEBUG = 1 unless defined $DEBUG; use Data::Dumper; diff --git a/lib/SQL/Translator/Producer/TT/Base.pm b/lib/SQL/Translator/Producer/TT/Base.pm index ff87737..7533820 100644 --- a/lib/SQL/Translator/Producer/TT/Base.pm +++ b/lib/SQL/Translator/Producer/TT/Base.pm @@ -30,7 +30,7 @@ class. use strict; use vars qw[ $VERSION @EXPORT_OK ]; -$VERSION = '1.60'; +$VERSION = '1.59'; use Template; use Data::Dumper; diff --git a/lib/SQL/Translator/Producer/TT/Table.pm b/lib/SQL/Translator/Producer/TT/Table.pm index e84b563..35f9d65 100644 --- a/lib/SQL/Translator/Producer/TT/Table.pm +++ b/lib/SQL/Translator/Producer/TT/Table.pm @@ -176,7 +176,7 @@ whitespace either side, to be recognised. use strict; use vars qw[ $DEBUG $VERSION @EXPORT_OK ]; -$VERSION = '1.60'; +$VERSION = '1.59'; $DEBUG = 0 unless defined $DEBUG; use File::Path; diff --git a/lib/SQL/Translator/Producer/TTSchema.pm b/lib/SQL/Translator/Producer/TTSchema.pm index 307e3ad..839e22e 100644 --- a/lib/SQL/Translator/Producer/TTSchema.pm +++ b/lib/SQL/Translator/Producer/TTSchema.pm @@ -127,7 +127,7 @@ constructor. use strict; use vars qw[ $DEBUG $VERSION @EXPORT_OK ]; -$VERSION = '1.60'; +$VERSION = '1.59'; $DEBUG = 0 unless defined $DEBUG; use Template; diff --git a/lib/SQL/Translator/Producer/XML.pm b/lib/SQL/Translator/Producer/XML.pm index 8312918..e306a2c 100644 --- a/lib/SQL/Translator/Producer/XML.pm +++ b/lib/SQL/Translator/Producer/XML.pm @@ -44,7 +44,7 @@ Ken Youens-Clark Ekclark@cpan.orgE. use strict; use vars qw[ $VERSION $DEBUG ]; -$VERSION = '1.60'; +$VERSION = '1.59'; $DEBUG = 1 unless defined $DEBUG; use SQL::Translator::Producer::XML::SQLFairy; diff --git a/lib/SQL/Translator/Producer/XML/SQLFairy.pm b/lib/SQL/Translator/Producer/XML/SQLFairy.pm index bd6afe4..6e58924 100644 --- a/lib/SQL/Translator/Producer/XML/SQLFairy.pm +++ b/lib/SQL/Translator/Producer/XML/SQLFairy.pm @@ -160,7 +160,7 @@ To convert your old format files simply pass them through the translator :) use strict; use vars qw[ $VERSION @EXPORT_OK ]; -$VERSION = '1.60'; +$VERSION = '1.59'; use Exporter; use base qw(Exporter); diff --git a/lib/SQL/Translator/Producer/YAML.pm b/lib/SQL/Translator/Producer/YAML.pm index 31b2420..68ecd8f 100644 --- a/lib/SQL/Translator/Producer/YAML.pm +++ b/lib/SQL/Translator/Producer/YAML.pm @@ -39,7 +39,7 @@ takes a long time. use strict; use vars qw($VERSION); -$VERSION = '1.60'; +$VERSION = '1.59'; use YAML qw(Dump); diff --git a/lib/SQL/Translator/Schema.pm b/lib/SQL/Translator/Schema.pm index c53789f..6268f21 100644 --- a/lib/SQL/Translator/Schema.pm +++ b/lib/SQL/Translator/Schema.pm @@ -56,7 +56,7 @@ use SQL::Translator::Utils 'parse_list_arg'; use base 'SQL::Translator::Schema::Object'; use vars qw[ $VERSION ]; -$VERSION = '1.60'; +$VERSION = '1.59'; __PACKAGE__->_attributes(qw/name database translator/); diff --git a/lib/SQL/Translator/Schema/Constants.pm b/lib/SQL/Translator/Schema/Constants.pm index e03027f..a1aab04 100644 --- a/lib/SQL/Translator/Schema/Constants.pm +++ b/lib/SQL/Translator/Schema/Constants.pm @@ -61,7 +61,7 @@ use strict; use base qw( Exporter ); use vars qw( @EXPORT $VERSION ); require Exporter; -$VERSION = '1.60'; +$VERSION = '1.59'; @EXPORT = qw[ CHECK_C diff --git a/lib/SQL/Translator/Schema/Constraint.pm b/lib/SQL/Translator/Schema/Constraint.pm index 4a77686..84f1d8c 100644 --- a/lib/SQL/Translator/Schema/Constraint.pm +++ b/lib/SQL/Translator/Schema/Constraint.pm @@ -49,7 +49,7 @@ use base 'SQL::Translator::Schema::Object'; use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT); -$VERSION = '1.60'; +$VERSION = '1.59'; my %VALID_CONSTRAINT_TYPE = ( PRIMARY_KEY, 1, diff --git a/lib/SQL/Translator/Schema/Field.pm b/lib/SQL/Translator/Schema/Field.pm index bade685..3249d95 100644 --- a/lib/SQL/Translator/Schema/Field.pm +++ b/lib/SQL/Translator/Schema/Field.pm @@ -48,7 +48,7 @@ use base 'SQL::Translator::Schema::Object'; use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT); -$VERSION = '1.60'; +$VERSION = '1.59'; # 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 diff --git a/lib/SQL/Translator/Schema/Graph.pm b/lib/SQL/Translator/Schema/Graph.pm index ca508a7..897e535 100644 --- a/lib/SQL/Translator/Schema/Graph.pm +++ b/lib/SQL/Translator/Schema/Graph.pm @@ -4,305 +4,253 @@ use strict; use base 'Class::Base'; -use vars qw[ $VERSION ]; -$VERSION = '1.60'; - use Data::Dumper; +local $Data::Dumper::Maxdepth = 3; + use SQL::Translator::Schema::Graph::Node; use SQL::Translator::Schema::Graph::Edge; use SQL::Translator::Schema::Graph::Port; use SQL::Translator::Schema::Graph::CompoundEdge; use SQL::Translator::Schema::Graph::HyperEdge; -use Readonly; -local $Data::Dumper::Maxdepth = 3; - -Readonly my $Node => 'SQL::Translator::Schema::Graph::Node'; -Readonly my $Edge => 'SQL::Translator::Schema::Graph::Edge'; -Readonly my $Port => 'SQL::Translator::Schema::Graph::Port'; -Readonly my $CompoundEdge => 'SQL::Translator::Schema::Graph::CompoundEdge'; -Readonly my $HyperEdge => 'SQL::Translator::Schema::Graph::HyperEdge'; +use constant Node => 'SQL::Translator::Schema::Graph::Node'; +use constant Edge => 'SQL::Translator::Schema::Graph::Edge'; +use constant Port => 'SQL::Translator::Schema::Graph::Port'; +use constant CompoundEdge => 'SQL::Translator::Schema::Graph::CompoundEdge'; +use constant HyperEdge => 'SQL::Translator::Schema::Graph::HyperEdge'; use Class::MakeMethods::Template::Hash ( - 'new --and_then_init' => 'new', - object => [ 'translator' => { class => 'SQL::Translator' }, ], - 'hash' => [qw( node )], - 'number --counter' => [qw( order )], + 'new --and_then_init' => 'new', + object => [ + 'translator' => {class => 'SQL::Translator'}, + ], + 'hash' => [ qw( node ) ], + 'number --counter' => [ qw( order ) ], ); use vars qw/$DEBUG/; $DEBUG = 0 unless defined $DEBUG; sub init { - my $self = shift; - - # - # build package objects - # - for my $table ( $self->translator->schema->get_tables ) { - die __PACKAGE__ - . " table " - . $table->name - . " doesn't have a primary key!" - unless $table->primary_key; - die __PACKAGE__ - . " table " - . $table->name - . " can't have a composite primary key!" - if ( $table->primary_key->fields )[1]; - - my $node = $Node->new(); - - $self->node_push( $table->name => $node ); - - if ( $table->is_trivial_link ) { $node->is_trivial_link(1); } - else { $node->is_trivial_link(0); } - - $node->order( $self->order_incr() ); - $node->name( $self->translator->format_package_name( $table->name ) ); - $node->table($table); - $node->primary_key( ( $table->primary_key->fields )[0] ); - - # Primary key may have a differenct accessor method name - $node->primary_key_accessor( - defined( $self->translator->format_pk_name ) - ? $self->translator->format_pk_name->( - $node->name, $node->primary_key - ) - : undef - ); - } - - for my $node ( $self->node_values ) { - for my $field ( $node->table->get_fields ) { - if ( !$field->is_foreign_key && !$field->is_primary_key ) { - $node->data_fields->{ $field->name } = 1; - } - elsif ( $field->is_foreign_key ) { - my $that = - $self->node( $field->foreign_key_reference->reference_table ); - - #this means we have an incomplete schema - next unless $that; - - my $edge = $Edge->new( - type => 'import', - thisnode => $node, - thisfield => $field, - thatnode => $that, - - #can you believe this sh*t just to get a field obj? - thatfield => $self->translator->schema->get_table( - $field->foreign_key_reference->reference_table - )->get_field( - ( $field->foreign_key_reference->reference_fields )[0] - ) - ); - - $node->edgecount( $that->name, - $node->edgecount( $that->name ) + 1 ); - - $node->has( $that->name, $node->has( $that->name ) + 1 ); - $that->many( $node->name, $that->many( $node->name ) + 1 ); - - $that->edgecount( $node->name, - $that->edgecount( $node->name ) + 1 ); - - #warn "\t" . $node->name . "\t" . $node->edgecount($that->name); - $node->push_edges($edge); - $that->push_edges( $edge->flip ); - } - } - } - - # - # type MM relationships - # - #for linknode - for my $lnode ( sort $self->node_values ) { - next if $lnode->table->is_data; - for my $inode1 ( sort $self->node_values ) { - - #linknode can't link to itself - next if $inode1 eq $lnode; - - my @inode1_imports = - grep { $_->type eq 'import' and $_->thatnode eq $inode1 } - $lnode->edges; - next unless @inode1_imports; - - for my $inode2 ( sort $self->node_values ) { - - #linknode can't link to itself - next if $inode2 eq $lnode; - - #identify tables that import keys to linknode - my %i = - map { $_->thatnode->name => 1 } - grep { $_->type eq 'import' } $lnode->edges; - - if ( scalar( keys %i ) == 1 ) { - } - else { - last if $inode1 eq $inode2; - } - - my @inode2_imports = - grep { $_->type eq 'import' and $_->thatnode eq $inode2 } - $lnode->edges; - next unless @inode2_imports; - - my $cedge = $CompoundEdge->new(); - $cedge->via($lnode); - - $cedge->push_edges( - map { $_->flip } - grep { - $_->type eq 'import' - and - ( $_->thatnode eq $inode1 or $_->thatnode eq $inode2 ) - } $lnode->edges - ); - - if ( scalar(@inode1_imports) == 1 - and scalar(@inode2_imports) == 1 ) - { - $cedge->type('one2one'); - - $inode1->via( $inode2->name, - $inode1->via( $inode2->name ) + 1 ); - $inode2->via( $inode1->name, - $inode2->via( $inode1->name ) + 1 ); - } - elsif ( scalar(@inode1_imports) > 1 - and scalar(@inode2_imports) == 1 ) - { - $cedge->type('many2one'); - - $inode1->via( $inode2->name, - $inode1->via( $inode2->name ) + 1 ); - $inode2->via( $inode1->name, - $inode2->via( $inode1->name ) + 1 ); - } - elsif ( scalar(@inode1_imports) == 1 - and scalar(@inode2_imports) > 1 ) - { - - #handled above - } - elsif ( scalar(@inode1_imports) > 1 - and scalar(@inode2_imports) > 1 ) - { - $cedge->type('many2many'); - - $inode1->via( $inode2->name, - $inode1->via( $inode2->name ) + 1 ); - $inode2->via( $inode1->name, - $inode2->via( $inode1->name ) + 1 ); - } - - $inode1->push_compoundedges($cedge); - $inode2->push_compoundedges($cedge) unless $inode1 eq $inode2; - } + my $self = shift; + + # + # build package objects + # + foreach my $table ($self->translator->schema->get_tables){ + die __PACKAGE__." table ".$table->name." doesn't have a primary key!" unless $table->primary_key; + die __PACKAGE__." table ".$table->name." can't have a composite primary key!" if ($table->primary_key->fields)[1]; + + my $node = Node->new(); + + $self->node_push($table->name => $node); + + if ($table->is_trivial_link) { $node->is_trivial_link(1); } + else { $node->is_trivial_link(0); } + + $node->order($self->order_incr()); + $node->name( $self->translator->format_package_name($table->name) ); + $node->table( $table ); + $node->primary_key( ($table->primary_key->fields)[0] ); + + # Primary key may have a differenct accessor method name + $node->primary_key_accessor( + defined($self->translator->format_pk_name) + ? $self->translator->format_pk_name->( $node->name, $node->primary_key ) + : undef + ); + } + + foreach my $node ($self->node_values){ + foreach my $field ($node->table->get_fields){ + if (!$field->is_foreign_key && !$field->is_primary_key) { $node->data_fields->{$field->name} = 1; } + elsif($field->is_foreign_key) { + my $that = $self->node($field->foreign_key_reference->reference_table); + + #this means we have an incomplete schema + next unless $that; + + my $edge = Edge->new( + type => 'import', + thisnode => $node, + thisfield => $field, + thatnode => $that, + #can you believe this sh*t just to get a field obj? + thatfield => $self->translator->schema->get_table($field->foreign_key_reference->reference_table)->get_field(($field->foreign_key_reference->reference_fields)[0]) + ); + + $node->edgecount($that->name, $node->edgecount($that->name)+1); + + $node->has($that->name, $node->has($that->name)+1); + $that->many($node->name, $that->many($node->name)+1); + + $that->edgecount($node->name, $that->edgecount($node->name)+1); + + #warn "\t" . $node->name . "\t" . $node->edgecount($that->name); + $node->push_edges( $edge ); + $that->push_edges( $edge->flip ); + } + } + + #warn Dumper($node->edgecount()); + #warn "*****"; + } + + # + # type MM relationships + # + #foreach linknode + foreach my $lnode (sort $self->node_values){ + next if $lnode->table->is_data; + foreach my $inode1 (sort $self->node_values){ + #linknode can't link to itself + next if $inode1 eq $lnode; + + my @inode1_imports = grep { $_->type eq 'import' and $_->thatnode eq $inode1 } $lnode->edges; + next unless @inode1_imports; + + foreach my $inode2 (sort $self->node_values){ + #linknode can't link to itself + next if $inode2 eq $lnode; + + #identify tables that import keys to linknode + my %i = map {$_->thatnode->name => 1} grep { $_->type eq 'import'} $lnode->edges; + + if(scalar(keys %i) == 1) { + } else { + last if $inode1 eq $inode2; + } + + my @inode2_imports = grep { $_->type eq 'import' and $_->thatnode eq $inode2 } $lnode->edges; + next unless @inode2_imports; + + my $cedge = CompoundEdge->new(); + $cedge->via($lnode); + + #warn join ' ', map {$_->thisfield->name} map {$_->flip} $lnode->edges; + #warn join ' ', map {$_->thisfield->name} $lnode->edges; + #warn join ' ', map {$_->thisfield->name} map {$_->flip} grep {$_->type eq 'import'} $lnode->edges; + #warn join ' ', map {$_->thatfield->name} map {$_->flip} grep {$_->type eq 'import'} $lnode->edges; + $cedge->push_edges( + map {$_->flip} + grep {$_->type eq 'import' + and + ($_->thatnode eq $inode1 or $_->thatnode eq $inode2) + } $lnode->edges + ); + + if(scalar(@inode1_imports) == 1 and scalar(@inode2_imports) == 1){ + $cedge->type('one2one'); + + $inode1->via($inode2->name,$inode1->via($inode2->name)+1); + $inode2->via($inode1->name,$inode2->via($inode1->name)+1); + } + elsif(scalar(@inode1_imports) > 1 and scalar(@inode2_imports) == 1){ + $cedge->type('many2one'); + + $inode1->via($inode2->name,$inode1->via($inode2->name)+1); + $inode2->via($inode1->name,$inode2->via($inode1->name)+1); + } + elsif(scalar(@inode1_imports) == 1 and scalar(@inode2_imports) > 1){ + #handled above + } + elsif(scalar(@inode1_imports) > 1 and scalar(@inode2_imports) > 1){ + $cedge->type('many2many'); + + $inode1->via($inode2->name,$inode1->via($inode2->name)+1); + $inode2->via($inode1->name,$inode2->via($inode1->name)+1); + } +#warn Dumper($cedge); + + $inode1->push_compoundedges($cedge); + $inode2->push_compoundedges($cedge) unless $inode1 eq $inode2; +# if($inode1->name ne $inode2->name){ +# my $flipped_cedge = $cedge; +# foreach my $flipped_cedge_edge ($flipped_cedge->edges){ +# warn Dumper $flipped_cedge_edge; +# warn "\t". Dumper $flipped_cedge_edge->flip; +# } +# } + } + } + } + + my $graph = $self; #hack + + # + # create methods + # + # this code needs to move to Graph.pm + foreach my $node_from ($graph->node_values) { + + next unless $node_from->table->is_data or !$node_from->table->is_trivial_link; + + foreach my $cedge ( $node_from->compoundedges ) { + + my $hyperedge = SQL::Translator::Schema::Graph::HyperEdge->new(); + + my $node_to; + foreach my $edge ($cedge->edges) { + if ($edge->thisnode->name eq $node_from->name) { + $hyperedge->vianode($edge->thatnode); + + if ($edge->thatnode->name ne $cedge->via->name) { + $node_to ||= $graph->node($edge->thatnode->table->name); + } + + $hyperedge->push_thisnode($edge->thisnode); + $hyperedge->push_thisfield($edge->thisfield); + $hyperedge->push_thisviafield($edge->thatfield); + + } else { + if ($edge->thisnode->name ne $cedge->via->name) { + $node_to ||= $graph->node($edge->thisnode->table->name); + } + $hyperedge->push_thatnode($edge->thisnode); + $hyperedge->push_thatfield($edge->thisfield); + $hyperedge->push_thatviafield($edge->thatfield); } - } - - my $graph = $self; #hack - - # - # create methods - # - # this code needs to move to Graph.pm - for my $node_from ( $graph->node_values ) { - - next - unless $node_from->table->is_data - or !$node_from->table->is_trivial_link; - - for my $cedge ( $node_from->compoundedges ) { - - my $hyperedge = SQL::Translator::Schema::Graph::HyperEdge->new(); - - my $node_to; - for my $edge ( $cedge->edges ) { - if ( $edge->thisnode->name eq $node_from->name ) { - $hyperedge->vianode( $edge->thatnode ); - - if ( $edge->thatnode->name ne $cedge->via->name ) { - $node_to ||= - $graph->node( $edge->thatnode->table->name ); - } - - $hyperedge->push_thisnode( $edge->thisnode ); - $hyperedge->push_thisfield( $edge->thisfield ); - $hyperedge->push_thisviafield( $edge->thatfield ); - - } - else { - if ( $edge->thisnode->name ne $cedge->via->name ) { - $node_to ||= - $graph->node( $edge->thisnode->table->name ); - } - $hyperedge->push_thatnode( $edge->thisnode ); - $hyperedge->push_thatfield( $edge->thisfield ); - $hyperedge->push_thatviafield( $edge->thatfield ); - } - $self->debug( $edge->thisfield->name ); - $self->debug( $edge->thatfield->name ); - } - - if ( $hyperedge->count_thisnode == 1 - and $hyperedge->count_thatnode == 1 ) - { - $hyperedge->type('one2one'); - } - elsif ( $hyperedge->count_thisnode > 1 - and $hyperedge->count_thatnode == 1 ) - { - $hyperedge->type('many2one'); - } - elsif ( $hyperedge->count_thisnode == 1 - and $hyperedge->count_thatnode > 1 ) - { - $hyperedge->type('one2many'); - } - elsif ( $hyperedge->count_thisnode > 1 - and $hyperedge->count_thatnode > 1 ) - { - $hyperedge->type('many2many'); - } - - $self->debug($_) - for sort keys %::SQL::Translator::Schema::Graph::HyperEdge::; - - # node_to won't always be defined b/c of multiple edges to a - # single other node - if ( defined($node_to) ) { - $self->debug( $node_from->name ); - $self->debug( $node_to->name ); - - if ( scalar( $hyperedge->thisnode ) > 1 ) { - $self->debug( $hyperedge->type . " via " - . $hyperedge->vianode->name ); - my $i = 0; - for my $thisnode ( $hyperedge->thisnode ) { - $self->debug( $thisnode->name . ' ' - . $hyperedge->thisfield_index(0)->name . ' -> ' - . $hyperedge->thisviafield_index($i)->name . ' ' - . $hyperedge->vianode->name . ' ' - . $hyperedge->thatviafield_index(0)->name . ' <- ' - . $hyperedge->thatfield_index(0)->name . ' ' - . $hyperedge->thatnode_index(0)->name - . "\n" ); - $i++; - } - } - - #warn Dumper($hyperedge) if $hyperedge->type eq 'many2many'; - $node_from->push_hyperedges($hyperedge); - } + $self->debug($edge->thisfield->name); + $self->debug($edge->thatfield->name); + } + + if ($hyperedge->count_thisnode == 1 and $hyperedge->count_thatnode == 1) { + $hyperedge->type('one2one'); + } elsif ($hyperedge->count_thisnode > 1 and $hyperedge->count_thatnode == 1) { + $hyperedge->type('many2one'); + } elsif ($hyperedge->count_thisnode == 1 and $hyperedge->count_thatnode > 1) { + $hyperedge->type('one2many'); + } elsif ($hyperedge->count_thisnode > 1 and $hyperedge->count_thatnode > 1) { + $hyperedge->type('many2many'); + } + + $self->debug($_) foreach sort keys %::SQL::Translator::Schema::Graph::HyperEdge::; + + #node_to won't always be defined b/c of multiple edges to a single other node + if (defined($node_to)) { + $self->debug($node_from->name); + $self->debug($node_to->name); + + if (scalar($hyperedge->thisnode) > 1) { + $self->debug($hyperedge->type ." via ". $hyperedge->vianode->name); + my $i = 0; + foreach my $thisnode ( $hyperedge->thisnode ) { + $self->debug($thisnode->name .' '. + $hyperedge->thisfield_index(0)->name .' -> '. + $hyperedge->thisviafield_index($i)->name .' '. + $hyperedge->vianode->name .' '. + $hyperedge->thatviafield_index(0)->name .' <- '. + $hyperedge->thatfield_index(0)->name .' '. + $hyperedge->thatnode_index(0)->name ."\n" + ); + $i++; + } } + #warn Dumper($hyperedge) if $hyperedge->type eq 'many2many'; + $node_from->push_hyperedges($hyperedge); + } } + } } diff --git a/lib/SQL/Translator/Schema/Graph/CompoundEdge.pm b/lib/SQL/Translator/Schema/Graph/CompoundEdge.pm index ac0faa4..ab115b2 100644 --- a/lib/SQL/Translator/Schema/Graph/CompoundEdge.pm +++ b/lib/SQL/Translator/Schema/Graph/CompoundEdge.pm @@ -1,15 +1,13 @@ package SQL::Translator::Schema::Graph::CompoundEdge; -use vars qw[ $VERSION ]; -$VERSION = '1.60'; - use strict; use base qw(SQL::Translator::Schema::Graph::Edge); use Class::MakeMethods::Template::Hash ( - new => ['new'], - object => [ 'via' => { class => 'SQL::Translator::Schema::Graph::Node' }, ], - 'array_of_objects -class SQL::Translator::Schema::Graph::Edge' => - [qw( edges )], + new => ['new'], + object => [ + 'via' => {class => 'SQL::Translator::Schema::Graph::Node'}, + ], + 'array_of_objects -class SQL::Translator::Schema::Graph::Edge' => [ qw( edges ) ], ); 1; diff --git a/lib/SQL/Translator/Schema/Graph/Edge.pm b/lib/SQL/Translator/Schema/Graph/Edge.pm index 3357c38..cece2fa 100644 --- a/lib/SQL/Translator/Schema/Graph/Edge.pm +++ b/lib/SQL/Translator/Schema/Graph/Edge.pm @@ -2,32 +2,31 @@ package SQL::Translator::Schema::Graph::Edge; use strict; -use vars qw[ $VERSION ]; -$VERSION = '1.60'; - use Class::MakeMethods::Template::Hash ( - new => ['new'], - scalar => [qw( type )], - array => [qw( traversals )], - object => [ - 'thisfield' => { class => 'SQL::Translator::Schema::Field' }, #FIXME - 'thatfield' => { class => 'SQL::Translator::Schema::Field' }, #FIXME - 'thisnode' => { class => 'SQL::Translator::Schema::Graph::Node' }, - 'thatnode' => { class => 'SQL::Translator::Schema::Graph::Node' }, + new => ['new'], + scalar => [ qw( type ) ], + array => [ qw( traversals ) ], + object => [ + 'thisfield' => {class => 'SQL::Translator::Schema::Field'}, #FIXME + 'thatfield' => {class => 'SQL::Translator::Schema::Field'}, #FIXME + 'thisnode' => {class => 'SQL::Translator::Schema::Graph::Node'}, + 'thatnode' => {class => 'SQL::Translator::Schema::Graph::Node'}, - ], + ], ); sub flip { - my $self = shift; + my $self = shift; + +#warn "self thisfield: ".$self->thisfield->name; +#warn "self thatfield: ".$self->thatfield->name; - return SQL::Translator::Schema::Graph::Edge->new( - thisfield => $self->thatfield, - thatfield => $self->thisfield, - thisnode => $self->thatnode, - thatnode => $self->thisnode, - type => $self->type eq 'import' ? 'export' : 'import' - ); + return SQL::Translator::Schema::Graph::Edge->new( thisfield => $self->thatfield, + thatfield => $self->thisfield, + thisnode => $self->thatnode, + thatnode => $self->thisnode, + type => $self->type eq 'import' ? 'export' : 'import' + ); } 1; diff --git a/lib/SQL/Translator/Schema/Graph/HyperEdge.pm b/lib/SQL/Translator/Schema/Graph/HyperEdge.pm index a7f53d0..c5ebec1 100644 --- a/lib/SQL/Translator/Schema/Graph/HyperEdge.pm +++ b/lib/SQL/Translator/Schema/Graph/HyperEdge.pm @@ -3,16 +3,10 @@ package SQL::Translator::Schema::Graph::HyperEdge; use strict; use base qw(SQL::Translator::Schema::Graph::Edge); -use vars qw[ $VERSION ]; -$VERSION = '1.60'; - use Class::MakeMethods::Template::Hash ( - 'array_of_objects -class SQL::Translator::Schema::Field' => - [qw( thisviafield thatviafield thisfield thatfield)], #FIXME - 'array_of_objects -class SQL::Translator::Schema::Graph::Node' => - [qw( thisnode thatnode )], - 'object' => - [ 'vianode' => { class => 'SQL::Translator::Schema::Graph::Node' } ], + 'array_of_objects -class SQL::Translator::Schema::Field' => [ qw( thisviafield thatviafield thisfield thatfield) ], #FIXME + 'array_of_objects -class SQL::Translator::Schema::Graph::Node' => [ qw( thisnode thatnode ) ], + object => [ 'vianode' => {class => 'SQL::Translator::Schema::Graph::Node'} ], ); 1; diff --git a/lib/SQL/Translator/Schema/Graph/Node.pm b/lib/SQL/Translator/Schema/Graph/Node.pm index 8b39778..fc901b2 100644 --- a/lib/SQL/Translator/Schema/Graph/Node.pm +++ b/lib/SQL/Translator/Schema/Graph/Node.pm @@ -2,149 +2,125 @@ package SQL::Translator::Schema::Graph::Node; use strict; -use vars qw[ $VERSION ]; -$VERSION = '1.60'; - use Class::MakeMethods::Template::Hash ( - new => ['new'], - 'array_of_objects -class SQL::Translator::Schema::Graph::Edge' => - [qw( edges )], - 'array_of_objects -class SQL::Translator::Schema::Graph::CompoundEdge' => - [qw( compoundedges )], - 'array_of_objects -class SQL::Translator::Schema::Graph::HyperEdge' => - [qw( hyperedges )], - - #'hash' => [ qw( many via has edgecount data_fields) ], - #'hash' => [ qw( many via has data_fields) ], - scalar => [ - qw( base name order primary_key primary_key_accessor table is_trivial_link ) - ], - number => [qw( order )], + new => [ 'new' ], + 'array_of_objects -class SQL::Translator::Schema::Graph::Edge' => [ qw( edges ) ], + 'array_of_objects -class SQL::Translator::Schema::Graph::CompoundEdge' => [ qw( compoundedges ) ], + 'array_of_objects -class SQL::Translator::Schema::Graph::HyperEdge' => [ qw( hyperedges ) ], + #'hash' => [ qw( many via has edgecount data_fields) ], + #'hash' => [ qw( many via has data_fields) ], + scalar => [ qw( base name order primary_key primary_key_accessor table is_trivial_link ) ], + number => [ qw( order ) ], ); sub many { - my ($self) = shift; - - $self->{_many} ||= {}; - - if ( scalar(@_) == 1 ) { - my $k = shift; - return $self->{_many}{$k} || 0; - } - elsif (@_) { - my %arg = @_; + my($self) = shift; - foreach my $k ( keys %arg ) { + $self->{_many} ||= {}; - #warn $a,"\t",$arg{$k}; - $self->{_many}{$k} = $arg{$k}; - } + if(scalar(@_) == 1){ + my $k = shift; + return $self->{_many}{$k} || 0; + } elsif(@_) { + my %arg = @_; - return %arg; - } - else { - return $self->{_many}; + foreach my $k (keys %arg){ + #warn $a,"\t",$arg{$k}; + $self->{_many}{$k} = $arg{$k}; } + + return %arg; + } else { + return $self->{_many}; + } } sub via { - my ($self) = shift; + my($self) = shift; - $self->{_via} ||= {}; + $self->{_via} ||= {}; - if ( scalar(@_) == 1 ) { - my $k = shift; - return $self->{_via}{$k} || 0; - } - elsif (@_) { - my %arg = @_; + if(scalar(@_) == 1){ + my $k = shift; + return $self->{_via}{$k} || 0; + } elsif(@_) { + my %arg = @_; - foreach my $k ( keys %arg ) { - - #warn $a,"\t",$arg{$k}; - $self->{_via}{$k} = $arg{$k}; - } - - return %arg; - } - else { - return $self->{_via}; + foreach my $k (keys %arg){ + #warn $a,"\t",$arg{$k}; + $self->{_via}{$k} = $arg{$k}; } + + return %arg; + } else { + return $self->{_via}; + } } sub has { - my ($self) = shift; - - $self->{_has} ||= {}; - - if ( scalar(@_) == 1 ) { - my $k = shift; - return $self->{_has}{$k} || 0; - } - elsif (@_) { - my %arg = @_; + my($self) = shift; - foreach my $k ( keys %arg ) { + $self->{_has} ||= {}; - #warn $a,"\t",$arg{$k}; - $self->{_has}{$k} = $arg{$k}; - } + if(scalar(@_) == 1){ + my $k = shift; + return $self->{_has}{$k} || 0; + } elsif(@_) { + my %arg = @_; - return %arg; - } - else { - return $self->{_has}; + foreach my $k (keys %arg){ + #warn $a,"\t",$arg{$k}; + $self->{_has}{$k} = $arg{$k}; } + + return %arg; + } else { + return $self->{_has}; + } } sub edgecount { - my ($self) = shift; + my($self) = shift; - $self->{_edgecount} ||= {}; + $self->{_edgecount} ||= {}; - if ( scalar(@_) == 1 ) { - my $k = shift; - return $self->{_edgecount}{$k} || 0; - } - elsif (@_) { - my %arg = @_; + if(scalar(@_) == 1){ + my $k = shift; + return $self->{_edgecount}{$k} || 0; + } elsif(@_) { + my %arg = @_; - foreach my $k ( keys %arg ) { - - #warn $a,"\t",$arg{$k}; - $self->{_edgecount}{$k} = $arg{$k}; - } - - return %arg; - } - else { - return $self->{_edgecount}; + foreach my $k (keys %arg){ + #warn $a,"\t",$arg{$k}; + $self->{_edgecount}{$k} = $arg{$k}; } + + return %arg; + } else { + return $self->{_edgecount}; + } } sub data_fields { - my ($self) = shift; - - $self->{_data_fields} ||= {}; - - if ( scalar(@_) == 1 ) { - my $k = shift; - return $self->{_data_fields}{$k}; - } - elsif (@_) { - my %arg = @_; + my($self) = shift; - foreach my $k ( keys %arg ) { + $self->{_data_fields} ||= {}; - #warn $a,"\t",$arg{$k}; - $self->{_data_fields}{$k} = $arg{$k}; - } + if(scalar(@_) == 1){ + my $k = shift; + return $self->{_data_fields}{$k}; + } elsif(@_) { + my %arg = @_; - return %arg; - } - else { - return $self->{_data_fields}; + foreach my $k (keys %arg){ + #warn $a,"\t",$arg{$k}; + $self->{_data_fields}{$k} = $arg{$k}; } + + return %arg; + } else { + return $self->{_data_fields}; + } } 1; diff --git a/lib/SQL/Translator/Schema/Graph/Port.pm b/lib/SQL/Translator/Schema/Graph/Port.pm index 8ec7b43..f0aeab4 100644 --- a/lib/SQL/Translator/Schema/Graph/Port.pm +++ b/lib/SQL/Translator/Schema/Graph/Port.pm @@ -2,7 +2,4 @@ package SQL::Translator::Schema::Graph::Port; use strict; -use vars qw[ $VERSION ]; -$VERSION = '1.60'; - 1; diff --git a/lib/SQL/Translator/Schema/Index.pm b/lib/SQL/Translator/Schema/Index.pm index 5f067ca..4a71063 100644 --- a/lib/SQL/Translator/Schema/Index.pm +++ b/lib/SQL/Translator/Schema/Index.pm @@ -46,20 +46,19 @@ Primary and unique keys are table constraints, not indices. use strict; use SQL::Translator::Schema::Constants; use SQL::Translator::Utils 'parse_list_arg'; -use Readonly; use base 'SQL::Translator::Schema::Object'; use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT); -$VERSION = '1.60'; +$VERSION = '1.59'; -Readonly my %VALID_INDEX_TYPE => ( - UNIQUE => 1, - NORMAL => 1, - FULLTEXT => 1, # MySQL only (?) - FULL_TEXT => 1, # MySQL only (?) - SPATIAL => 1, # MySQL only (?) +my %VALID_INDEX_TYPE = ( + UNIQUE => 1, + NORMAL => 1, + FULLTEXT => 1, # MySQL only (?) + FULL_TEXT => 1, # MySQL only (?) + SPATIAL => 1, # MySQL only (?) ); # ---------------------------------------------------------------------- diff --git a/lib/SQL/Translator/Schema/Object.pm b/lib/SQL/Translator/Schema/Object.pm index 41ce4a7..c2aa333 100644 --- a/lib/SQL/Translator/Schema/Object.pm +++ b/lib/SQL/Translator/Schema/Object.pm @@ -41,7 +41,8 @@ use Class::MakeMethods::Utility::Ref qw( ref_compare ); use vars qw[ $VERSION ]; -$VERSION = '1.60'; +$VERSION = '1.59'; + =head1 Construction @@ -201,11 +202,18 @@ Determines if this object is the same as another. # ---------------------------------------------------------------------- sub _compare_objects { - my $self = shift; - my $obj1 = shift; - my $obj2 = shift; + my $self = shift; + my $obj1 = shift; + my $obj2 = shift; my $result = (ref_compare($obj1, $obj2) == 0); - +# if ( !$result ) { +# use Carp qw(cluck); +# cluck("How did I get here?"); +# use Data::Dumper; +# $Data::Dumper::Maxdepth = 1; +# print "obj1: ", Dumper($obj1), "\n"; +# print "obj2: ", Dumper($obj2), "\n"; +# } return $result; } @@ -215,6 +223,12 @@ sub _compare_objects { =pod +=head1 SEE ALSO + +=head1 TODO + +=head1 BUGS + =head1 AUTHOR Ken Youens-Clark Ekclark@cpan.orgE, diff --git a/lib/SQL/Translator/Schema/Procedure.pm b/lib/SQL/Translator/Schema/Procedure.pm index 507393d..c7d549e 100644 --- a/lib/SQL/Translator/Schema/Procedure.pm +++ b/lib/SQL/Translator/Schema/Procedure.pm @@ -52,7 +52,7 @@ use base 'SQL::Translator::Schema::Object'; use vars qw($VERSION); -$VERSION = '1.60'; +$VERSION = '1.59'; # ---------------------------------------------------------------------- diff --git a/lib/SQL/Translator/Schema/Table.pm b/lib/SQL/Translator/Schema/Table.pm index 9cbdd73..3e02c43 100644 --- a/lib/SQL/Translator/Schema/Table.pm +++ b/lib/SQL/Translator/Schema/Table.pm @@ -49,7 +49,7 @@ use base 'SQL::Translator::Schema::Object'; use vars qw( $VERSION ); -$VERSION = '1.60'; +$VERSION = '1.59'; # 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 diff --git a/lib/SQL/Translator/Schema/Trigger.pm b/lib/SQL/Translator/Schema/Trigger.pm index 83ff30f..dd63b4d 100644 --- a/lib/SQL/Translator/Schema/Trigger.pm +++ b/lib/SQL/Translator/Schema/Trigger.pm @@ -54,7 +54,7 @@ use Carp; use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT); -$VERSION = '1.60'; +$VERSION = '1.59'; # ---------------------------------------------------------------------- diff --git a/lib/SQL/Translator/Schema/View.pm b/lib/SQL/Translator/Schema/View.pm index beb83df..637ee3d 100644 --- a/lib/SQL/Translator/Schema/View.pm +++ b/lib/SQL/Translator/Schema/View.pm @@ -48,7 +48,7 @@ use base 'SQL::Translator::Schema::Object'; use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT); -$VERSION = '1.60'; +$VERSION = '1.59'; # ---------------------------------------------------------------------- diff --git a/lib/SQL/Translator/Utils.pm b/lib/SQL/Translator/Utils.pm index 9860617..a2862f6 100644 --- a/lib/SQL/Translator/Utils.pm +++ b/lib/SQL/Translator/Utils.pm @@ -25,12 +25,12 @@ use Digest::SHA1 qw( sha1_hex ); use Exporter; use Readonly; -$VERSION = '1.60'; +$VERSION = '1.59'; $DEFAULT_COMMENT = '-- '; @EXPORT_OK = qw( debug normalize_name header_comment parse_list_arg truncate_id_uniquely $DEFAULT_COMMENT parse_mysql_version ); -Readonly my $COLLISION_TAG_LENGTH => 8; +use constant COLLISION_TAG_LENGTH => 8; # ---------------------------------------------------------------------- # debug(@msg) @@ -158,12 +158,12 @@ sub truncate_id_uniquely { unless defined $desired_name && length $desired_name > $max_symbol_length; my $truncated_name = substr $desired_name, 0, - $max_symbol_length - $COLLISION_TAG_LENGTH - 1; + $max_symbol_length - COLLISION_TAG_LENGTH - 1; # Hex isn't the most space-efficient, but it skirts around allowed # charset issues my $digest = sha1_hex($desired_name); - my $collision_tag = substr $digest, 0, $COLLISION_TAG_LENGTH; + my $collision_tag = substr $digest, 0, COLLISION_TAG_LENGTH; return $truncated_name . '_' @@ -366,6 +366,6 @@ version specifications: =head1 AUTHORS Darren Chamberlain Edarren@cpan.orgE, -Ken Youens-Clark Ekclark@cpan.orgE. +Ken Y. Clark Ekclark@cpan.orgE. =cut diff --git a/lib/Test/SQL/Translator.pm b/lib/Test/SQL/Translator.pm index 79f412b..2cbf82a 100644 --- a/lib/Test/SQL/Translator.pm +++ b/lib/Test/SQL/Translator.pm @@ -33,7 +33,7 @@ use SQL::Translator::Schema::Constants; use base qw(Exporter); use vars qw($VERSION @EXPORT @EXPORT_OK); -$VERSION = '1.60'; +$VERSION = '1.59'; @EXPORT = qw( schema_ok table_ok @@ -634,8 +634,8 @@ schema file and test yaml file to compare it against. Mark D. Addison Emark.addison@itn.co.ukE, Darren Chamberlain . -Thanks to Ken YouensClark for the original table and field test code taken -from his mysql test. +Thanks to Ken Y. Clark for the original table and field test code taken from +his mysql test. =head1 SEE ALSO diff --git a/script/sqlt b/script/sqlt index 8d063a1..091c250 100755 --- a/script/sqlt +++ b/script/sqlt @@ -153,7 +153,7 @@ use Pod::Usage; use SQL::Translator; use vars qw( $VERSION ); -$VERSION = '1.60'; +$VERSION = '1.59'; my $from; # the original database my $to; # the destination database diff --git a/script/sqlt-diagram b/script/sqlt-diagram index c19e2b3..7af13f8 100755 --- a/script/sqlt-diagram +++ b/script/sqlt-diagram @@ -75,7 +75,7 @@ use Pod::Usage; use SQL::Translator; use vars '$VERSION'; -$VERSION = '1.60'; +$VERSION = '1.59'; # # Get arguments. diff --git a/script/sqlt-diff b/script/sqlt-diff index 03a9622..3a5a6a5 100755 --- a/script/sqlt-diff +++ b/script/sqlt-diff @@ -111,7 +111,7 @@ use SQL::Translator::Diff; use SQL::Translator::Schema::Constants; use vars qw( $VERSION ); -$VERSION = '1.60'; +$VERSION = '1.59'; my ( @input, $list, $help, $debug, $trace, $caseopt, $ignore_index_names, $ignore_constraint_names, $output_db, $mysql_parser_version, diff --git a/script/sqlt-diff-old b/script/sqlt-diff-old index 0773831..96a3c92 100755 --- a/script/sqlt-diff-old +++ b/script/sqlt-diff-old @@ -96,7 +96,7 @@ use SQL::Translator; use SQL::Translator::Schema::Constants; use vars qw( $VERSION ); -$VERSION = '1.60'; +$VERSION = '1.59'; my ( @input, $list, $help, $debug ); for my $arg ( @ARGV ) { diff --git a/script/sqlt-dumper b/script/sqlt-dumper index b8b52c1..0f80959 100755 --- a/script/sqlt-dumper +++ b/script/sqlt-dumper @@ -62,7 +62,7 @@ use SQL::Translator; use File::Basename qw(basename); use vars '$VERSION'; -$VERSION = '1.60'; +$VERSION = '1.59'; my ( $help, $db, $skip, $skiplike, $db_user, $db_pass, $dsn ); GetOptions( diff --git a/script/sqlt-graph b/script/sqlt-graph index 2d13ce7..b92129c 100755 --- a/script/sqlt-graph +++ b/script/sqlt-graph @@ -107,7 +107,7 @@ use Pod::Usage; use SQL::Translator; use vars '$VERSION'; -$VERSION = '1.60'; +$VERSION = '1.59'; # # Get arguments. diff --git a/script/sqlt.cgi b/script/sqlt.cgi index 4d114cb..658e5ab 100755 --- a/script/sqlt.cgi +++ b/script/sqlt.cgi @@ -38,7 +38,7 @@ use CGI; use SQL::Translator; use vars '$VERSION'; -$VERSION = '1.60'; +$VERSION = '1.59'; my $q = CGI->new; diff --git a/t/36-filters.t b/t/36-filters.t index 15da914..c1ad7ca 100644 --- a/t/36-filters.t +++ b/t/36-filters.t @@ -42,7 +42,10 @@ use Test::SQL::Translator qw(maybe_plan); use Data::Dumper; BEGIN { - maybe_plan(16, 'Template', 'Test::Differences') + maybe_plan(16, 'Template', 'Test::Differences', + 'SQL::Translator::Parser::YAML', + 'SQL::Translator::Producer::YAML') + } use Test::Differences; use SQL::Translator;