# ----------------------------------------------------------
-# 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
# ----------------------------------------------------------
* 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)
- 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
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
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
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
INSTALLATION
- $ perl Build.PL
- $ ./Build
- $ ./Build test
- $ su
- # ./Build install
+ $ perl Makefile.PL
+ $ make && make test
+ $ sudo make install
MANUAL
+++ /dev/null
-* 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.
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;
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
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);
}
# Fields
- foreach ( map { $_->get_fields } $schema->get_tables ) {
+ for ( map { $_->get_fields } $schema->get_tables ) {
my %extra = $_->extra;
$extra{label} ||= ucfirst($_->name);
=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<perl(1)>, L<SQL::Translator>
-=head1 BUGS
-
-=head1 TODO
-
=head1 AUTHOR
+Unknown.
+
=cut
use strict;
use vars qw/$VERSION/;
-$VERSION = '1.59';
+$VERSION = '1.60';
sub filter {
my $schema = shift;
=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<global_table> arg to the
-filter.
+The name of the global can be changed using a C<global_table> arg to
+the filter.
=head1 SEE ALSO
=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
use strict;
use vars qw/$VERSION/;
-$VERSION = '1.59';
+$VERSION = '1.60';
sub filter {
my $schema = shift;
# 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__
L<perl(1)>, L<SQL::Translator>
-=head1 BUGS
-
=head1 TODO
=over 4
=head1 AUTHOR
+Unknown.
+
=cut
=head1 AUTHOR
-Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
+Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
use strict;
use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
-$VERSION = '1.59';
+$VERSION = '1.60';
$DEBUG = 0 unless defined $DEBUG;
use Data::Dumper;
=head1 AUTHOR
-Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
+Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
=head1 SEE ALSO
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.
package SQL::Translator::Parser::DB2::Grammar;
+
+use vars qw[ $VERSION ];
+$VERSION = '1.60';
+
use Parse::RecDescent;
{ my $ERRORS;
}, 'Parse::RecDescent::Rule' )
}
}, 'Parse::RecDescent' );
-}
\ No newline at end of file
+}
use strict;
use DBI;
use vars qw($VERSION @EXPORT);
-$VERSION = '1.59';
+$VERSION = '1.60';
use constant DRIVERS => {
mysql => 'MySQL',
=head1 AUTHOR
-Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
+Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
=head1 SEE ALSO
use SQL::Translator::Schema::Constants;
use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
-# $VERSION = '1.59';
+$VERSION = '1.60';
$DEBUG = 0 unless defined $DEBUG;
# -------------------------------------------------------------------
use SQL::Translator::Parser::MySQL;
use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
-$VERSION = '1.59';
+$VERSION = '1.60';
$DEBUG = 0 unless defined $DEBUG;
# -------------------------------------------------------------------
use SQL::Translator::Schema::Field;
use SQL::Translator::Schema::Constraint;
-our $VERSION = '1.59';
+use vars qw[ $VERSION ];
+$VERSION = '1.60';
# -------------------------------------------------------------------
sub parse {
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',
use Data::Dumper;
use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
-$VERSION = '1.59';
+$VERSION = '1.60';
$DEBUG = 0 unless defined $DEBUG;
no strict 'refs';
use Data::Dumper;
use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
-$VERSION = '1.59';
+$VERSION = '1.60';
$DEBUG = 0 unless defined $DEBUG;
# -------------------------------------------------------------------
=head1 AUTHOR
-Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
+Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
=head1 SEE ALSO
use Data::Dumper;
use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
-$VERSION = '1.59';
+$VERSION = '1.60';
$DEBUG = 0 unless defined $DEBUG;
no strict 'refs';
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;
Mike Mellilo <mmelillo@users.sourceforge.net>,
darren chamberlain E<lt>dlc@users.sourceforge.netE<gt>,
-Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
+Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
=head1 SEE ALSO
use strict;
use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
-$VERSION = '1.59';
+$VERSION = '1.60';
$DEBUG = 0 unless defined $DEBUG;
use Data::Dumper;
use strict;
use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
-$VERSION = '1.59';
+$VERSION = '1.60';
$DEBUG = 0 unless defined $DEBUG;
use Data::Dumper;
use strict;
use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
-$VERSION = '1.59';
+$VERSION = '1.60';
$DEBUG = 0 unless defined $DEBUG;
use Data::Dumper;
=head1 AUTHORS
-Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
+Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
Allen Day E<lt>allenday@ucla.eduE<gt>.
=head1 SEE ALSO
use strict;
use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
-$VERSION = '1.59';
+$VERSION = '1.60';
$DEBUG = 0 unless defined $DEBUG;
use Data::Dumper;
use strict;
use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
-$VERSION = '1.59';
+$VERSION = '1.60';
$DEBUG = 0 unless defined $DEBUG;
use Data::Dumper;
use strict;
use vars qw($DEBUG $VERSION @EXPORT_OK);
$DEBUG = 0 unless defined $DEBUG;
-$VERSION = '1.59';
+$VERSION = '1.60';
use Storable;
use Exporter;
use strict;
use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
-$VERSION = '1.59';
+$VERSION = '1.60';
$DEBUG = 0 unless defined $DEBUG;
use Data::Dumper;
=head1 AUTHOR
-Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
+Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
=head1 SEE ALSO
=head1 AUTHOR
-Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
+Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
=cut
use strict;
use vars qw[ $VERSION $DEBUG ];
-$VERSION = '1.59';
+$VERSION = '1.60';
$DEBUG = 1 unless defined $DEBUG;
use SQL::Translator::Parser::XML::SQLFairy;
package SQL::Translator::Parser::XML::SQLFairy;
# -------------------------------------------------------------------
+# Copyright (C) 2002-2009 The SQLFairy Authors,
# Copyright (C) 2003 Mark Addison <mark.addison@itn.co.uk>,
# Copyright (C) 2009 Jonathan Yu <frequency@cpan.org>
#
use strict;
use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
-$VERSION = '1.59';
+$VERSION = '1.60';
$DEBUG = 0 unless defined $DEBUG;
use Data::Dumper;
use strict;
use vars qw($VERSION);
-$VERSION = '1.59';
+$VERSION = '1.60';
use SQL::Translator::Schema;
use SQL::Translator::Utils qw(header_comment);
=head1 AUTHORS
Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
-Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
+Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
use strict;
use vars qw($VERSION @EXPORT);
-$VERSION = '1.59';
+$VERSION = '1.60';
use Exporter;
use Text::ParseWords qw(quotewords);
=head1 AUTHORS
Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
-Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
+Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
=head1 SEE ALSO
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
use strict;
use vars qw($VERSION);
-$VERSION = '1.59';
+$VERSION = '1.60';
sub produce { "" }
=head1 AUTHORS
Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
-Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
+Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
=head1 SEE ALSO
use strict;
use vars qw[ $VERSION $DEBUG ];
-$VERSION = '1.59';
+$VERSION = '1.60';
$DEBUG = 1 unless defined $DEBUG;
use SQL::Translator::Schema::Constants;
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;
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/;
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 => {
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
use Data::Dumper;
-$VERSION = '1.59';
+$VERSION = '1.60';
sub produce {
my $t = shift;
use Scalar::Util qw/openhandle/;
use vars qw[ $VERSION $DEBUG ];
-$VERSION = '1.59';
+$VERSION = '1.60';
$DEBUG = 0 unless defined $DEBUG;
sub produce {
=head1 AUTHOR
-Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>
-
-Jonathan Yu E<lt>frequency@cpan.orgE<gt>
+Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
+Jonathan Yu E<lt>frequency@cpan.orgE<gt>.
=head1 SEE ALSO
-SQL::Translator, GraphViz
+SQL::Translator, GraphViz.
=cut
use Data::Dumper;
use vars qw($VERSION $NOWRAP $NOLINKTABLE $NAME);
-$VERSION = '1.59';
+$VERSION = '1.60';
$NAME = __PACKAGE__;
$NOWRAP = 0 unless defined $NOWRAP;
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
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';
=head1 AUTHOR
-Chris Mungall
+Chris Mungall.
=head1 SEE ALSO
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:
use strict;
use vars qw[ $VERSION $DEBUG $WARN ];
-$VERSION = '1.59';
+$VERSION = '1.60';
$DEBUG = 0 unless defined $DEBUG;
use SQL::Translator::Schema::Constants;
use strict;
use vars qw[ $VERSION ];
-$VERSION = '1.59';
+$VERSION = '1.60';
use SQL::Translator::Schema::Constants;
use SQL::Translator::Utils qw(header_comment);
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);
use strict;
use vars qw[ $DEBUG $WARN $VERSION ];
-$VERSION = '1.59';
+$VERSION = '1.60';
$DEBUG = 1 unless defined $DEBUG;
use Data::Dumper;
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 {
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;
=head1 AUTHOR
-Ken Youens-Clark C<< <kclark@cpan.orgE> >>.
+Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
Diff code added by Ash Berlin C<< <ash@cpan.org> >>.
use strict;
use vars qw($DEBUG $VERSION @EXPORT_OK);
$DEBUG = 0 unless defined $DEBUG;
-$VERSION = '1.59';
+$VERSION = '1.60';
use Storable;
use Exporter;
use strict;
use vars qw[ $DEBUG $WARN $VERSION ];
-$VERSION = '1.59';
+$VERSION = '1.60';
$DEBUG = 1 unless defined $DEBUG;
use Data::Dumper;
use strict;
use vars qw[ $VERSION @EXPORT_OK ];
-$VERSION = '1.59';
+$VERSION = '1.60';
use Template;
use Data::Dumper;
use strict;
use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
-$VERSION = '1.59';
+$VERSION = '1.60';
$DEBUG = 0 unless defined $DEBUG;
use File::Path;
use strict;
use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
-$VERSION = '1.59';
+$VERSION = '1.60';
$DEBUG = 0 unless defined $DEBUG;
use Template;
use strict;
use vars qw[ $VERSION $DEBUG ];
-$VERSION = '1.59';
+$VERSION = '1.60';
$DEBUG = 1 unless defined $DEBUG;
use SQL::Translator::Producer::XML::SQLFairy;
use strict;
use vars qw[ $VERSION @EXPORT_OK ];
-$VERSION = '1.59';
+$VERSION = '1.60';
use Exporter;
use base qw(Exporter);
use strict;
use vars qw($VERSION);
-$VERSION = '1.59';
+$VERSION = '1.60';
use YAML qw(Dump);
use base 'SQL::Translator::Schema::Object';
use vars qw[ $VERSION ];
-$VERSION = '1.59';
+$VERSION = '1.60';
__PACKAGE__->_attributes(qw/name database translator/);
use base qw( Exporter );
use vars qw( @EXPORT $VERSION );
require Exporter;
-$VERSION = '1.59';
+$VERSION = '1.60';
@EXPORT = qw[
CHECK_C
use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
-$VERSION = '1.59';
+$VERSION = '1.60';
my %VALID_CONSTRAINT_TYPE = (
PRIMARY_KEY, 1,
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
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);
- }
}
- }
}
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;
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;
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;
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;
use strict;
+use vars qw[ $VERSION ];
+$VERSION = '1.60';
+
1;
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 (?)
);
# ----------------------------------------------------------------------
use vars qw[ $VERSION ];
-$VERSION = '1.59';
-
+$VERSION = '1.60';
=head1 Construction
# ----------------------------------------------------------------------
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;
}
=pod
-=head1 SEE ALSO
-
-=head1 TODO
-
-=head1 BUGS
-
=head1 AUTHOR
Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
use vars qw($VERSION);
-$VERSION = '1.59';
+$VERSION = '1.60';
# ----------------------------------------------------------------------
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
use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
-$VERSION = '1.59';
+$VERSION = '1.60';
# ----------------------------------------------------------------------
use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
-$VERSION = '1.59';
+$VERSION = '1.60';
# ----------------------------------------------------------------------
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
=head1 AUTHORS
Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
-Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
+Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
=cut
use base qw(Exporter);
use vars qw($VERSION @EXPORT @EXPORT_OK);
-$VERSION = '1.59';
+$VERSION = '1.60';
@EXPORT = qw(
schema_ok
table_ok
Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>,
Darren Chamberlain <darren@cpan.org>.
-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
use SQL::Translator;
use vars qw( $VERSION );
-$VERSION = '1.59';
+$VERSION = '1.60';
my $from; # the original database
my $to; # the destination database
use SQL::Translator;
use vars '$VERSION';
-$VERSION = '1.59';
+$VERSION = '1.60';
#
# Get arguments.
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,
use SQL::Translator::Schema::Constants;
use vars qw( $VERSION );
-$VERSION = '1.59';
+$VERSION = '1.60';
my ( @input, $list, $help, $debug );
for my $arg ( @ARGV ) {
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(
use SQL::Translator;
use vars '$VERSION';
-$VERSION = '1.59';
+$VERSION = '1.60';
#
# Get arguments.
use SQL::Translator;
use vars '$VERSION';
-$VERSION = '1.59';
+$VERSION = '1.60';
my $q = CGI->new;
projects / dbsrgits/SQL-Translator.git / commitdiff