From: Ken Youens-Clark Date: Thu, 13 Aug 2009 19:04:24 +0000 (+0000) Subject: Upped version numbers, cleaned up code, fixed my name. X-Git-Tag: v0.11008~101 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ba506e52c480afe33dfec6b38a12759fad1e7fa2;p=dbsrgits%2FSQL-Translator.git Upped version numbers, cleaned up code, fixed my name. --- diff --git a/Changes b/Changes index 66faff2..5b7c789 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,34 @@ # ---------------------------------------------------------- -# x.xxxxx xxxx-xx-xx +# 0.10 2009-08-13 # ---------------------------------------------------------- +* Resolved the following RT bugs (thanks to everyone for reporting!): +25791 does not recognize PostgreSQL ON_ERROR_STOP +29265 sqlt-diagram: --natural-join needs Graph::Directed +37814 SQLite translator failing to parse schema +42548 Producer::PostgreSQL incorrectly inserts the size in + 'time(stamp)? with(out) time zone' fields +43173 SQL::Translator::Parser without versionnumber - will install + old 0.09002 +46805 (No subject) +47026 META.yml is not packaged due to MANIFEST.SKIP (easyfix) +32130 Move from XML::XPath to XML::LibXML::XPathContext +22261 MySQL parse +13915 missing optional prerequisite cause make test to fail +8847 Diagram.pm: BINMODE missing in printing of graphic file. +21065 GraphViz producer fails on tables named 'node' +35448 Producer::PostgreSQL types without size +22026 sqlt-diagram uses -f arg twice +47897 [PATCH] Fix uninitialized value within @_ in (uc|lc) +47668 Mysql Parser doesn't recognize key types +46448 sqlt-graph errors out on MySQL DDL with btree keys +47176 Add Foreign Key support to Parser::DBI::PostgreSQL.pm +48025 MySQL Producer: Case inconsistency between elements in + @no_length_attr and $data_type +48569 sqlt-diagram fails to load SQLite schema +48596 SQL::Translator::Diff::schema_diff should produce a list in + list context +44907 SQL::Translator::Producer::PostgreSQL produce() in list context + should return a list of statements # ---------------------------------------------------------- # 0.09007 2009-06-25 @@ -24,6 +52,10 @@ # ---------------------------------------------------------- * Add parser support for MySQL default values with a single quote * Properly quote absolute table names in the MySQL producer +<<<<<<< .mine +* Added CREATE VIEW subrules for mysql parser (wreis) +* Many fixes to code and tests for trigger's "database_events" +======= * Added semi-colon for (DROP|CREATE) TYPE statements in the Pg producer (wreis) * Added CREATE VIEW subrules for mysql parser (wreis) * ALTER TABLE/ALTER COLUMN/DROP DEFAULT support in Pg producer (mo) @@ -51,6 +83,7 @@ - Support parsing of all DROP clauses - Support parsing of field-level comments - When producing do not append table names to constraint/index names +>>>>>>> .r1584 # ---------------------------------------------------------- # 0.09004 2009-02-13 diff --git a/README b/README index 7076ba5..edc834d 100644 --- a/README +++ b/README @@ -18,20 +18,26 @@ 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.06, parsers exist for the following: +As of version 0.10, 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 @@ -41,20 +47,27 @@ As of version 0.06, 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 @@ -68,12 +81,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-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 +* 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 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 @@ -95,11 +108,9 @@ manipulate the SQL::Translator::Schema objects. INSTALLATION - $ perl Build.PL - $ ./Build - $ ./Build test - $ su - # ./Build install + $ perl Makefile.PL + $ make && make test + $ sudo make install MANUAL diff --git a/TODO b/TODO deleted file mode 100644 index 1bd0713..0000000 --- a/TODO +++ /dev/null @@ -1,46 +0,0 @@ -* Parse FOREIGN KEY / REFERENCES with SQLite as the latest version - supports them. - -* Add Parser/Producer for ActiveRecord::Migration - [http://api.rubyonrails.com/classes/ActiveRecord/Migration.html]. - -* The regular Sybase parser is only just functional. If you are - interested in using Sybase, I would suggest serializing the schema - (via YAML or Storable) using the DBI-Sybase parser and then - manipulating that as you see fit. - -* Add more DBI parsers! These have the potential to be very - thorough and far faster than parsing text files with - Parse::RecDescent. - -* At least allow more pass-through of INSERT, DELETE, and UPDATE - statements - -* Add INSERT statements for xSV, Excel parsers to automatically - create INSERTs for each row of data in the source file - -* Somehow merge ClassDBI producer with CGI::FormBuilder or Template - Toolkit and some sort of automated CGI builder to create - view/create/edit/delete forms for objects based on schema defs - -* Embetter the Diagram producer to use some real graphing algorithms - to distribute the tables so that the lines don't overlap so badly - -* Integrate more with some standard XML schema representations, - maybe like Torque DB (http://db.apache.org/torque/). We've - started messing around with XMI, too, but it isn't quite usable. - -* Possibly write a basic ANSI-92 SQL parser which could be extended - when writing other new parsers. - -* Make as many "required" modules as possible optional. This will - require support in the Makefile, the tests, and the modules - themselves (they'll need to die gracefully if prerequisites are - not installed). - -* Support for precompiled Parse::RecDescent grammars. -- This is easy and I've done it locally with the DB2 parser - Jess - -* More code generation producers, such as Java, PHP, and Python. - -* Integrate Module::Pluggable as a replacement for the _list method. diff --git a/lib/SQL/Translator.pm b/lib/SQL/Translator.pm index 09472df..f45a0e2 100644 --- a/lib/SQL/Translator.pm +++ b/lib/SQL/Translator.pm @@ -24,16 +24,15 @@ use base 'Class::Base'; require 5.005; -$VERSION = '0.10'; -$DEBUG = 0 unless defined $DEBUG; -$ERROR = ""; +$VERSION = '0.10'; +$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 91b8c1a..ff61b8d 100644 --- a/lib/SQL/Translator/Diff.pm +++ b/lib/SQL/Translator/Diff.pm @@ -1,15 +1,17 @@ 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 21ebec8..405cfe8 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.59'; +$VERSION = '1.60'; sub filter { my $schema = shift; my %args = { +shift }; # Tables - foreach ( $schema->get_tables ) { + for ( $schema->get_tables ) { my %extra = $_->extra; $extra{label} ||= ucfirst($_->name); @@ -66,7 +66,7 @@ sub filter { } # Fields - foreach ( map { $_->get_fields } $schema->get_tables ) { + for ( map { $_->get_fields } $schema->get_tables ) { my %extra = $_->extra; $extra{label} ||= ucfirst($_->name); @@ -80,17 +80,15 @@ __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 BUGS - -=head1 TODO - =head1 AUTHOR +Unknown. + =cut diff --git a/lib/SQL/Translator/Filter/Globals.pm b/lib/SQL/Translator/Filter/Globals.pm index e1ead93..a3d3c4a 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.59'; +$VERSION = '1.60'; sub filter { my $schema = shift; @@ -147,21 +147,22 @@ __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 @@ -169,16 +170,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 constraints if a constraint already exists on a table +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. + =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 afa0f1f..cafa72c 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.59'; +$VERSION = '1.60'; sub filter { my $schema = shift; @@ -99,15 +99,17 @@ 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__ @@ -117,8 +119,6 @@ __END__ L, L -=head1 BUGS - =head1 TODO =over 4 @@ -165,4 +165,6 @@ 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 4774437..4b9b1df 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 Y. Clark Ekclark@cpan.orgE. +Ken Youens-Clark Ekclark@cpan.orgE. diff --git a/lib/SQL/Translator/Parser/Access.pm b/lib/SQL/Translator/Parser/Access.pm index 696ebcb..5e812e7 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.59'; +$VERSION = '1.60'; $DEBUG = 0 unless defined $DEBUG; use Data::Dumper; @@ -472,7 +472,7 @@ sub parse { =head1 AUTHOR -Ken Y. Clark Ekclark@cpan.orgE. +Ken Youens-Clark Ekclark@cpan.orgE. =head1 SEE ALSO diff --git a/lib/SQL/Translator/Parser/DB2.pm b/lib/SQL/Translator/Parser/DB2.pm index 55032dc..fc2b18a 100644 --- a/lib/SQL/Translator/Parser/DB2.pm +++ b/lib/SQL/Translator/Parser/DB2.pm @@ -1,9 +1,13 @@ 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 4452df2..1c6017f 100644 --- a/lib/SQL/Translator/Parser/DB2/Grammar.pm +++ b/lib/SQL/Translator/Parser/DB2/Grammar.pm @@ -1,4 +1,8 @@ package SQL::Translator::Parser::DB2::Grammar; + +use vars qw[ $VERSION ]; +$VERSION = '1.60'; + use Parse::RecDescent; { my $ERRORS; @@ -47952,4 +47956,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 1d0219d..139f84c 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.59'; +$VERSION = '1.60'; use constant DRIVERS => { mysql => 'MySQL', @@ -191,7 +191,7 @@ sub parse { =head1 AUTHOR -Ken Y. Clark Ekclark@cpan.orgE. +Ken Youens-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 9dcf35e..ab8d41f 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.59'; +$VERSION = '1.60'; $DEBUG = 0 unless defined $DEBUG; # ------------------------------------------------------------------- diff --git a/lib/SQL/Translator/Parser/DBI/MySQL.pm b/lib/SQL/Translator/Parser/DBI/MySQL.pm index dcabb1b..d1f8868 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.59'; +$VERSION = '1.60'; $DEBUG = 0 unless defined $DEBUG; # ------------------------------------------------------------------- diff --git a/lib/SQL/Translator/Parser/DBI/Oracle.pm b/lib/SQL/Translator/Parser/DBI/Oracle.pm index d111387..ca4cd75 100644 --- a/lib/SQL/Translator/Parser/DBI/Oracle.pm +++ b/lib/SQL/Translator/Parser/DBI/Oracle.pm @@ -40,7 +40,8 @@ use SQL::Translator::Schema::Table; use SQL::Translator::Schema::Field; use SQL::Translator::Schema::Constraint; -our $VERSION = '1.59'; +use vars qw[ $VERSION ]; +$VERSION = '1.60'; # ------------------------------------------------------------------- sub parse { diff --git a/lib/SQL/Translator/Parser/DBI/PostgreSQL.pm b/lib/SQL/Translator/Parser/DBI/PostgreSQL.pm index 9606651..a34263e 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.59'; +$VERSION = '1.60'; $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 267e6f8..37dd7fd 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.59'; +$VERSION = '1.60'; $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 a95630e..c319f05 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.59'; +$VERSION = '1.60'; $DEBUG = 0 unless defined $DEBUG; # ------------------------------------------------------------------- @@ -74,7 +74,7 @@ sub parse { =head1 AUTHOR -Ken Y. Clark Ekclark@cpan.orgE. +Ken Youens-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 d800fe0..18ab6fe 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.59'; +$VERSION = '1.60'; $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 0d98f6b..2eed0dc 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.59'; +$VERSION = '1.60'; use Spreadsheet::ParseExcel; use Exporter; @@ -212,7 +212,7 @@ sub ET_to_ST { Mike Mellilo , darren chamberlain Edlc@users.sourceforge.netE, -Ken Y. Clark Ekclark@cpan.orgE. +Ken Youens-Clark Ekclark@cpan.orgE. =head1 SEE ALSO diff --git a/lib/SQL/Translator/Parser/MySQL.pm b/lib/SQL/Translator/Parser/MySQL.pm index 38b062b..5383f74 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 Youens-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 98c7fe1..21d443e 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.59'; +$VERSION = '1.60'; $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 c4c2fe1..9b72e76 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.59'; +$VERSION = '1.60'; $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 d50cf88..f3e9392 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.59'; +$VERSION = '1.60'; use Storable; use Exporter; diff --git a/lib/SQL/Translator/Parser/Sybase.pm b/lib/SQL/Translator/Parser/Sybase.pm index 9b7814c..4ea0850 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.59'; +$VERSION = '1.60'; $DEBUG = 0 unless defined $DEBUG; use Data::Dumper; @@ -416,7 +416,7 @@ sub parse { =head1 AUTHOR -Ken Y. Clark Ekclark@cpan.orgE. +Ken Youens-Clark Ekclark@cpan.orgE. =head1 SEE ALSO diff --git a/lib/SQL/Translator/Parser/XML.pm b/lib/SQL/Translator/Parser/XML.pm index 2cec293..bb8f176 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 Y. Clark Ekclark@cpan.orgE. +Ken Youens-Clark Ekclark@cpan.orgE. =cut @@ -42,7 +42,7 @@ Ken Y. Clark Ekclark@cpan.orgE. use strict; use vars qw[ $VERSION $DEBUG ]; -$VERSION = '1.59'; +$VERSION = '1.60'; $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 390a4ca..3f681ae 100644 --- a/lib/SQL/Translator/Parser/XML/SQLFairy.pm +++ b/lib/SQL/Translator/Parser/XML/SQLFairy.pm @@ -1,6 +1,7 @@ package SQL::Translator::Parser::XML::SQLFairy; # ------------------------------------------------------------------- +# Copyright (C) 2002-2009 The SQLFairy Authors, # Copyright (C) 2003 Mark Addison , # Copyright (C) 2009 Jonathan Yu # @@ -99,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 = '1.59'; +$VERSION = '1.60'; $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 4170d1f..1cc9fa1 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.59'; +$VERSION = '1.60'; 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 Y. Clark Ekclark@cpan.orgE. +Ken Youens-Clark Ekclark@cpan.orgE. diff --git a/lib/SQL/Translator/Parser/xSV.pm b/lib/SQL/Translator/Parser/xSV.pm index 3ab2f12..0006b46 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.59'; +$VERSION = '1.60'; use Exporter; use Text::ParseWords qw(quotewords); @@ -189,7 +189,7 @@ sub parse { =head1 AUTHORS Darren Chamberlain Edarren@cpan.orgE, -Ken Y. Clark Ekclark@cpan.orgE. +Ken Youens-Clark Ekclark@cpan.orgE. =head1 SEE ALSO diff --git a/lib/SQL/Translator/Producer.pm b/lib/SQL/Translator/Producer.pm index b2ba10e..86e5c55 100644 --- a/lib/SQL/Translator/Producer.pm +++ b/lib/SQL/Translator/Producer.pm @@ -1,7 +1,7 @@ package SQL::Translator::Producer; # ------------------------------------------------------------------- -# Copyright (C) 2002-4 SQLFairy Authors +# Copyright (C) 2002-2009 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.59'; +$VERSION = '1.60'; sub produce { "" } @@ -105,7 +105,7 @@ by the parser. It is expected to return a string. =head1 AUTHORS Darren Chamberlain Edarren@cpan.orgE, -Ken Y. Clark Ekclark@cpan.orgE. +Ken Youens-Clark Ekclark@cpan.orgE. =head1 SEE ALSO diff --git a/lib/SQL/Translator/Producer/ClassDBI.pm b/lib/SQL/Translator/Producer/ClassDBI.pm index e6ecd40..61e731d 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.59'; +$VERSION = '1.60'; $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 a343674..e71e9e7 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.59'; +$VERSION = '1.60'; $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 7c02d33..8230cfe 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.59'; +$VERSION = '1.60'; $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 93b67c8..20085bb 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.59'; +$VERSION = '1.60'; $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 b24b78b..bba9974 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-2006 SQLFairy Authors +# Copyright (C) 2002-2009 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.59'; +$VERSION = '1.60'; sub produce { my $t = shift; diff --git a/lib/SQL/Translator/Producer/GraphViz.pm b/lib/SQL/Translator/Producer/GraphViz.pm index a360e4c..518872d 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.59'; +$VERSION = '1.60'; $DEBUG = 0 unless defined $DEBUG; sub produce { @@ -631,12 +631,11 @@ 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 6659fb3..79e70a8 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.59'; +$VERSION = '1.60'; $NAME = __PACKAGE__; $NOWRAP = 0 unless defined $NOWRAP; diff --git a/lib/SQL/Translator/Producer/Latex.pm b/lib/SQL/Translator/Producer/Latex.pm index c2bbf79..5bb031e 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-6 SQLFairy Authors +# Copyright (C) 2002-2009 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.59'; +$VERSION = '1.60'; $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 a7ebb05..924a7f1 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.59'; +$VERSION = '1.60'; $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 2ae0f3f..00a9e2e 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.59'; +$VERSION = '1.60'; $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 e7a1e75..f1b7b70 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.59'; +$VERSION = '1.60'; 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 ae37a83..aa90309 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.59'; +$VERSION = '1.60'; $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 11cee5f..8ac2ed9 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.59'; +$VERSION = '1.60'; $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 f85b360..d03112c 100644 --- a/lib/SQL/Translator/Producer/SQLite.pm +++ b/lib/SQL/Translator/Producer/SQLite.pm @@ -40,14 +40,15 @@ 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.59'; -$DEBUG = 0 unless defined $DEBUG; -$WARN = 0 unless defined $WARN; +$VERSION = '1.60'; +$DEBUG = 0 if !defined $DEBUG; +$WARN = 0 if !defined $WARN; -our $max_id_length = 30; +Readonly my $MAX_ID_LENGTH => 30; my %global_names; sub produce { @@ -106,8 +107,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; @@ -525,7 +526,7 @@ SQL::Translator, http://www.sqlite.org/. =head1 AUTHOR -Ken Youens-Clark C<< >>. +Ken Youens-Clark Ekclark@cpan.orgE. Diff code added by Ash Berlin C<< >>. diff --git a/lib/SQL/Translator/Producer/Storable.pm b/lib/SQL/Translator/Producer/Storable.pm index 3c918c0..6cf84be 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.59'; +$VERSION = '1.60'; use Storable; use Exporter; diff --git a/lib/SQL/Translator/Producer/Sybase.pm b/lib/SQL/Translator/Producer/Sybase.pm index 5755cfc..1ba6970 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.59'; +$VERSION = '1.60'; $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 7533820..ff87737 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.59'; +$VERSION = '1.60'; use Template; use Data::Dumper; diff --git a/lib/SQL/Translator/Producer/TT/Table.pm b/lib/SQL/Translator/Producer/TT/Table.pm index 35f9d65..e84b563 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.59'; +$VERSION = '1.60'; $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 839e22e..307e3ad 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.59'; +$VERSION = '1.60'; $DEBUG = 0 unless defined $DEBUG; use Template; diff --git a/lib/SQL/Translator/Producer/XML.pm b/lib/SQL/Translator/Producer/XML.pm index e306a2c..8312918 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.59'; +$VERSION = '1.60'; $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 6e58924..bd6afe4 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.59'; +$VERSION = '1.60'; use Exporter; use base qw(Exporter); diff --git a/lib/SQL/Translator/Producer/YAML.pm b/lib/SQL/Translator/Producer/YAML.pm index 68ecd8f..31b2420 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.59'; +$VERSION = '1.60'; use YAML qw(Dump); diff --git a/lib/SQL/Translator/Schema.pm b/lib/SQL/Translator/Schema.pm index 6268f21..c53789f 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.59'; +$VERSION = '1.60'; __PACKAGE__->_attributes(qw/name database translator/); diff --git a/lib/SQL/Translator/Schema/Constants.pm b/lib/SQL/Translator/Schema/Constants.pm index a1aab04..e03027f 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.59'; +$VERSION = '1.60'; @EXPORT = qw[ CHECK_C diff --git a/lib/SQL/Translator/Schema/Constraint.pm b/lib/SQL/Translator/Schema/Constraint.pm index 84f1d8c..4a77686 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.59'; +$VERSION = '1.60'; my %VALID_CONSTRAINT_TYPE = ( PRIMARY_KEY, 1, diff --git a/lib/SQL/Translator/Schema/Field.pm b/lib/SQL/Translator/Schema/Field.pm index 3249d95..bade685 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.59'; +$VERSION = '1.60'; # 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 897e535..ca508a7 100644 --- a/lib/SQL/Translator/Schema/Graph.pm +++ b/lib/SQL/Translator/Schema/Graph.pm @@ -4,253 +4,305 @@ use strict; use base 'Class::Base'; -use Data::Dumper; -local $Data::Dumper::Maxdepth = 3; +use vars qw[ $VERSION ]; +$VERSION = '1.60'; +use Data::Dumper; 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; -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'; +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 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 - # - 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 $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; + } } - $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++; - } + } + + 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); + } } - #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 ab115b2..ac0faa4 100644 --- a/lib/SQL/Translator/Schema/Graph/CompoundEdge.pm +++ b/lib/SQL/Translator/Schema/Graph/CompoundEdge.pm @@ -1,13 +1,15 @@ 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 cece2fa..3357c38 100644 --- a/lib/SQL/Translator/Schema/Graph/Edge.pm +++ b/lib/SQL/Translator/Schema/Graph/Edge.pm @@ -2,31 +2,32 @@ 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; - -#warn "self thisfield: ".$self->thisfield->name; -#warn "self thatfield: ".$self->thatfield->name; + my $self = shift; - 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 c5ebec1..a7f53d0 100644 --- a/lib/SQL/Translator/Schema/Graph/HyperEdge.pm +++ b/lib/SQL/Translator/Schema/Graph/HyperEdge.pm @@ -3,10 +3,16 @@ 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 fc901b2..8b39778 100644 --- a/lib/SQL/Translator/Schema/Graph/Node.pm +++ b/lib/SQL/Translator/Schema/Graph/Node.pm @@ -2,125 +2,149 @@ 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} ||= {}; + my ($self) = shift; - if(scalar(@_) == 1){ - my $k = shift; - return $self->{_many}{$k} || 0; - } elsif(@_) { - my %arg = @_; + $self->{_many} ||= {}; - foreach my $k (keys %arg){ - #warn $a,"\t",$arg{$k}; - $self->{_many}{$k} = $arg{$k}; + if ( scalar(@_) == 1 ) { + my $k = shift; + return $self->{_many}{$k} || 0; } + elsif (@_) { + my %arg = @_; + + foreach my $k ( keys %arg ) { + + #warn $a,"\t",$arg{$k}; + $self->{_many}{$k} = $arg{$k}; + } - return %arg; - } else { - return $self->{_many}; - } + return %arg; + } + else { + return $self->{_many}; + } } sub via { - my($self) = shift; - - $self->{_via} ||= {}; + my ($self) = shift; - if(scalar(@_) == 1){ - my $k = shift; - return $self->{_via}{$k} || 0; - } elsif(@_) { - my %arg = @_; + $self->{_via} ||= {}; - foreach my $k (keys %arg){ - #warn $a,"\t",$arg{$k}; - $self->{_via}{$k} = $arg{$k}; + if ( scalar(@_) == 1 ) { + my $k = shift; + return $self->{_via}{$k} || 0; } + elsif (@_) { + my %arg = @_; - 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} ||= {}; + my ($self) = shift; - if(scalar(@_) == 1){ - my $k = shift; - return $self->{_has}{$k} || 0; - } elsif(@_) { - my %arg = @_; + $self->{_has} ||= {}; - foreach my $k (keys %arg){ - #warn $a,"\t",$arg{$k}; - $self->{_has}{$k} = $arg{$k}; + if ( scalar(@_) == 1 ) { + my $k = shift; + return $self->{_has}{$k} || 0; } + elsif (@_) { + my %arg = @_; + + foreach my $k ( keys %arg ) { - return %arg; - } else { - return $self->{_has}; - } + #warn $a,"\t",$arg{$k}; + $self->{_has}{$k} = $arg{$k}; + } + + return %arg; + } + else { + return $self->{_has}; + } } sub edgecount { - my($self) = shift; - - $self->{_edgecount} ||= {}; + my ($self) = shift; - if(scalar(@_) == 1){ - my $k = shift; - return $self->{_edgecount}{$k} || 0; - } elsif(@_) { - my %arg = @_; + $self->{_edgecount} ||= {}; - foreach my $k (keys %arg){ - #warn $a,"\t",$arg{$k}; - $self->{_edgecount}{$k} = $arg{$k}; + if ( scalar(@_) == 1 ) { + my $k = shift; + return $self->{_edgecount}{$k} || 0; } + elsif (@_) { + my %arg = @_; - 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} ||= {}; + my ($self) = shift; - if(scalar(@_) == 1){ - my $k = shift; - return $self->{_data_fields}{$k}; - } elsif(@_) { - my %arg = @_; + $self->{_data_fields} ||= {}; - foreach my $k (keys %arg){ - #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 = @_; + + foreach my $k ( keys %arg ) { - return %arg; - } else { - return $self->{_data_fields}; - } + #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 f0aeab4..8ec7b43 100644 --- a/lib/SQL/Translator/Schema/Graph/Port.pm +++ b/lib/SQL/Translator/Schema/Graph/Port.pm @@ -2,4 +2,7 @@ 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 4a71063..5f067ca 100644 --- a/lib/SQL/Translator/Schema/Index.pm +++ b/lib/SQL/Translator/Schema/Index.pm @@ -46,19 +46,20 @@ 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.59'; +$VERSION = '1.60'; -my %VALID_INDEX_TYPE = ( - UNIQUE => 1, - NORMAL => 1, - FULLTEXT => 1, # MySQL only (?) - FULL_TEXT => 1, # MySQL only (?) - SPATIAL => 1, # MySQL only (?) +Readonly 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 c2aa333..41ce4a7 100644 --- a/lib/SQL/Translator/Schema/Object.pm +++ b/lib/SQL/Translator/Schema/Object.pm @@ -41,8 +41,7 @@ use Class::MakeMethods::Utility::Ref qw( ref_compare ); use vars qw[ $VERSION ]; -$VERSION = '1.59'; - +$VERSION = '1.60'; =head1 Construction @@ -202,18 +201,11 @@ 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; } @@ -223,12 +215,6 @@ 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 c7d549e..507393d 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.59'; +$VERSION = '1.60'; # ---------------------------------------------------------------------- diff --git a/lib/SQL/Translator/Schema/Table.pm b/lib/SQL/Translator/Schema/Table.pm index 3e02c43..9cbdd73 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.59'; +$VERSION = '1.60'; # 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 dd63b4d..83ff30f 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.59'; +$VERSION = '1.60'; # ---------------------------------------------------------------------- diff --git a/lib/SQL/Translator/Schema/View.pm b/lib/SQL/Translator/Schema/View.pm index 637ee3d..beb83df 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.59'; +$VERSION = '1.60'; # ---------------------------------------------------------------------- diff --git a/lib/SQL/Translator/Utils.pm b/lib/SQL/Translator/Utils.pm index cd0be09..9860617 100644 --- a/lib/SQL/Translator/Utils.pm +++ b/lib/SQL/Translator/Utils.pm @@ -25,7 +25,7 @@ use Digest::SHA1 qw( sha1_hex ); use Exporter; use Readonly; -$VERSION = '1.59'; +$VERSION = '1.60'; $DEFAULT_COMMENT = '-- '; @EXPORT_OK = qw( debug normalize_name header_comment parse_list_arg truncate_id_uniquely $DEFAULT_COMMENT parse_mysql_version @@ -366,6 +366,6 @@ version specifications: =head1 AUTHORS Darren Chamberlain Edarren@cpan.orgE, -Ken Y. Clark Ekclark@cpan.orgE. +Ken Youens-Clark Ekclark@cpan.orgE. =cut diff --git a/lib/Test/SQL/Translator.pm b/lib/Test/SQL/Translator.pm index 2cbf82a..79f412b 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.59'; +$VERSION = '1.60'; @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 Y. Clark for the original table and field test code taken from -his mysql test. +Thanks to Ken YouensClark 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 091c250..8d063a1 100755 --- a/script/sqlt +++ b/script/sqlt @@ -153,7 +153,7 @@ use Pod::Usage; use SQL::Translator; use vars qw( $VERSION ); -$VERSION = '1.59'; +$VERSION = '1.60'; my $from; # the original database my $to; # the destination database diff --git a/script/sqlt-diagram b/script/sqlt-diagram index 7af13f8..c19e2b3 100755 --- a/script/sqlt-diagram +++ b/script/sqlt-diagram @@ -75,7 +75,7 @@ use Pod::Usage; use SQL::Translator; use vars '$VERSION'; -$VERSION = '1.59'; +$VERSION = '1.60'; # # Get arguments. diff --git a/script/sqlt-diff b/script/sqlt-diff index 3a5a6a5..03a9622 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.59'; +$VERSION = '1.60'; 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 96a3c92..0773831 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.59'; +$VERSION = '1.60'; my ( @input, $list, $help, $debug ); for my $arg ( @ARGV ) { diff --git a/script/sqlt-dumper b/script/sqlt-dumper index 0f80959..b8b52c1 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.59'; +$VERSION = '1.60'; my ( $help, $db, $skip, $skiplike, $db_user, $db_pass, $dsn ); GetOptions( diff --git a/script/sqlt-graph b/script/sqlt-graph index b92129c..2d13ce7 100755 --- a/script/sqlt-graph +++ b/script/sqlt-graph @@ -107,7 +107,7 @@ use Pod::Usage; use SQL::Translator; use vars '$VERSION'; -$VERSION = '1.59'; +$VERSION = '1.60'; # # Get arguments. diff --git a/script/sqlt.cgi b/script/sqlt.cgi index 658e5ab..4d114cb 100755 --- a/script/sqlt.cgi +++ b/script/sqlt.cgi @@ -38,7 +38,7 @@ use CGI; use SQL::Translator; use vars '$VERSION'; -$VERSION = '1.59'; +$VERSION = '1.60'; my $q = CGI->new;