r71229 - in /branches/upstream/libparse-dia-sql-perl/current: ./ bin/ lib/Parse/Dia/ lib/Parse/Dia/SQL/ t/ t/data/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Sat Mar 12 01:46:46 UTC 2011
Author: jawnsy-guest
Date: Sat Mar 12 01:46:36 2011
New Revision: 71229
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=71229
Log:
[svn-upgrade] new version libparse-dia-sql-perl (0.17)
Added:
branches/upstream/libparse-dia-sql-perl/current/t/621-output-get-schema-create-many-to-many-uml.t
branches/upstream/libparse-dia-sql-perl/current/t/962-rt57842-postsgres-int.t
branches/upstream/libparse-dia-sql-perl/current/t/data/rt57842.dia (with props)
Modified:
branches/upstream/libparse-dia-sql-perl/current/Changes
branches/upstream/libparse-dia-sql-perl/current/MANIFEST
branches/upstream/libparse-dia-sql-perl/current/META.yml
branches/upstream/libparse-dia-sql-perl/current/bin/parsediasql
branches/upstream/libparse-dia-sql-perl/current/lib/Parse/Dia/SQL.pm
branches/upstream/libparse-dia-sql-perl/current/lib/Parse/Dia/SQL/Logger.pm
branches/upstream/libparse-dia-sql-perl/current/lib/Parse/Dia/SQL/Output.pm
branches/upstream/libparse-dia-sql-perl/current/lib/Parse/Dia/SQL/Utils.pm
branches/upstream/libparse-dia-sql-perl/current/t/300-parse-classes-many-to-many.t
branches/upstream/libparse-dia-sql-perl/current/t/500-get-associations.t
branches/upstream/libparse-dia-sql-perl/current/t/650-output-get-create-associations-many-to-many-097.t
branches/upstream/libparse-dia-sql-perl/current/t/650-output-get-create-associations-many-to-many.t
branches/upstream/libparse-dia-sql-perl/current/t/961-rt57182-charset.t
Modified: branches/upstream/libparse-dia-sql-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparse-dia-sql-perl/current/Changes?rev=71229&op=diff
==============================================================================
--- branches/upstream/libparse-dia-sql-perl/current/Changes (original)
+++ branches/upstream/libparse-dia-sql-perl/current/Changes Sat Mar 12 01:46:36 2011
@@ -1,4 +1,14 @@
Revision history for Perl module Parse::Dia::SQL.
+
+0.17 Wed Feb 16 11:02:44 CET 2011
+ - RT #58189: Enable log level in command line arguments.
+ (reported by ELACOUR at cpan.org)
+ - RT #62131 (reported by Felix Ostmann):
+ - Associations incorrectly named in many-to-many
+ relationships.
+ - Add --uml support.
+ - RT #57842 postgres: serial -> int not working
+ (reported by shemgp).
0.16 Fri May 21 07:20:43 CEST 2010
- RT #57182 Encoding for insert statements in UML components
Modified: branches/upstream/libparse-dia-sql-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparse-dia-sql-perl/current/MANIFEST?rev=71229&op=diff
==============================================================================
--- branches/upstream/libparse-dia-sql-perl/current/MANIFEST (original)
+++ branches/upstream/libparse-dia-sql-perl/current/MANIFEST Sat Mar 12 01:46:36 2011
@@ -19,8 +19,9 @@
lib/Parse/Dia/SQL/Utils.pm
LICENSE
Makefile.PL
-MANIFEST This list of files
+MANIFEST
MANIFEST.SKIP
+META.yml Module meta-data (added by MakeMaker)
README
t/000-load.t
t/001-new.t
@@ -51,6 +52,7 @@
t/620-output-get-schema-create-many-to-many.t
t/620-output-get-schema-create.t
t/621-output-get-create-table-sql.t
+t/621-output-get-schema-create-many-to-many-uml.t
t/622-output-get-create-view-sql.t
t/623-output-get-view-create.t
t/640-output-get-schema-drop-sql.t
@@ -101,6 +103,7 @@
t/953-rt53783-sqlite3.t
t/960-rt56357-database-model.t
t/961-rt57182-charset.t
+t/962-rt57842-postsgres-int.t
t/data/association_dia_0_97.dia
t/data/db-model-fk.dia
t/data/db2.pre.dupe.dia
@@ -115,10 +118,10 @@
t/data/rt52755.dia
t/data/rt53783.dia
t/data/rt56357.dia
+t/data/rt57842.dia
t/data/table.col.comment.dia
t/data/TestERD.dia
t/data/typemap.dia
t/data/version.supported.dia
t/data/version.unsupported.dia
TODO
-META.yml Module meta-data (added by MakeMaker)
Modified: branches/upstream/libparse-dia-sql-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparse-dia-sql-perl/current/META.yml?rev=71229&op=diff
==============================================================================
--- branches/upstream/libparse-dia-sql-perl/current/META.yml (original)
+++ branches/upstream/libparse-dia-sql-perl/current/META.yml Sat Mar 12 01:46:36 2011
@@ -1,12 +1,14 @@
--- #YAML:1.0
name: Parse-Dia-SQL
-version: 0.16
+version: 0.17
abstract: Convert Dia class diagrams into SQL.
author:
- Andreas Faafeng <aff at cpan.org>
license: gpl
distribution_type: module
configure_requires:
+ ExtUtils::MakeMaker: 0
+build_requires:
ExtUtils::MakeMaker: 0
requires:
Data::Dumper: 0
@@ -29,7 +31,7 @@
directory:
- t
- inc
-generated_by: ExtUtils::MakeMaker version 6.48
+generated_by: ExtUtils::MakeMaker version 6.56
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
Modified: branches/upstream/libparse-dia-sql-perl/current/bin/parsediasql
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparse-dia-sql-perl/current/bin/parsediasql?rev=71229&op=diff
==============================================================================
--- branches/upstream/libparse-dia-sql-perl/current/bin/parsediasql (original)
+++ branches/upstream/libparse-dia-sql-perl/current/bin/parsediasql Sat Mar 12 01:46:36 2011
@@ -1,6 +1,6 @@
-#!/usr/bin/perl
+#!perl
-# $Id: parsediasql,v 1.8 2009/11/17 12:21:25 aff Exp $
+# $Id: parsediasql,v 1.10 2011/02/16 10:23:11 aff Exp $
use strict;
use warnings;
@@ -11,22 +11,32 @@
use lib q{lib};
use Parse::Dia::SQL;
-my $help = undef;
-my $file = undef;
+my $help = undef;
+my $file = undef;
my $ignore_type_mismatch = undef;
-my $db = undef;
+my $db = undef;
+my $uml = undef;
+my $loglevel = undef;
GetOptions(
- "help|?" => \$help,
- "file=s" => \$file,
- "db=s" => \$db,
- "ignore_type_mismatch" => \$ignore_type_mismatch,
+ "help|?" => \$help,
+ "file=s" => \$file,
+ "db=s" => \$db,
+ "uml" => \$uml,
+ "loglevel=s" => \$loglevel,
+ "ignore_type_mismatch" => \$ignore_type_mismatch,
) or pod2usage(2);
pod2usage(1) if $help;
pod2usage(qq{Missing argument 'file'}) if !$file;
pod2usage(qq{Missing argument 'db'}) if !$db;
-my $dia = Parse::Dia::SQL->new(file => $file, db => $db, ignore_type_mismatch => $ignore_type_mismatch);
+my $dia = Parse::Dia::SQL->new(
+ file => $file,
+ db => $db,
+ ignore_type_mismatch => $ignore_type_mismatch,
+ uml => $uml,
+ loglevel => $loglevel
+);
print $dia->get_sql();
__END__
@@ -43,10 +53,15 @@
=head1 OPTIONS
- file - filename of Dia file
- db - Database type (e.g. 'db2')
- ignore_type_mismatch - Allows foreign keys to have a different
- type than the primary key it references, if true.
+ file - Filename of Dia file
+ db - Database type (e.g. 'db2')
+ ignore_type_mismatch - Allows foreign keys to have a different
+ type than the primary key it references,
+ if true. Default false.
+ uml - Use UML interpretation of the diagram,
+ default is ERD interpretation.
+ loglevel - Log verbosity, valid values are
+ DEBUG|INFO|WARN|ERROR|FATAL|TRACE|ALL|OFF.
=head1 DESCRIPTION
Modified: branches/upstream/libparse-dia-sql-perl/current/lib/Parse/Dia/SQL.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparse-dia-sql-perl/current/lib/Parse/Dia/SQL.pm?rev=71229&op=diff
==============================================================================
--- branches/upstream/libparse-dia-sql-perl/current/lib/Parse/Dia/SQL.pm (original)
+++ branches/upstream/libparse-dia-sql-perl/current/lib/Parse/Dia/SQL.pm Sat Mar 12 01:46:36 2011
@@ -1,6 +1,6 @@
package Parse::Dia::SQL;
-# $Id: SQL.pm,v 1.52 2010/05/21 05:25:11 aff Exp $
+# $Id: SQL.pm,v 1.55 2011/02/16 10:23:11 aff Exp $
=pod
@@ -190,7 +190,7 @@
use Parse::Dia::SQL::Output::Sybase;
use Parse::Dia::SQL::Output::SQLite3;
-our $VERSION = '0.16';
+our $VERSION = '0.17';
my $UML_ASSOCIATION = 'UML - Association';
my $UML_SMALLPACKAGE = 'UML - SmallPackage';
@@ -241,6 +241,7 @@
diaversion => $param{diaversion} || undef,
ignore_type_mismatch => $param{ignore_type_mismatch} || undef,
converted => 0,
+ loglevel => $param{loglevel} || undef,
};
bless($self, $class);
@@ -264,7 +265,7 @@
# Initialize logger
sub _init_log {
my $self = shift;
- my $logger = Parse::Dia::SQL::Logger::->new();
+ my $logger = Parse::Dia::SQL::Logger::->new(loglevel => $self->{loglevel});
$self->{log} = $logger->get_logger(__PACKAGE__);
return 1;
}
@@ -282,6 +283,7 @@
$self->{utils} = Parse::Dia::SQL::Utils::->new(
db => $self->{db},
default_pk => $self->{default_pk},
+ loglevel => $self->{loglevel},
);
return 1;
}
@@ -315,7 +317,7 @@
# Add some args to param unless they are set by caller
%param =
map { $param{$_} = $self->{$_} unless exists($param{$_}); $_ => $param{$_} }
- qw(classes associations small_packages components files index_options typemap);
+ qw(classes associations small_packages components files index_options typemap loglevel);
if ($self->{db} eq q{db2}) {
return Parse::Dia::SQL::Output::DB2->new(%param);
@@ -1375,8 +1377,8 @@
# many-to-many; generate the centre (join) table, its constraints
# and the classes' primary keys (if needed)
$ok = $self->generate_many_to_many_association(
- $assocName, $leftClass, $leftEnd{'role'},
- $rightClass, $rightEnd{'role'}
+ $assocName, $leftClass, $rightEnd{'role'},
+ $rightClass, $leftEnd{'role'}
);
}
else {
@@ -1917,7 +1919,7 @@
$targetTable, $rightEnd, $constraintAction
];
- $self->{log}->debug("save_foreign_key: fk_defs is now: " . Dumper($self->{fk_defs}));
+ $self->{log}->debug("save_foreign_key: fk_defs is now: " . Dumper($self->{fk_defs})) if $self->{log}->is_debug();
return 1;
}
Modified: branches/upstream/libparse-dia-sql-perl/current/lib/Parse/Dia/SQL/Logger.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparse-dia-sql-perl/current/lib/Parse/Dia/SQL/Logger.pm?rev=71229&op=diff
==============================================================================
--- branches/upstream/libparse-dia-sql-perl/current/lib/Parse/Dia/SQL/Logger.pm (original)
+++ branches/upstream/libparse-dia-sql-perl/current/lib/Parse/Dia/SQL/Logger.pm Sat Mar 12 01:46:36 2011
@@ -1,6 +1,6 @@
package Parse::Dia::SQL::Logger;
-# $Id: Logger.pm,v 1.8 2010/04/15 20:41:00 aff Exp $
+# $Id: Logger.pm,v 1.9 2011/02/16 10:23:11 aff Exp $
=pod
@@ -11,7 +11,7 @@
=head1 SYNOPSIS
use Parse::Dia::SQL::Logger;
- my $logger = Parse::Dia::SQL::Logger::->new();
+ my $logger = Parse::Dia::SQL::Logger::->new(loglevel => 'INFO');
my $log = $logger->get_logger(__PACKAGE__);
$log->error('error');
$log->info('info');
@@ -19,14 +19,6 @@
=head1 DESCRIPTION
This module is a wrapper around Log::Log4perl.
-
-=head1 SEE ALSO
-
- Log::Log4perl
-
-Make appender_thresholds_adjust return number of appenders changed:
-
- https://rt.cpan.org/Ticket/Display.html?id=43426
=cut
@@ -49,10 +41,10 @@
my $self = {
log => undef,
+ loglevel => $param{loglevel} || undef,
};
bless( $self, $class );
-
$self->_init_log();
return $self;
}
@@ -63,34 +55,44 @@
my $self = shift;
# Init logging
- my $conf = q(
- # Main logger for Parse::Dia::SQL
-# log4perl.category.Parse::Dia::SQL = DEBUG, screen-main
- log4perl.category.Parse::Dia::SQL = INFO, screen-main
- log4perl.appender.screen-main = Log::Log4perl::Appender::Screen
- log4perl.appender.screen-main.stderr = 0
- log4perl.appender.screen-main.layout = PatternLayout
- log4perl.appender.screen-main.layout.ConversionPattern=[%p] %m%n
+ my $conf = undef;
- # Separate logger for Output::*
-# log4perl.category.Parse::Dia::SQL::Output = DEBUG, screen-output
- log4perl.category.Parse::Dia::SQL::Output = INFO, screen-output
- log4perl.appender.screen-output = Log::Log4perl::Appender::Screen
- log4perl.appender.screen-output.stderr = 1
- log4perl.appender.screen-output.layout = PatternLayout
- log4perl.appender.screen-output.layout.ConversionPattern=[%p] %m%n
- log4perl.additivity.Parse::Dia::SQL::Output = 0
+ if ($self->{loglevel}) {
+ $conf = qq(
+ # Loglevel set by user
+ log4perl.category.Parse::Dia::SQL = $self->{loglevel}, screen-main
+ log4perl.appender.screen-main = Log::Log4perl::Appender::Screen
+ log4perl.appender.screen-main.stderr = 1
+ log4perl.appender.screen-main.layout = PatternLayout
+ log4perl.appender.screen-main.layout.ConversionPattern=[%p] %m%n
+ );
+ } else {
+ # Default logging
+ $conf = q(
+ # Main logger for Parse::Dia::SQL
+ log4perl.category.Parse::Dia::SQL = INFO, screen-main
+ log4perl.appender.screen-main = Log::Log4perl::Appender::Screen
+ log4perl.appender.screen-main.stderr = 1
+ log4perl.appender.screen-main.layout = PatternLayout
+ log4perl.appender.screen-main.layout.ConversionPattern=[%p] %m%n
- # Separate logger for Utils.pm
-# log4perl.category.Parse::Dia::SQL::Utils = DEBUG, screen-utils
- log4perl.category.Parse::Dia::SQL::Utils = INFO, screen-utils
- log4perl.appender.screen-utils = Log::Log4perl::Appender::Screen
- log4perl.appender.screen-utils.stderr = 1
- log4perl.appender.screen-utils.layout = PatternLayout
- log4perl.appender.screen-utils.layout.ConversionPattern=[%p] %m%n
- log4perl.additivity.Parse::Dia::SQL::Utils = 0
+ # Separate logger for Output::*
+ log4perl.category.Parse::Dia::SQL::Output = INFO, screen-output
+ log4perl.appender.screen-output = Log::Log4perl::Appender::Screen
+ log4perl.appender.screen-output.stderr = 1
+ log4perl.appender.screen-output.layout = PatternLayout
+ log4perl.appender.screen-output.layout.ConversionPattern=[%p] %m%n
+ log4perl.additivity.Parse::Dia::SQL::Output = 0
- );
+ # Separate logger for Utils.pm
+ log4perl.category.Parse::Dia::SQL::Utils = INFO, screen-utils
+ log4perl.appender.screen-utils = Log::Log4perl::Appender::Screen
+ log4perl.appender.screen-utils.stderr = 1
+ log4perl.appender.screen-utils.layout = PatternLayout
+ log4perl.appender.screen-utils.layout.ConversionPattern=[%p] %m%n
+ log4perl.additivity.Parse::Dia::SQL::Utils = 0
+ );
+ }
Log::Log4perl::init( \$conf );
Modified: branches/upstream/libparse-dia-sql-perl/current/lib/Parse/Dia/SQL/Output.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparse-dia-sql-perl/current/lib/Parse/Dia/SQL/Output.pm?rev=71229&op=diff
==============================================================================
--- branches/upstream/libparse-dia-sql-perl/current/lib/Parse/Dia/SQL/Output.pm (original)
+++ branches/upstream/libparse-dia-sql-perl/current/lib/Parse/Dia/SQL/Output.pm Sat Mar 12 01:46:36 2011
@@ -1,6 +1,6 @@
package Parse::Dia::SQL::Output;
-# $Id: Output.pm,v 1.32 2010/05/21 05:19:36 aff Exp $
+# $Id: Output.pm,v 1.33 2011/02/16 10:23:11 aff Exp $
=pod
@@ -86,6 +86,7 @@
components => $param{components} || [], # insert statements
small_packages => $param{small_packages} || [],
typemap => $param{typemap} || {}, # custom type mapping
+ loglevel => $param{loglevel} || undef,
# references to components
log => undef,
@@ -96,7 +97,7 @@
$self->_init_log();
$self->_init_const();
- $self->_init_utils();
+ $self->_init_utils(loglevel => $param{loglevel});
return $self;
}
@@ -106,8 +107,7 @@
# Initialize logger
sub _init_log {
my $self = shift;
-
- my $logger = Parse::Dia::SQL::Logger::->new();
+ my $logger = Parse::Dia::SQL::Logger::->new(loglevel => $self->{loglevel});
$self->{log} = $logger->get_logger(__PACKAGE__);
return 1;
}
@@ -122,7 +122,10 @@
# Initialize Parse::Dia::SQL::Utils class.
sub _init_utils {
my $self = shift;
- $self->{utils} = Parse::Dia::SQL::Utils::->new(db => $self->{db});
+ $self->{utils} = Parse::Dia::SQL::Utils::->new(
+ db => $self->{db},
+ loglevel => $self->{loglevel},
+ );
return 1;
}
Modified: branches/upstream/libparse-dia-sql-perl/current/lib/Parse/Dia/SQL/Utils.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparse-dia-sql-perl/current/lib/Parse/Dia/SQL/Utils.pm?rev=71229&op=diff
==============================================================================
--- branches/upstream/libparse-dia-sql-perl/current/lib/Parse/Dia/SQL/Utils.pm (original)
+++ branches/upstream/libparse-dia-sql-perl/current/lib/Parse/Dia/SQL/Utils.pm Sat Mar 12 01:46:36 2011
@@ -1,6 +1,6 @@
package Parse::Dia::SQL::Utils;
-# $Id: Utils.pm,v 1.11 2010/01/22 19:07:18 aff Exp $
+# $Id: Utils.pm,v 1.13 2011/02/16 10:23:11 aff Exp $
=pod
@@ -89,12 +89,13 @@
log => undef,
db => $param{db} || undef,
default_pk => $param{default_pk} || undef,
+ loglevel => $param{loglevel} || undef,
};
bless($self, $class);
# init logger
- my $logger = Parse::Dia::SQL::Logger::->new();
+ my $logger = Parse::Dia::SQL::Logger::->new(loglevel => $self->{loglevel});
$self->{log} = $logger->get_logger(__PACKAGE__);
return $self;
@@ -538,7 +539,7 @@
if ( $db eq 'postgres' ) {
# handle PostgreSQL database type
- if ( lc($typeName) eq 'serial' or lc($typeName) eq 'int4' ) {
+ if ( lc($typeName) eq 'serial' or lc($typeName) eq 'int4' or lc($typeName) eq 'int') {
$self->{log}->info(qq{Replaced $typeName with integer}) if $self->{log}->is_info();
return 'integer';
}
Modified: branches/upstream/libparse-dia-sql-perl/current/t/300-parse-classes-many-to-many.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparse-dia-sql-perl/current/t/300-parse-classes-many-to-many.t?rev=71229&op=diff
==============================================================================
--- branches/upstream/libparse-dia-sql-perl/current/t/300-parse-classes-many-to-many.t (original)
+++ branches/upstream/libparse-dia-sql-perl/current/t/300-parse-classes-many-to-many.t Sat Mar 12 01:46:36 2011
@@ -1,4 +1,4 @@
-# $Id: 300-parse-classes-many-to-many.t,v 1.2 2009/02/26 13:49:07 aff Exp $
+# $Id: 300-parse-classes-many-to-many.t,v 1.3 2011/02/15 20:15:54 aff Exp $
# NOTE: This files has all the tests crammed together as opposed to
# the others that are using TestERD.dia - consider doing it more
@@ -99,7 +99,7 @@
[ 'endtime', 'timestamp', '', '0', '' ]
],
student_course =>
- [ [ 'course_id', 'int', '', 2, '' ], [ 'ssn', 'int', '', 2, '' ] ],
+ [ [ 'ssn', 'int', '', 2, '' ], [ 'course_id', 'int', '', 2, '' ] ],
);
$classes = $diasql->get_classes_ref(); # no parsing
Modified: branches/upstream/libparse-dia-sql-perl/current/t/500-get-associations.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparse-dia-sql-perl/current/t/500-get-associations.t?rev=71229&op=diff
==============================================================================
--- branches/upstream/libparse-dia-sql-perl/current/t/500-get-associations.t (original)
+++ branches/upstream/libparse-dia-sql-perl/current/t/500-get-associations.t Sat Mar 12 01:46:36 2011
@@ -1,4 +1,4 @@
-# $Id: 500-get-associations.t,v 1.3 2009/04/01 05:12:56 aff Exp $
+# $Id: 500-get-associations.t,v 1.4 2011/02/15 20:15:54 aff Exp $
use warnings;
use strict;
@@ -78,7 +78,7 @@
[
'student_course',
'stdn_crs_fk_StntSn',
- 'course_id',
+ 'ssn',
'student',
'ssn',
'on delete cascade'
@@ -86,7 +86,7 @@
[
'student_course',
'lTeT8iBKfXObJYiSrq',
- 'ssn',
+ 'course_id',
'course',
'course_id',
'on delete cascade'
@@ -94,7 +94,7 @@
];
-is_deeply( $association_many_to_many_arrayref, $expected_many_to_many );
+is_deeply( $association_many_to_many_arrayref, $expected_many_to_many, 'expected_many_to_many' );
# or diag( q{association_many_to_many_arrayref: }
# . Dumper($association_many_to_many_arrayref)
Added: branches/upstream/libparse-dia-sql-perl/current/t/621-output-get-schema-create-many-to-many-uml.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparse-dia-sql-perl/current/t/621-output-get-schema-create-many-to-many-uml.t?rev=71229&op=file
==============================================================================
--- branches/upstream/libparse-dia-sql-perl/current/t/621-output-get-schema-create-many-to-many-uml.t (added)
+++ branches/upstream/libparse-dia-sql-perl/current/t/621-output-get-schema-create-many-to-many-uml.t Sat Mar 12 01:46:36 2011
@@ -1,0 +1,70 @@
+# $Id: 621-output-get-schema-create-many-to-many-uml.t,v 1.1 2011/02/15 20:15:54 aff Exp $
+
+use warnings;
+use strict;
+
+use Data::Dumper;
+use Test::More;
+use Test::Exception;
+use File::Spec::Functions;
+use lib catdir qw ( blib lib );
+
+plan tests => 16;
+
+use lib q{lib};
+use_ok ('Parse::Dia::SQL');
+use_ok ('Parse::Dia::SQL::Output');
+use_ok ('Parse::Dia::SQL::Output::DB2');
+
+# 1. parse input
+my $diasql = Parse::Dia::SQL->new( file => catfile(qw(t data many_to_many.dia)), db => 'db2', uml => 1 );
+isa_ok($diasql, q{Parse::Dia::SQL}, q{Expect a Parse::Dia::SQL object});
+is($diasql->convert(), 1, q{Expect convert to return 1});
+
+my $classes = $diasql->get_classes_ref();
+my $associations = $diasql->get_associations_ref();
+my $smallpackages = $diasql->get_smallpackages_ref();
+
+# check parsed content
+ok(defined($classes) && ref($classes) eq q{ARRAY} && scalar(@$classes), q{Non-empty array ref});
+ok(defined($associations) && ref($associations) eq q{ARRAY} && scalar(@$associations), q{Non-empty array ref});
+
+# 2. get output instance
+my $subclass = undef;
+lives_ok(sub { $subclass = $diasql->get_output_instance(); },
+ q{get_output_instance (db2) should not die});
+
+isa_ok($subclass, 'Parse::Dia::SQL::Output')
+ or diag(Dumper($subclass));
+isa_ok($subclass, 'Parse::Dia::SQL::Output::DB2')
+ or diag(Dumper($subclass));
+can_ok($subclass, 'get_schema_create');
+
+# 3. schema
+my $schema = $subclass->get_schema_create();
+
+like($schema, qr|.*
+ create \s+ table \s+ student \s*
+.*|six, q{Check syntax for sql create table student});
+like($schema, qr|.*
+ create \s+ table \s+ course \s*
+.*|six, q{Check syntax for sql create table course});
+like($schema, qr|.*
+ create \s+ table \s+ student_course \s*
+.*|six, q{Check syntax for sql create table student_course});
+
+# 4. associations
+my $assoc = $subclass->get_associations_create();
+
+like($assoc, qr|.*
+ alter \s+ table \s+ student_course \s+ add \s+ constraint \s+ \w+ \s+
+ foreign \s+ key \s+ \(ssn\) \s+
+ references \s+ student \s+ \(ssn\) \s+ on \s+ delete \s+ cascade; \s*
+ .*|six, q{Check syntax for sql alter table add constraint rel1});
+like($assoc, qr|.*
+ alter \s+ table \s+ student_course \s+ add \s+ constraint \s+ \w+ \s+
+ foreign \s+ key \s+ \(course_id\) \s+
+ references \s+ course \s+ \(course_id\) \s+ on \s+ delete \s+ cascade; \s*
+ .*|six, q{Check syntax for sql alter table add constraint rel2});
+
+__END__
Modified: branches/upstream/libparse-dia-sql-perl/current/t/650-output-get-create-associations-many-to-many-097.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparse-dia-sql-perl/current/t/650-output-get-create-associations-many-to-many-097.t?rev=71229&op=diff
==============================================================================
--- branches/upstream/libparse-dia-sql-perl/current/t/650-output-get-create-associations-many-to-many-097.t (original)
+++ branches/upstream/libparse-dia-sql-perl/current/t/650-output-get-create-associations-many-to-many-097.t Sat Mar 12 01:46:36 2011
@@ -1,4 +1,4 @@
-# $Id: 650-output-get-create-associations-many-to-many-097.t,v 1.1 2009/10/01 18:23:55 aff Exp $
+# $Id: 650-output-get-create-associations-many-to-many-097.t,v 1.2 2011/02/15 20:15:54 aff Exp $
use warnings;
use strict;
@@ -24,23 +24,23 @@
#diag("association_m2m_arrayref: ".Dumper($association_m2m_arrayref));
my $expected_m2m = [
- [
- 'student_course',
- 'stdn_crs_fk_StntSn',
- 'course_id',
- 'student',
- 'ssn',
- 'on delete cascade'
- ],
- [
- 'student_course',
- 'lTeT8iBKfXObJYiSrq',
- 'ssn',
- 'course',
- 'course_id',
- 'on delete cascade'
- ]
- ];
+ [
+ 'student_course',
+ 'stdn_crs_fk_StntSn',
+ 'ssn',
+ 'student',
+ 'ssn',
+ 'on delete cascade'
+ ],
+ [
+ 'student_course',
+ 'lTeT8iBKfXObJYiSrq',
+ 'course_id',
+ 'course',
+ 'course_id',
+ 'on delete cascade'
+ ]
+ ];
is_deeply( $association_m2m_arrayref, $expected_m2m );
@@ -66,12 +66,12 @@
# check 2 foreign keys
like($association_str_m2m, qr/.*
- alter \s+ table \s+ student_course \s+ add \s+ constraint \s+ stdn_crs_fk_StntSn \s+ foreign \s+ key \s* \( \s* course_id \s* \) \s+ references \s+ student \s* \( \s* ssn \s* \) \s* on \s+ delete \s+ cascade
- .*/six);
+ alter \s+ table \s+ student_course \s+ add \s+ constraint \s+ stdn_crs_fk_StntSn \s+ foreign \s+ key \s* \( \s* ssn \s* \) \s+ references \s+ student \s* \( \s* ssn \s* \) \s* on \s+ delete \s+ cascade
+ .*/six);
like($association_str_m2m, qr/.*
- alter \s+ table \s+ student_course \s+ add \s+ constraint \s+ lTeT8iBKfXObJYiSrq \s+ foreign \s+ key \s* \( \s* ssn \s* \) \s* references \s+ course \s+ \s* \( \s* course_id \) \s* on \s+ delete \s+ cascade
- .*/six);
+ alter \s+ table \s+ student_course \s+ add \s+ constraint \s+ lTeT8iBKfXObJYiSrq \s+ foreign \s+ key \s* \( \s* course_id \s* \) \s* references \s+ course \s+ \s* \( \s* course_id \) \s* on \s+ delete \s+ cascade
+ .*/six);
# ------ implicit role ------
my $diasql_ir = Parse::Dia::SQL->new( file => catfile(qw(t data implicit_role.dia)), db => 'db2' );
@@ -96,10 +96,10 @@
#diag $association_str_ir;
like($association_str_ir, qr/.*
- alter \s+ table \s+ emp \s+ add \s+ constraint \s+ emp_fk_Dept_id
- \s+ foreign \s+ key \s+ \( \s* dept_id \s* \)
- \s+ references \s+ dept \s+ \( \s* id \s* \) \s+ ;
- .*/six);
+ alter \s+ table \s+ emp \s+ add \s+ constraint \s+ emp_fk_Dept_id
+ \s+ foreign \s+ key \s+ \( \s* dept_id \s* \)
+ \s+ references \s+ dept \s+ \( \s* id \s* \) \s+ ;
+ .*/six);
__END__
Modified: branches/upstream/libparse-dia-sql-perl/current/t/650-output-get-create-associations-many-to-many.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparse-dia-sql-perl/current/t/650-output-get-create-associations-many-to-many.t?rev=71229&op=diff
==============================================================================
--- branches/upstream/libparse-dia-sql-perl/current/t/650-output-get-create-associations-many-to-many.t (original)
+++ branches/upstream/libparse-dia-sql-perl/current/t/650-output-get-create-associations-many-to-many.t Sat Mar 12 01:46:36 2011
@@ -1,4 +1,4 @@
-# $Id: 650-output-get-create-associations-many-to-many.t,v 1.1 2009/10/01 18:21:04 aff Exp $
+# $Id: 650-output-get-create-associations-many-to-many.t,v 1.2 2011/02/15 20:15:54 aff Exp $
use warnings;
use strict;
@@ -24,23 +24,23 @@
#diag("association_m2m_arrayref: ".Dumper($association_m2m_arrayref));
my $expected_m2m = [
- [
- 'student_course',
- 'stdn_crs_fk_StntSn',
- 'course_id',
- 'student',
- 'ssn',
- 'on delete cascade'
- ],
- [
- 'student_course',
- 'lTeT8iBKfXObJYiSrq',
- 'ssn',
- 'course',
- 'course_id',
- 'on delete cascade'
- ]
- ];
+ [
+ 'student_course',
+ 'stdn_crs_fk_StntSn',
+ 'ssn',
+ 'student',
+ 'ssn',
+ 'on delete cascade'
+ ],
+ [
+ 'student_course',
+ 'lTeT8iBKfXObJYiSrq',
+ 'course_id',
+ 'course',
+ 'course_id',
+ 'on delete cascade'
+ ]
+ ];
is_deeply( $association_m2m_arrayref, $expected_m2m );
@@ -66,12 +66,12 @@
# check 2 foreign keys
like($association_str_m2m, qr/.*
- alter \s+ table \s+ student_course \s+ add \s+ constraint \s+ stdn_crs_fk_StntSn \s+ foreign \s+ key \s* \( \s* course_id \s* \) \s+ references \s+ student \s* \( \s* ssn \s* \) \s* on \s+ delete \s+ cascade
- .*/six);
+ alter \s+ table \s+ student_course \s+ add \s+ constraint \s+ stdn_crs_fk_StntSn \s+ foreign \s+ key \s* \( \s* ssn \s* \) \s+ references \s+ student \s* \( \s* ssn \s* \) \s* on \s+ delete \s+ cascade
+ .*/six);
like($association_str_m2m, qr/.*
- alter \s+ table \s+ student_course \s+ add \s+ constraint \s+ lTeT8iBKfXObJYiSrq \s+ foreign \s+ key \s* \( \s* ssn \s* \) \s* references \s+ course \s+ \s* \( \s* course_id \) \s* on \s+ delete \s+ cascade
- .*/six);
+ alter \s+ table \s+ student_course \s+ add \s+ constraint \s+ lTeT8iBKfXObJYiSrq \s+ foreign \s+ key \s* \( \s* course_id \s* \) \s* references \s+ course \s+ \s* \( \s* course_id \) \s* on \s+ delete \s+ cascade
+ .*/six);
# ------ implicit role ------
my $diasql_ir = Parse::Dia::SQL->new( file => catfile(qw(t data implicit_role.dia)), db => 'db2' );
@@ -96,10 +96,10 @@
#diag $association_str_ir;
like($association_str_ir, qr/.*
- alter \s+ table \s+ emp \s+ add \s+ constraint \s+ emp_fk_Dept_id
- \s+ foreign \s+ key \s+ \( \s* dept_id \s* \)
- \s+ references \s+ dept \s+ \( \s* id \s* \) \s+ ;
- .*/six);
+ alter \s+ table \s+ emp \s+ add \s+ constraint \s+ emp_fk_Dept_id
+ \s+ foreign \s+ key \s+ \( \s* dept_id \s* \)
+ \s+ references \s+ dept \s+ \( \s* id \s* \) \s+ ;
+ .*/six);
__END__
Modified: branches/upstream/libparse-dia-sql-perl/current/t/961-rt57182-charset.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparse-dia-sql-perl/current/t/961-rt57182-charset.t?rev=71229&op=diff
==============================================================================
--- branches/upstream/libparse-dia-sql-perl/current/t/961-rt57182-charset.t (original)
+++ branches/upstream/libparse-dia-sql-perl/current/t/961-rt57182-charset.t Sat Mar 12 01:46:36 2011
@@ -1,5 +1,5 @@
-# $Id: 960-rt56357-database-model.t,v 1.2 2010/04/10 12:58:16 aff Exp $
+# $Id: 961-rt57182-charset.t,v 1.2 2011/02/15 20:15:54 aff Exp $
use warnings;
use strict;
Added: branches/upstream/libparse-dia-sql-perl/current/t/962-rt57842-postsgres-int.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparse-dia-sql-perl/current/t/962-rt57842-postsgres-int.t?rev=71229&op=file
==============================================================================
--- branches/upstream/libparse-dia-sql-perl/current/t/962-rt57842-postsgres-int.t (added)
+++ branches/upstream/libparse-dia-sql-perl/current/t/962-rt57842-postsgres-int.t Sat Mar 12 01:46:36 2011
@@ -1,0 +1,53 @@
+
+# $Id: 962-rt57842-postsgres-int.t,v 1.1 2010/05/27 09:21:47 aff Exp $
+
+use warnings;
+use strict;
+
+use locale;
+use Data::Dumper;
+use Test::More;
+use Test::Exception;
+use File::Spec::Functions;
+use lib catdir qw ( blib lib );
+
+plan tests => 6;
+
+use lib q{lib};
+use_ok ('Parse::Dia::SQL');
+
+my $diasql =
+ Parse::Dia::SQL->new(file => catfile(qw(t data rt57842.dia)), db => 'postgres');
+isa_ok($diasql, q{Parse::Dia::SQL}, q{Expect a Parse::Dia::SQL object});
+can_ok($diasql, q{get_sql});
+
+my $sql = undef;
+lives_ok(
+ sub { $sql = $diasql->get_sql() },
+ q{get_sql should live on supported model type 'Database - Table'}
+ );
+
+
+my $outputter = $diasql->get_output_instance();
+can_ok($outputter, q{get_associations_create});
+
+my $association_str = $outputter->get_associations_create();
+
+like($association_str, qr|.*
+alter \s+ table \s+ sales \s+ add \s+ constraint \s+ sales_fk_User_id \s+
+ foreign \s+ key \s* \( \s* user_id \s* \) \s+
+ references \s+ users \s* \( \s* user_id \s* \) .*
+|six, q{Expect constraint on sales});
+
+
+__END__
+
+
+=pod
+
+=head1 DESCRIPTION
+
+ https://rt.cpan.org/Public/Bug/Display.html?id=57182
+
+=cut
+
Added: branches/upstream/libparse-dia-sql-perl/current/t/data/rt57842.dia
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libparse-dia-sql-perl/current/t/data/rt57842.dia?rev=71229&op=file
==============================================================================
Binary file - no diff available.
Propchange: branches/upstream/libparse-dia-sql-perl/current/t/data/rt57842.dia
------------------------------------------------------------------------------
svn:mime-type = application/octet-stream
More information about the Pkg-perl-cvs-commits
mailing list