+
+# ----------------------------------------------------------
+# 0.11000 2009-08-18
+# ----------------------------------------------------------
+* Re-add version numbers to files, else cpan's "upgrade" gets very confused
+* Replaced code using Readonly, since most of the rest uses constant, and thats already a dep
+* Moved YAML and XML::LibXML back to recommends, the tests for both now skip if not installed
+* Bumped to 0.11000 to supercede 0.10 which has incorrect numbering scheme
+
# ----------------------------------------------------------
# 0.10 2009-08-13
# ----------------------------------------------------------
# Test::Kwalitee cache files.
^Debian_CPANTS\.txt
+# Old tarballs etc
+^SQL-Translator
+
+# patch and diff files
+\.diff
+\.patch
+\.orig$
+\.rej$
+
+# junk
+\.log$
+\.tmp$
'File::ShareDir' => 1.0,
'File::Spec' => 0,
'XML::Writer' => 0.500,
- 'XML::LibXML' => 1.69,
- 'YAML' => 0.66,
},
recommends => {
'Template' => 2.10,
'Spreadsheet::ParseExcel' => 0.41,
'Text::ParseWords' => 0,
'Text::RecordParser' => 0.02,
+ 'XML::LibXML' => 1.69,
+ 'YAML' => 0.66,
},
test_requires => {
'File::Basename' => 0,
definition parts of SQL are handled (CREATE, ALTER), not the
manipulation of data (INSERT, UPDATE, DELETE).
-As of version 0.10, parsers exist for the following:
+As of version 0.06, parsers exist for the following:
Databases:
- Access
- DB2
- DBI-DB2
- DBI-MySQL
- DBI-Oracle
- DBI-PostgreSQL
- DBI-SQLServer
- DBI-SQLite
- DBI-Sybase
MySQL
Oracle
PostgreSQL
- SQLServer
SQLite
- Storable
Sybase
+ DBI-MySQL
+ DBI-PostgreSQL
+ DBI-SQLite
+ DBI-Sybase
+
Other:
xSV : arbitrarily delimited text files
Excel : Microsoft Excel spreadsheets
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 : command-line interface for text-to-text translations
-* sqlt-diagram : interface to Diagram producer
-* sqlt-diff : diff two schemas to generate schema mutation file
-* sqlt-graph : interface to GraphViz producer
-* sqlt-dumper : create a data dumper script from a schema
-* sqlt.cgi : CGI interface for all SQLFairy functions
+* sqlt-diagram: interface to Diagram producer
+* sqlt-diff : diff two schemas to generate schema mutation file
+* sqlt-graph : interface to GraphViz producer
+* sqlt-dumper : create a data dumper script from a schema
+* sqlt : command-line interface for text-to-text translations
+* sqlt.cgi : CGI interface for all SQLFairy functions
All scripts not ending in ".cgi" are meant to be run from the command
line with various switches to control the input and output of the
INSTALLATION
- $ perl Makefile.PL
- $ make && make test
- $ sudo make install
+ $ perl Build.PL
+ $ ./Build
+ $ ./Build test
+ $ su
+ # ./Build install
MANUAL
require 5.005;
-$VERSION = '0.10000';
-$DEBUG = 0 unless defined $DEBUG;
-$ERROR = "";
+$VERSION = '0.11000';
+$DEBUG = 0 unless defined $DEBUG;
+$ERROR = "";
use Carp qw(carp);
+
use Data::Dumper;
-use File::Basename qw(dirname);
use File::Find;
use File::Spec::Functions qw(catfile);
+use File::Basename qw(dirname);
use IO::Dir;
use SQL::Translator::Producer;
use SQL::Translator::Schema;
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.60';
+$VERSION = '1.59';
sub filter {
my $schema = shift;
my %args = { +shift };
# Tables
- for ( $schema->get_tables ) {
+ foreach ( $schema->get_tables ) {
my %extra = $_->extra;
$extra{label} ||= ucfirst($_->name);
}
# Fields
- for ( map { $_->get_fields } $schema->get_tables ) {
+ foreach ( 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 AUTHOR
+=head1 BUGS
+
+=head1 TODO
-Unknown.
+=head1 AUTHOR
=cut
use strict;
use vars qw/$VERSION/;
-$VERSION = '1.60';
+$VERSION = '1.59';
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 indices if an index already exists on a table the same
+as one added globally.
-Will generate duplicate constraints if a constraint already exists on
-a table the same as one added globally.
+Will generate duplicate constraints if a constraint already exists on a table
+the same as one added globally.
=head1 TODO
-Some extra data values that can be used to control the global
-addition. e.g. 'skip_global'.
+Some extra data values that can be used to control the global addition. e.g.
+'skip_global'.
=head1 AUTHOR
use strict;
use vars qw/$VERSION/;
-$VERSION = '1.60';
+$VERSION = '1.59';
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 Youens-Clark E<lt>kclark@cpan.orgE<gt>.
+Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
use strict;
use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
-$VERSION = '1.60';
+$VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
use Data::Dumper;
=head1 AUTHOR
-Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
+Ken Y. 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.60';
+$VERSION = '1.59';
use constant DRIVERS => {
mysql => 'MySQL',
=head1 AUTHOR
-Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
+Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
=head1 SEE ALSO
use SQL::Translator::Schema::Constants;
use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
-$VERSION = '1.60';
+# $VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
# -------------------------------------------------------------------
use SQL::Translator::Parser::MySQL;
use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
-$VERSION = '1.60';
+$VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
# -------------------------------------------------------------------
use SQL::Translator::Schema::Field;
use SQL::Translator::Schema::Constraint;
-use vars qw[ $VERSION ];
-$VERSION = '1.60';
+our $VERSION = '1.59';
# -------------------------------------------------------------------
sub parse {
use SQL::Translator::Schema::Constants;
use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
-$VERSION = '1.60';
+$VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
my $actions = {c => 'cascade',
use Data::Dumper;
use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
-$VERSION = '1.60';
+$VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
no strict 'refs';
use Data::Dumper;
use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
-$VERSION = '1.60';
+$VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
# -------------------------------------------------------------------
=head1 AUTHOR
-Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
+Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
=head1 SEE ALSO
use Data::Dumper;
use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
-$VERSION = '1.60';
+$VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
no strict 'refs';
use strict;
use vars qw($DEBUG $VERSION @EXPORT_OK);
$DEBUG = 0 unless defined $DEBUG;
-$VERSION = '1.60';
+$VERSION = '1.59';
use Spreadsheet::ParseExcel;
use Exporter;
Mike Mellilo <mmelillo@users.sourceforge.net>,
darren chamberlain E<lt>dlc@users.sourceforge.netE<gt>,
-Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
+Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
=head1 SEE ALSO
use strict;
use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
-$VERSION = '1.60';
+$VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
use Data::Dumper;
use strict;
use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
-$VERSION = '1.60';
+$VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
use Data::Dumper;
use strict;
use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
-$VERSION = '1.60';
+$VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
use Data::Dumper;
=head1 AUTHORS
-Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
+Ken Y. 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.60';
+$VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
use Data::Dumper;
use strict;
use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
-$VERSION = '1.60';
+$VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
use Data::Dumper;
use strict;
use vars qw($DEBUG $VERSION @EXPORT_OK);
$DEBUG = 0 unless defined $DEBUG;
-$VERSION = '1.60';
+$VERSION = '1.59';
use Storable;
use Exporter;
use strict;
use vars qw[ $DEBUG $VERSION $GRAMMAR @EXPORT_OK ];
-$VERSION = '1.60';
+$VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
use Data::Dumper;
=head1 AUTHOR
-Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
+Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
=head1 SEE ALSO
=head1 AUTHOR
-Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
+Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
=cut
use strict;
use vars qw[ $VERSION $DEBUG ];
-$VERSION = '1.60';
+$VERSION = '1.59';
$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.60';
+$VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
use Data::Dumper;
use strict;
use vars qw($VERSION);
-$VERSION = '1.60';
+$VERSION = '1.59';
use SQL::Translator::Schema;
use SQL::Translator::Utils qw(header_comment);
=head1 AUTHORS
Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
-Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
+Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
use strict;
use vars qw($VERSION @EXPORT);
-$VERSION = '1.60';
+$VERSION = '1.59';
use Exporter;
use Text::ParseWords qw(quotewords);
=head1 AUTHORS
Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
-Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
+Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
=head1 SEE ALSO
package SQL::Translator::Producer;
# -------------------------------------------------------------------
-# Copyright (C) 2002-2009 SQLFairy Authors
+# Copyright (C) 2002-4 SQLFairy Authors
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
use strict;
use vars qw($VERSION);
-$VERSION = '1.60';
+$VERSION = '1.59';
sub produce { "" }
=head1 AUTHORS
Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
-Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
+Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
=head1 SEE ALSO
use strict;
use vars qw[ $VERSION $DEBUG ];
-$VERSION = '1.60';
+$VERSION = '1.59';
$DEBUG = 1 unless defined $DEBUG;
use SQL::Translator::Schema::Constants;
use warnings;
use strict;
use vars qw[ $VERSION $DEBUG $WARN ];
-$VERSION = '1.60';
+$VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
use SQL::Translator::Schema::Constants;
use strict;
use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
-$VERSION = '1.60';
+$VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
use File::ShareDir qw/dist_dir/;
use SQL::Translator::Utils qw(debug);
use vars qw[ $VERSION $DEBUG ];
-$VERSION = '1.60';
+$VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
use constant VALID_FONT_SIZE => {
package SQL::Translator::Producer::Dumper;
# -------------------------------------------------------------------
-# Copyright (C) 2002-2009 SQLFairy Authors
+# Copyright (C) 2002-2006 SQLFairy Authors
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
use Data::Dumper;
-$VERSION = '1.60';
+$VERSION = '1.59';
sub produce {
my $t = shift;
use Scalar::Util qw/openhandle/;
use vars qw[ $VERSION $DEBUG ];
-$VERSION = '1.60';
+$VERSION = '1.59';
$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.60';
+$VERSION = '1.59';
$NAME = __PACKAGE__;
$NOWRAP = 0 unless defined $NOWRAP;
package SQL::Translator::Producer::Latex;
# -------------------------------------------------------------------
-# Copyright (C) 2002-2009 SQLFairy Authors
+# Copyright (C) 2002-6 SQLFairy Authors
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
use strict;
use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
-$VERSION = '1.60';
+$VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
use SQL::Translator::Utils 'debug';
=head1 AUTHOR
-Chris Mungall.
+Chris Mungall
=head1 SEE ALSO
use strict;
use warnings;
use vars qw[ $VERSION $DEBUG %used_names ];
-$VERSION = '1.60';
+$VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
# Maximum length for most identifiers is 64, according to:
use strict;
use vars qw[ $VERSION $DEBUG $WARN ];
-$VERSION = '1.60';
+$VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
use SQL::Translator::Schema::Constants;
use strict;
use vars qw[ $VERSION ];
-$VERSION = '1.60';
+$VERSION = '1.59';
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.60';
+$VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
use base qw(SQL::Translator::Producer);
use strict;
use vars qw[ $DEBUG $WARN $VERSION ];
-$VERSION = '1.60';
+$VERSION = '1.59';
$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.60';
-$DEBUG = 0 if !defined $DEBUG;
-$WARN = 0 if !defined $WARN;
+$VERSION = '1.59';
+$DEBUG = 0 unless defined $DEBUG;
+$WARN = 0 unless defined $WARN;
-Readonly my $MAX_ID_LENGTH => 30;
+our $max_id_length = 30;
my %global_names;
sub produce {
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 E<lt>kclark@cpan.orgE<gt>.
+Ken Youens-Clark C<< <kclark@cpan.orgE> >>.
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.60';
+$VERSION = '1.59';
use Storable;
use Exporter;
use strict;
use vars qw[ $DEBUG $WARN $VERSION ];
-$VERSION = '1.60';
+$VERSION = '1.59';
$DEBUG = 1 unless defined $DEBUG;
use Data::Dumper;
use strict;
use vars qw[ $VERSION @EXPORT_OK ];
-$VERSION = '1.60';
+$VERSION = '1.59';
use Template;
use Data::Dumper;
use strict;
use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
-$VERSION = '1.60';
+$VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
use File::Path;
use strict;
use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
-$VERSION = '1.60';
+$VERSION = '1.59';
$DEBUG = 0 unless defined $DEBUG;
use Template;
use strict;
use vars qw[ $VERSION $DEBUG ];
-$VERSION = '1.60';
+$VERSION = '1.59';
$DEBUG = 1 unless defined $DEBUG;
use SQL::Translator::Producer::XML::SQLFairy;
use strict;
use vars qw[ $VERSION @EXPORT_OK ];
-$VERSION = '1.60';
+$VERSION = '1.59';
use Exporter;
use base qw(Exporter);
use strict;
use vars qw($VERSION);
-$VERSION = '1.60';
+$VERSION = '1.59';
use YAML qw(Dump);
use base 'SQL::Translator::Schema::Object';
use vars qw[ $VERSION ];
-$VERSION = '1.60';
+$VERSION = '1.59';
__PACKAGE__->_attributes(qw/name database translator/);
use base qw( Exporter );
use vars qw( @EXPORT $VERSION );
require Exporter;
-$VERSION = '1.60';
+$VERSION = '1.59';
@EXPORT = qw[
CHECK_C
use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
-$VERSION = '1.60';
+$VERSION = '1.59';
my %VALID_CONSTRAINT_TYPE = (
PRIMARY_KEY, 1,
use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
-$VERSION = '1.60';
+$VERSION = '1.59';
# Stringify to our name, being careful not to pass any args through so we don't
# accidentally set it to undef. We also have to tweak bool so the object is
use base 'Class::Base';
-use vars qw[ $VERSION ];
-$VERSION = '1.60';
-
use Data::Dumper;
+local $Data::Dumper::Maxdepth = 3;
+
use SQL::Translator::Schema::Graph::Node;
use SQL::Translator::Schema::Graph::Edge;
use SQL::Translator::Schema::Graph::Port;
use SQL::Translator::Schema::Graph::CompoundEdge;
use SQL::Translator::Schema::Graph::HyperEdge;
-use Readonly;
-local $Data::Dumper::Maxdepth = 3;
-
-Readonly my $Node => 'SQL::Translator::Schema::Graph::Node';
-Readonly my $Edge => 'SQL::Translator::Schema::Graph::Edge';
-Readonly my $Port => 'SQL::Translator::Schema::Graph::Port';
-Readonly my $CompoundEdge => 'SQL::Translator::Schema::Graph::CompoundEdge';
-Readonly my $HyperEdge => 'SQL::Translator::Schema::Graph::HyperEdge';
+use constant Node => 'SQL::Translator::Schema::Graph::Node';
+use constant Edge => 'SQL::Translator::Schema::Graph::Edge';
+use constant Port => 'SQL::Translator::Schema::Graph::Port';
+use constant CompoundEdge => 'SQL::Translator::Schema::Graph::CompoundEdge';
+use constant HyperEdge => 'SQL::Translator::Schema::Graph::HyperEdge';
use Class::MakeMethods::Template::Hash (
- 'new --and_then_init' => 'new',
- object => [ 'translator' => { class => 'SQL::Translator' }, ],
- 'hash' => [qw( node )],
- 'number --counter' => [qw( order )],
+ 'new --and_then_init' => 'new',
+ object => [
+ 'translator' => {class => 'SQL::Translator'},
+ ],
+ 'hash' => [ qw( node ) ],
+ 'number --counter' => [ qw( order ) ],
);
use vars qw/$DEBUG/;
$DEBUG = 0 unless defined $DEBUG;
sub init {
- my $self = shift;
-
- #
- # build package objects
- #
- for my $table ( $self->translator->schema->get_tables ) {
- die __PACKAGE__
- . " table "
- . $table->name
- . " doesn't have a primary key!"
- unless $table->primary_key;
- die __PACKAGE__
- . " table "
- . $table->name
- . " can't have a composite primary key!"
- if ( $table->primary_key->fields )[1];
-
- my $node = $Node->new();
-
- $self->node_push( $table->name => $node );
-
- if ( $table->is_trivial_link ) { $node->is_trivial_link(1); }
- else { $node->is_trivial_link(0); }
-
- $node->order( $self->order_incr() );
- $node->name( $self->translator->format_package_name( $table->name ) );
- $node->table($table);
- $node->primary_key( ( $table->primary_key->fields )[0] );
-
- # Primary key may have a differenct accessor method name
- $node->primary_key_accessor(
- defined( $self->translator->format_pk_name )
- ? $self->translator->format_pk_name->(
- $node->name, $node->primary_key
- )
- : undef
- );
- }
-
- for my $node ( $self->node_values ) {
- for my $field ( $node->table->get_fields ) {
- if ( !$field->is_foreign_key && !$field->is_primary_key ) {
- $node->data_fields->{ $field->name } = 1;
- }
- elsif ( $field->is_foreign_key ) {
- my $that =
- $self->node( $field->foreign_key_reference->reference_table );
-
- #this means we have an incomplete schema
- next unless $that;
-
- my $edge = $Edge->new(
- type => 'import',
- thisnode => $node,
- thisfield => $field,
- thatnode => $that,
-
- #can you believe this sh*t just to get a field obj?
- thatfield => $self->translator->schema->get_table(
- $field->foreign_key_reference->reference_table
- )->get_field(
- ( $field->foreign_key_reference->reference_fields )[0]
- )
- );
-
- $node->edgecount( $that->name,
- $node->edgecount( $that->name ) + 1 );
-
- $node->has( $that->name, $node->has( $that->name ) + 1 );
- $that->many( $node->name, $that->many( $node->name ) + 1 );
-
- $that->edgecount( $node->name,
- $that->edgecount( $node->name ) + 1 );
-
- #warn "\t" . $node->name . "\t" . $node->edgecount($that->name);
- $node->push_edges($edge);
- $that->push_edges( $edge->flip );
- }
- }
- }
-
- #
- # type MM relationships
- #
- #for linknode
- for my $lnode ( sort $self->node_values ) {
- next if $lnode->table->is_data;
- for my $inode1 ( sort $self->node_values ) {
-
- #linknode can't link to itself
- next if $inode1 eq $lnode;
-
- my @inode1_imports =
- grep { $_->type eq 'import' and $_->thatnode eq $inode1 }
- $lnode->edges;
- next unless @inode1_imports;
-
- for my $inode2 ( sort $self->node_values ) {
-
- #linknode can't link to itself
- next if $inode2 eq $lnode;
-
- #identify tables that import keys to linknode
- my %i =
- map { $_->thatnode->name => 1 }
- grep { $_->type eq 'import' } $lnode->edges;
-
- if ( scalar( keys %i ) == 1 ) {
- }
- else {
- last if $inode1 eq $inode2;
- }
-
- my @inode2_imports =
- grep { $_->type eq 'import' and $_->thatnode eq $inode2 }
- $lnode->edges;
- next unless @inode2_imports;
-
- my $cedge = $CompoundEdge->new();
- $cedge->via($lnode);
-
- $cedge->push_edges(
- map { $_->flip }
- grep {
- $_->type eq 'import'
- and
- ( $_->thatnode eq $inode1 or $_->thatnode eq $inode2 )
- } $lnode->edges
- );
-
- if ( scalar(@inode1_imports) == 1
- and scalar(@inode2_imports) == 1 )
- {
- $cedge->type('one2one');
-
- $inode1->via( $inode2->name,
- $inode1->via( $inode2->name ) + 1 );
- $inode2->via( $inode1->name,
- $inode2->via( $inode1->name ) + 1 );
- }
- elsif ( scalar(@inode1_imports) > 1
- and scalar(@inode2_imports) == 1 )
- {
- $cedge->type('many2one');
-
- $inode1->via( $inode2->name,
- $inode1->via( $inode2->name ) + 1 );
- $inode2->via( $inode1->name,
- $inode2->via( $inode1->name ) + 1 );
- }
- elsif ( scalar(@inode1_imports) == 1
- and scalar(@inode2_imports) > 1 )
- {
-
- #handled above
- }
- elsif ( scalar(@inode1_imports) > 1
- and scalar(@inode2_imports) > 1 )
- {
- $cedge->type('many2many');
-
- $inode1->via( $inode2->name,
- $inode1->via( $inode2->name ) + 1 );
- $inode2->via( $inode1->name,
- $inode2->via( $inode1->name ) + 1 );
- }
-
- $inode1->push_compoundedges($cedge);
- $inode2->push_compoundedges($cedge) unless $inode1 eq $inode2;
- }
+ my $self = shift;
+
+ #
+ # build package objects
+ #
+ foreach my $table ($self->translator->schema->get_tables){
+ die __PACKAGE__." table ".$table->name." doesn't have a primary key!" unless $table->primary_key;
+ die __PACKAGE__." table ".$table->name." can't have a composite primary key!" if ($table->primary_key->fields)[1];
+
+ my $node = Node->new();
+
+ $self->node_push($table->name => $node);
+
+ if ($table->is_trivial_link) { $node->is_trivial_link(1); }
+ else { $node->is_trivial_link(0); }
+
+ $node->order($self->order_incr());
+ $node->name( $self->translator->format_package_name($table->name) );
+ $node->table( $table );
+ $node->primary_key( ($table->primary_key->fields)[0] );
+
+ # Primary key may have a differenct accessor method name
+ $node->primary_key_accessor(
+ defined($self->translator->format_pk_name)
+ ? $self->translator->format_pk_name->( $node->name, $node->primary_key )
+ : undef
+ );
+ }
+
+ foreach my $node ($self->node_values){
+ foreach my $field ($node->table->get_fields){
+ if (!$field->is_foreign_key && !$field->is_primary_key) { $node->data_fields->{$field->name} = 1; }
+ elsif($field->is_foreign_key) {
+ my $that = $self->node($field->foreign_key_reference->reference_table);
+
+ #this means we have an incomplete schema
+ next unless $that;
+
+ my $edge = Edge->new(
+ type => 'import',
+ thisnode => $node,
+ thisfield => $field,
+ thatnode => $that,
+ #can you believe this sh*t just to get a field obj?
+ thatfield => $self->translator->schema->get_table($field->foreign_key_reference->reference_table)->get_field(($field->foreign_key_reference->reference_fields)[0])
+ );
+
+ $node->edgecount($that->name, $node->edgecount($that->name)+1);
+
+ $node->has($that->name, $node->has($that->name)+1);
+ $that->many($node->name, $that->many($node->name)+1);
+
+ $that->edgecount($node->name, $that->edgecount($node->name)+1);
+
+ #warn "\t" . $node->name . "\t" . $node->edgecount($that->name);
+ $node->push_edges( $edge );
+ $that->push_edges( $edge->flip );
+ }
+ }
+
+ #warn Dumper($node->edgecount());
+ #warn "*****";
+ }
+
+ #
+ # type MM relationships
+ #
+ #foreach linknode
+ foreach my $lnode (sort $self->node_values){
+ next if $lnode->table->is_data;
+ foreach my $inode1 (sort $self->node_values){
+ #linknode can't link to itself
+ next if $inode1 eq $lnode;
+
+ my @inode1_imports = grep { $_->type eq 'import' and $_->thatnode eq $inode1 } $lnode->edges;
+ next unless @inode1_imports;
+
+ foreach my $inode2 (sort $self->node_values){
+ #linknode can't link to itself
+ next if $inode2 eq $lnode;
+
+ #identify tables that import keys to linknode
+ my %i = map {$_->thatnode->name => 1} grep { $_->type eq 'import'} $lnode->edges;
+
+ if(scalar(keys %i) == 1) {
+ } else {
+ last if $inode1 eq $inode2;
+ }
+
+ my @inode2_imports = grep { $_->type eq 'import' and $_->thatnode eq $inode2 } $lnode->edges;
+ next unless @inode2_imports;
+
+ my $cedge = CompoundEdge->new();
+ $cedge->via($lnode);
+
+ #warn join ' ', map {$_->thisfield->name} map {$_->flip} $lnode->edges;
+ #warn join ' ', map {$_->thisfield->name} $lnode->edges;
+ #warn join ' ', map {$_->thisfield->name} map {$_->flip} grep {$_->type eq 'import'} $lnode->edges;
+ #warn join ' ', map {$_->thatfield->name} map {$_->flip} grep {$_->type eq 'import'} $lnode->edges;
+ $cedge->push_edges(
+ map {$_->flip}
+ grep {$_->type eq 'import'
+ and
+ ($_->thatnode eq $inode1 or $_->thatnode eq $inode2)
+ } $lnode->edges
+ );
+
+ if(scalar(@inode1_imports) == 1 and scalar(@inode2_imports) == 1){
+ $cedge->type('one2one');
+
+ $inode1->via($inode2->name,$inode1->via($inode2->name)+1);
+ $inode2->via($inode1->name,$inode2->via($inode1->name)+1);
+ }
+ elsif(scalar(@inode1_imports) > 1 and scalar(@inode2_imports) == 1){
+ $cedge->type('many2one');
+
+ $inode1->via($inode2->name,$inode1->via($inode2->name)+1);
+ $inode2->via($inode1->name,$inode2->via($inode1->name)+1);
+ }
+ elsif(scalar(@inode1_imports) == 1 and scalar(@inode2_imports) > 1){
+ #handled above
+ }
+ elsif(scalar(@inode1_imports) > 1 and scalar(@inode2_imports) > 1){
+ $cedge->type('many2many');
+
+ $inode1->via($inode2->name,$inode1->via($inode2->name)+1);
+ $inode2->via($inode1->name,$inode2->via($inode1->name)+1);
+ }
+#warn Dumper($cedge);
+
+ $inode1->push_compoundedges($cedge);
+ $inode2->push_compoundedges($cedge) unless $inode1 eq $inode2;
+# if($inode1->name ne $inode2->name){
+# my $flipped_cedge = $cedge;
+# foreach my $flipped_cedge_edge ($flipped_cedge->edges){
+# warn Dumper $flipped_cedge_edge;
+# warn "\t". Dumper $flipped_cedge_edge->flip;
+# }
+# }
+ }
+ }
+ }
+
+ my $graph = $self; #hack
+
+ #
+ # create methods
+ #
+ # this code needs to move to Graph.pm
+ foreach my $node_from ($graph->node_values) {
+
+ next unless $node_from->table->is_data or !$node_from->table->is_trivial_link;
+
+ foreach my $cedge ( $node_from->compoundedges ) {
+
+ my $hyperedge = SQL::Translator::Schema::Graph::HyperEdge->new();
+
+ my $node_to;
+ foreach my $edge ($cedge->edges) {
+ if ($edge->thisnode->name eq $node_from->name) {
+ $hyperedge->vianode($edge->thatnode);
+
+ if ($edge->thatnode->name ne $cedge->via->name) {
+ $node_to ||= $graph->node($edge->thatnode->table->name);
+ }
+
+ $hyperedge->push_thisnode($edge->thisnode);
+ $hyperedge->push_thisfield($edge->thisfield);
+ $hyperedge->push_thisviafield($edge->thatfield);
+
+ } else {
+ if ($edge->thisnode->name ne $cedge->via->name) {
+ $node_to ||= $graph->node($edge->thisnode->table->name);
+ }
+ $hyperedge->push_thatnode($edge->thisnode);
+ $hyperedge->push_thatfield($edge->thisfield);
+ $hyperedge->push_thatviafield($edge->thatfield);
}
- }
-
- my $graph = $self; #hack
-
- #
- # create methods
- #
- # this code needs to move to Graph.pm
- for my $node_from ( $graph->node_values ) {
-
- next
- unless $node_from->table->is_data
- or !$node_from->table->is_trivial_link;
-
- for my $cedge ( $node_from->compoundedges ) {
-
- my $hyperedge = SQL::Translator::Schema::Graph::HyperEdge->new();
-
- my $node_to;
- for my $edge ( $cedge->edges ) {
- if ( $edge->thisnode->name eq $node_from->name ) {
- $hyperedge->vianode( $edge->thatnode );
-
- if ( $edge->thatnode->name ne $cedge->via->name ) {
- $node_to ||=
- $graph->node( $edge->thatnode->table->name );
- }
-
- $hyperedge->push_thisnode( $edge->thisnode );
- $hyperedge->push_thisfield( $edge->thisfield );
- $hyperedge->push_thisviafield( $edge->thatfield );
-
- }
- else {
- if ( $edge->thisnode->name ne $cedge->via->name ) {
- $node_to ||=
- $graph->node( $edge->thisnode->table->name );
- }
- $hyperedge->push_thatnode( $edge->thisnode );
- $hyperedge->push_thatfield( $edge->thisfield );
- $hyperedge->push_thatviafield( $edge->thatfield );
- }
- $self->debug( $edge->thisfield->name );
- $self->debug( $edge->thatfield->name );
- }
-
- if ( $hyperedge->count_thisnode == 1
- and $hyperedge->count_thatnode == 1 )
- {
- $hyperedge->type('one2one');
- }
- elsif ( $hyperedge->count_thisnode > 1
- and $hyperedge->count_thatnode == 1 )
- {
- $hyperedge->type('many2one');
- }
- elsif ( $hyperedge->count_thisnode == 1
- and $hyperedge->count_thatnode > 1 )
- {
- $hyperedge->type('one2many');
- }
- elsif ( $hyperedge->count_thisnode > 1
- and $hyperedge->count_thatnode > 1 )
- {
- $hyperedge->type('many2many');
- }
-
- $self->debug($_)
- for sort keys %::SQL::Translator::Schema::Graph::HyperEdge::;
-
- # node_to won't always be defined b/c of multiple edges to a
- # single other node
- if ( defined($node_to) ) {
- $self->debug( $node_from->name );
- $self->debug( $node_to->name );
-
- if ( scalar( $hyperedge->thisnode ) > 1 ) {
- $self->debug( $hyperedge->type . " via "
- . $hyperedge->vianode->name );
- my $i = 0;
- for my $thisnode ( $hyperedge->thisnode ) {
- $self->debug( $thisnode->name . ' '
- . $hyperedge->thisfield_index(0)->name . ' -> '
- . $hyperedge->thisviafield_index($i)->name . ' '
- . $hyperedge->vianode->name . ' '
- . $hyperedge->thatviafield_index(0)->name . ' <- '
- . $hyperedge->thatfield_index(0)->name . ' '
- . $hyperedge->thatnode_index(0)->name
- . "\n" );
- $i++;
- }
- }
-
- #warn Dumper($hyperedge) if $hyperedge->type eq 'many2many';
- $node_from->push_hyperedges($hyperedge);
- }
+ $self->debug($edge->thisfield->name);
+ $self->debug($edge->thatfield->name);
+ }
+
+ if ($hyperedge->count_thisnode == 1 and $hyperedge->count_thatnode == 1) {
+ $hyperedge->type('one2one');
+ } elsif ($hyperedge->count_thisnode > 1 and $hyperedge->count_thatnode == 1) {
+ $hyperedge->type('many2one');
+ } elsif ($hyperedge->count_thisnode == 1 and $hyperedge->count_thatnode > 1) {
+ $hyperedge->type('one2many');
+ } elsif ($hyperedge->count_thisnode > 1 and $hyperedge->count_thatnode > 1) {
+ $hyperedge->type('many2many');
+ }
+
+ $self->debug($_) foreach sort keys %::SQL::Translator::Schema::Graph::HyperEdge::;
+
+ #node_to won't always be defined b/c of multiple edges to a single other node
+ if (defined($node_to)) {
+ $self->debug($node_from->name);
+ $self->debug($node_to->name);
+
+ if (scalar($hyperedge->thisnode) > 1) {
+ $self->debug($hyperedge->type ." via ". $hyperedge->vianode->name);
+ my $i = 0;
+ foreach my $thisnode ( $hyperedge->thisnode ) {
+ $self->debug($thisnode->name .' '.
+ $hyperedge->thisfield_index(0)->name .' -> '.
+ $hyperedge->thisviafield_index($i)->name .' '.
+ $hyperedge->vianode->name .' '.
+ $hyperedge->thatviafield_index(0)->name .' <- '.
+ $hyperedge->thatfield_index(0)->name .' '.
+ $hyperedge->thatnode_index(0)->name ."\n"
+ );
+ $i++;
+ }
}
+ #warn Dumper($hyperedge) if $hyperedge->type eq 'many2many';
+ $node_from->push_hyperedges($hyperedge);
+ }
}
+ }
}
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;
+ my $self = shift;
+
+#warn "self thisfield: ".$self->thisfield->name;
+#warn "self thatfield: ".$self->thatfield->name;
- return SQL::Translator::Schema::Graph::Edge->new(
- thisfield => $self->thatfield,
- thatfield => $self->thisfield,
- thisnode => $self->thatnode,
- thatnode => $self->thisnode,
- type => $self->type eq 'import' ? 'export' : 'import'
- );
+ return SQL::Translator::Schema::Graph::Edge->new( thisfield => $self->thatfield,
+ thatfield => $self->thisfield,
+ thisnode => $self->thatnode,
+ thatnode => $self->thisnode,
+ type => $self->type eq 'import' ? 'export' : 'import'
+ );
}
1;
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} ||= {};
-
- if ( scalar(@_) == 1 ) {
- my $k = shift;
- return $self->{_many}{$k} || 0;
- }
- elsif (@_) {
- my %arg = @_;
+ my($self) = shift;
- foreach my $k ( keys %arg ) {
+ $self->{_many} ||= {};
- #warn $a,"\t",$arg{$k};
- $self->{_many}{$k} = $arg{$k};
- }
+ if(scalar(@_) == 1){
+ my $k = shift;
+ return $self->{_many}{$k} || 0;
+ } elsif(@_) {
+ my %arg = @_;
- return %arg;
- }
- else {
- return $self->{_many};
+ foreach my $k (keys %arg){
+ #warn $a,"\t",$arg{$k};
+ $self->{_many}{$k} = $arg{$k};
}
+
+ return %arg;
+ } else {
+ return $self->{_many};
+ }
}
sub via {
- my ($self) = shift;
+ my($self) = shift;
- $self->{_via} ||= {};
+ $self->{_via} ||= {};
- if ( scalar(@_) == 1 ) {
- my $k = shift;
- return $self->{_via}{$k} || 0;
- }
- elsif (@_) {
- my %arg = @_;
+ if(scalar(@_) == 1){
+ my $k = shift;
+ return $self->{_via}{$k} || 0;
+ } elsif(@_) {
+ my %arg = @_;
- foreach my $k ( keys %arg ) {
-
- #warn $a,"\t",$arg{$k};
- $self->{_via}{$k} = $arg{$k};
- }
-
- return %arg;
- }
- else {
- return $self->{_via};
+ foreach my $k (keys %arg){
+ #warn $a,"\t",$arg{$k};
+ $self->{_via}{$k} = $arg{$k};
}
+
+ return %arg;
+ } else {
+ return $self->{_via};
+ }
}
sub has {
- my ($self) = shift;
-
- $self->{_has} ||= {};
-
- if ( scalar(@_) == 1 ) {
- my $k = shift;
- return $self->{_has}{$k} || 0;
- }
- elsif (@_) {
- my %arg = @_;
+ my($self) = shift;
- foreach my $k ( keys %arg ) {
+ $self->{_has} ||= {};
- #warn $a,"\t",$arg{$k};
- $self->{_has}{$k} = $arg{$k};
- }
+ if(scalar(@_) == 1){
+ my $k = shift;
+ return $self->{_has}{$k} || 0;
+ } elsif(@_) {
+ my %arg = @_;
- return %arg;
- }
- else {
- return $self->{_has};
+ foreach my $k (keys %arg){
+ #warn $a,"\t",$arg{$k};
+ $self->{_has}{$k} = $arg{$k};
}
+
+ return %arg;
+ } else {
+ return $self->{_has};
+ }
}
sub edgecount {
- my ($self) = shift;
+ my($self) = shift;
- $self->{_edgecount} ||= {};
+ $self->{_edgecount} ||= {};
- if ( scalar(@_) == 1 ) {
- my $k = shift;
- return $self->{_edgecount}{$k} || 0;
- }
- elsif (@_) {
- my %arg = @_;
+ if(scalar(@_) == 1){
+ my $k = shift;
+ return $self->{_edgecount}{$k} || 0;
+ } elsif(@_) {
+ my %arg = @_;
- foreach my $k ( keys %arg ) {
-
- #warn $a,"\t",$arg{$k};
- $self->{_edgecount}{$k} = $arg{$k};
- }
-
- return %arg;
- }
- else {
- return $self->{_edgecount};
+ foreach my $k (keys %arg){
+ #warn $a,"\t",$arg{$k};
+ $self->{_edgecount}{$k} = $arg{$k};
}
+
+ return %arg;
+ } else {
+ return $self->{_edgecount};
+ }
}
sub data_fields {
- my ($self) = shift;
-
- $self->{_data_fields} ||= {};
-
- if ( scalar(@_) == 1 ) {
- my $k = shift;
- return $self->{_data_fields}{$k};
- }
- elsif (@_) {
- my %arg = @_;
+ my($self) = shift;
- foreach my $k ( keys %arg ) {
+ $self->{_data_fields} ||= {};
- #warn $a,"\t",$arg{$k};
- $self->{_data_fields}{$k} = $arg{$k};
- }
+ if(scalar(@_) == 1){
+ my $k = shift;
+ return $self->{_data_fields}{$k};
+ } elsif(@_) {
+ my %arg = @_;
- return %arg;
- }
- else {
- return $self->{_data_fields};
+ foreach my $k (keys %arg){
+ #warn $a,"\t",$arg{$k};
+ $self->{_data_fields}{$k} = $arg{$k};
}
+
+ return %arg;
+ } else {
+ return $self->{_data_fields};
+ }
}
1;
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.60';
+$VERSION = '1.59';
-Readonly my %VALID_INDEX_TYPE => (
- UNIQUE => 1,
- NORMAL => 1,
- FULLTEXT => 1, # MySQL only (?)
- FULL_TEXT => 1, # MySQL only (?)
- SPATIAL => 1, # MySQL only (?)
+my %VALID_INDEX_TYPE = (
+ UNIQUE => 1,
+ NORMAL => 1,
+ FULLTEXT => 1, # MySQL only (?)
+ FULL_TEXT => 1, # MySQL only (?)
+ SPATIAL => 1, # MySQL only (?)
);
# ----------------------------------------------------------------------
use vars qw[ $VERSION ];
-$VERSION = '1.60';
+$VERSION = '1.59';
+
=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.60';
+$VERSION = '1.59';
# ----------------------------------------------------------------------
use vars qw( $VERSION );
-$VERSION = '1.60';
+$VERSION = '1.59';
# Stringify to our name, being careful not to pass any args through so we don't
# accidentally set it to undef. We also have to tweak bool so the object is
use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
-$VERSION = '1.60';
+$VERSION = '1.59';
# ----------------------------------------------------------------------
use vars qw($VERSION $TABLE_COUNT $VIEW_COUNT);
-$VERSION = '1.60';
+$VERSION = '1.59';
# ----------------------------------------------------------------------
use Exporter;
use Readonly;
-$VERSION = '1.60';
+$VERSION = '1.59';
$DEFAULT_COMMENT = '-- ';
@EXPORT_OK = qw(
debug normalize_name header_comment parse_list_arg truncate_id_uniquely $DEFAULT_COMMENT parse_mysql_version
);
-Readonly my $COLLISION_TAG_LENGTH => 8;
+use constant COLLISION_TAG_LENGTH => 8;
# ----------------------------------------------------------------------
# debug(@msg)
unless defined $desired_name && length $desired_name > $max_symbol_length;
my $truncated_name = substr $desired_name, 0,
- $max_symbol_length - $COLLISION_TAG_LENGTH - 1;
+ $max_symbol_length - COLLISION_TAG_LENGTH - 1;
# Hex isn't the most space-efficient, but it skirts around allowed
# charset issues
my $digest = sha1_hex($desired_name);
- my $collision_tag = substr $digest, 0, $COLLISION_TAG_LENGTH;
+ my $collision_tag = substr $digest, 0, COLLISION_TAG_LENGTH;
return $truncated_name
. '_'
=head1 AUTHORS
Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
-Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>.
+Ken Y. Clark E<lt>kclark@cpan.orgE<gt>.
=cut
use base qw(Exporter);
use vars qw($VERSION @EXPORT @EXPORT_OK);
-$VERSION = '1.60';
+$VERSION = '1.59';
@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 YouensClark for the original table and field test code taken
-from his mysql test.
+Thanks to Ken Y. Clark for the original table and field test code taken from
+his mysql test.
=head1 SEE ALSO
use SQL::Translator;
use vars qw( $VERSION );
-$VERSION = '1.60';
+$VERSION = '1.59';
my $from; # the original database
my $to; # the destination database
use SQL::Translator;
use vars '$VERSION';
-$VERSION = '1.60';
+$VERSION = '1.59';
#
# Get arguments.
use SQL::Translator::Schema::Constants;
use vars qw( $VERSION );
-$VERSION = '1.60';
+$VERSION = '1.59';
my ( @input, $list, $help, $debug, $trace, $caseopt, $ignore_index_names,
$ignore_constraint_names, $output_db, $mysql_parser_version,
use SQL::Translator::Schema::Constants;
use vars qw( $VERSION );
-$VERSION = '1.60';
+$VERSION = '1.59';
my ( @input, $list, $help, $debug );
for my $arg ( @ARGV ) {
use File::Basename qw(basename);
use vars '$VERSION';
-$VERSION = '1.60';
+$VERSION = '1.59';
my ( $help, $db, $skip, $skiplike, $db_user, $db_pass, $dsn );
GetOptions(
use SQL::Translator;
use vars '$VERSION';
-$VERSION = '1.60';
+$VERSION = '1.59';
#
# Get arguments.
use SQL::Translator;
use vars '$VERSION';
-$VERSION = '1.60';
+$VERSION = '1.59';
my $q = CGI->new;
use Data::Dumper;
BEGIN {
- maybe_plan(16, 'Template', 'Test::Differences')
+ maybe_plan(16, 'Template', 'Test::Differences',
+ 'SQL::Translator::Parser::YAML',
+ 'SQL::Translator::Producer::YAML')
+
}
use Test::Differences;
use SQL::Translator;
projects / dbsrgits/SQL-Translator.git / commitdiff