Parse-Dia-SQL
view release on metacpan or search on metacpan
checks for each XML element containing it.
First reported in bug #47040: Associations are
not generated in Dia 0.97
0.10 Sat May 16 21:03:57 CEST 2009
- Use recent (6.50) EU::MM in build to get LICENCE
MIN_PERL_VERSION, META_MERGE correctly set.
0.09 Sat May 16 15:29:28 CEST 2009
- SQLite3: Fixed a bug in the update constraint trigger
- SQLite3: Added 'on delete cascade' support
- Added support for index options, which are modelled as
a comment on the operation (index).
- Fixed bug: Missing associations should bot prevent
index creation.
0.08 Tue Apr 14 14:12:00 CEST 2009
- Bugfix in Utils.pm (sqlite -> sqlite3).
- Updated Makefile.PL with META_MERGE and LICENSE.
- Added MANIFEST.SKIP
- Removed TODO in boilerplate test.
lib/Parse/Dia/SQL.pm view on Meta::CPAN
# generate the constraint code:
# foreign key -> referenced attribute
$self->{log}->debug("Call save_foreign_key (left to right)");
$self->save_foreign_key(
$assocName, ## From table
$leftFKName, ## name of foreign key constraint
$leftFKCols, ## foreign key column in assoc tbl
$leftClassLookup->{name}, ## Table referenced
$leftEndCols, ## Column in table referenced
'on delete cascade' ## Trash when no longer referenced
);
# generate the constraint code:
# referenced attribute <- foreign key
$self->{log}->debug("Call save_foreign_key (right to left)");
$self->save_foreign_key($assocName, $rightFKName, $rightFKCols,
$rightClassLookup->{name},
$rightEndCols, 'on delete cascade');
return 1;
}
# Create datastructure that represents given Table or View SQL and
# store in classes reference.
sub gen_table_view_sql {
my $self = shift;
my $objectName = shift;
my $objectType = shift;
lib/Parse/Dia/SQL.pm view on Meta::CPAN
# non-zero; 1 = aggregation, 2 = composition.
my $aggregation = $pkEnd->{'aggregate'} + $fkEnd->{'aggregate'};
if ( $aggregation == 0 ) { # No semantics specified
$constraintAction = '';
}
elsif ( $aggregation == 1 ) { # Aggregation
$constraintAction = 'on delete set NULL';
$defFKnull = 'null';
}
elsif ( $aggregation == 2 ) { # Composition
$constraintAction = 'on delete cascade';
}
}
else {
# ERD interpretation
# If Utils::classify_multiplicity didn't understand the multiplicity
# field, then assume it's a constraint action, and set the
# multiplicity classification to 'none'
lib/Parse/Dia/SQL.pm view on Meta::CPAN
}
# If the constraint action is 'on delete set null', then
# allow the FK to have null value
if ( $constraintAction =~ /on\s+delete\s+set\s+null/i ) {
$defFKnull = 'null';
}
# tedia2sql v1.2.9b usage of 'on delete clause'
# The 'on cascade delete' clauses were on opposite ends of
# the association for one-to-many and one-to-one for ERD mode!
# if ($arity eq 'zmany' && $fkMult eq 'undef') {
# $constraintAction = $fkEnd->{'multiplicity'};
# $fkMult = 'none';
# } elsif ($arity eq 'zone' && $pkMult eq 'undef') {
# $constraintAction = $pkEnd->{'multiplicity'};
# $pkMult = 'none';
# }
}
lib/Parse/Dia/SQL/Output/HTML.pm view on Meta::CPAN
I<Default>: B<refto> <p>References: {reftolist}</p>
=head3 refbyitem, reftoitem
A single item in the reference by list
I<Placeholders>: tablename, key, fk, action, refname
Here I<tablename> is the other table, I<key> is the field in this table, I<fk> is the field in the other table,
I<action> in the action on update/delete (such as cascade or update) and I<refname> is the name of the constraint.
I<Default>: <a href='#{tablename}'>{tablename}</a>
=head3 refbysep, reftosep
Separator between references.
I<Default>: C<, >
lib/Parse/Dia/SQL/Output/Oracle.pm view on Meta::CPAN
}
=head2 _get_drop_index_sql
Create drop index sql for given index. Discard tablename.
=cut
sub _get_drop_index_sql {
my ( $self, $tablename, $indexname ) = @_;
return qq{drop index $indexname cascade constraints}
. $self->{end_of_statement}
. $self->{newline};
}
=head2 _get_drop_schema_sql
Oracle do not support keyword 'if exists' in 'drop table' statement
=cut
lib/Parse/Dia/SQL/Output/Postgres.pm view on Meta::CPAN
=head2 _get_drop_index_sql
Create drop index sql for given index. Discard tablename.
(same as sas)
=cut
sub _get_drop_index_sql {
my ( $self, $tablename, $indexname ) = @_;
return qq{drop index $indexname cascade}
. $self->{end_of_statement}
. $self->{newline};
}
1;
__END__
lib/Parse/Dia/SQL/Output/SQLite3.pm view on Meta::CPAN
. $self->{newline};
$temp = $constraint_name . "_bu_tr";
$sqlstr .=
qq{create trigger $temp before update on $table_name for each row begin select raise(abort, 'update on table $table_name violates foreign key constraint $constraint_name') where new.$key_column is not null and (select $ref_column from $ref_table wher...
. $self->{end_of_statement}
. $self->{newline};
# note that the before delete triggers are on the parent ($ref_table)
$temp = $constraint_name . "_bdparent_tr";
if ( $constraint_action =~ /on delete cascade/i ) {
$sqlstr .=
qq{create trigger $temp before delete on $ref_table for each row begin delete from $table_name where $table_name.$key_column=old.$ref_column;end}
. $self->{end_of_statement}
. $self->{newline};
} elsif ( $constraint_action =~ /on delete set null/i ) {
$sqlstr .=
qq{create trigger $temp before delete on $ref_table for each row begin update $table_name set $key_column=null where $table_name.$key_column=old.$ref_column;end}
. $self->{end_of_statement}
. $self->{newline};
} else # default on delete restrict
lib/Parse/Dia/SQL/Output/SQLite3fk.pm view on Meta::CPAN
syntax:
Includes class comments before the table definition.
Includes autoupdate triggers based on the class comment.
Includes foreign key support of the form
foreign key(thisColumn) references thatTable(thatColumn) {action}
Where {action} is the optional contraint condition, such as 'on delete cascade' exactly as entered in the diagram.
=head3 autoupdate triggers
If the class comment includes a line like:
<autoupdate:I<foo>/>
Then an 'after update' trigger is generated for this table which
executes the statement I<foo> for the updated row.
t/500-get-associations.t view on Meta::CPAN
my $association_arrayref = $diasql->get_associations_ref();
#diag(Dumper($association_arrayref));
my $expected = [
[ 'subImageInfo', 'fk_iisii', 'imageInfo_id', 'imageInfo', 'id', '' ],
[ 'imageCategoryList', 'fk_iiicl', 'imageInfo_id', 'imageInfo', 'id', '' ],
[ 'imageAttribute', 'fk_iiia', 'imageInfo_id', 'imageInfo', 'id', '' ],
[
'userImageRating', 'fk_uiuir',
'userInfo_id', 'userInfo',
'id', 'on delete cascade'
],
[
'userAttribute', 'fk_uiua',
'userInfo_id', 'userInfo',
'id', 'on delete cascade'
],
[
'userSession', 'fk_uius', 'userInfo_id', 'userInfo',
'id', 'on delete cascade'
],
[
'imageAttribute', 'fk_iaac',
'attributeCategory_id', 'attributeCategory',
'id', ''
],
[
'userAttribute', 'fk_acua',
'attributeCategory_id', 'attributeCategory',
'id', ''
t/500-get-associations.t view on Meta::CPAN
my $association_many_to_many_arrayref = $diasql_many_to_many->get_associations_ref();
#diag("association_many_to_many_arrayref: ".Dumper($association_many_to_many_arrayref));
my $expected_many_to_many = [
[
'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_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)
# . q{ expected }
# . Dumper($expected_many_to_many) );
t/621-output-get-schema-create-many-to-many-uml.t view on Meta::CPAN
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__
t/650-output-get-create-associations-many-to-many-097.t view on Meta::CPAN
my $association_m2m_arrayref = $diasql_m2m->get_associations_ref();
#diag("association_m2m_arrayref: ".Dumper($association_m2m_arrayref));
my $expected_m2m = [
[
'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 );
# or diag( q{association_m2m_arrayref: }
# . Dumper($association_m2m_arrayref)
# . q{ expected }
# . Dumper($expected_m2m) );
t/650-output-get-create-associations-many-to-many-097.t view on Meta::CPAN
isa_ok($output_m2m, 'Parse::Dia::SQL::Output::DB2')
or diag(Dumper($output_m2m));
can_ok($output_m2m, 'get_associations_create');
# associations = foreign keys + indices
my $association_str_m2m = $output_m2m->get_associations_create();
# 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* 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* 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' );
isa_ok($diasql_ir, q{Parse::Dia::SQL}, q{Expect a Parse::Dia::SQL object});
ok $diasql_ir->convert();
my $output_ir = undef;
isa_ok($diasql_ir, 'Parse::Dia::SQL');
t/650-output-get-create-associations-many-to-many.t view on Meta::CPAN
my $association_m2m_arrayref = $diasql_m2m->get_associations_ref();
#diag("association_m2m_arrayref: ".Dumper($association_m2m_arrayref));
my $expected_m2m = [
[
'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 );
# or diag( q{association_m2m_arrayref: }
# . Dumper($association_m2m_arrayref)
# . q{ expected }
# . Dumper($expected_m2m) );
t/650-output-get-create-associations-many-to-many.t view on Meta::CPAN
isa_ok($output_m2m, 'Parse::Dia::SQL::Output::DB2')
or diag(Dumper($output_m2m));
can_ok($output_m2m, 'get_associations_create');
# associations = foreign keys + indices
my $association_str_m2m = $output_m2m->get_associations_create();
# 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* 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* 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' );
isa_ok($diasql_ir, q{Parse::Dia::SQL}, q{Expect a Parse::Dia::SQL object});
ok $diasql_ir->convert();
my $output_ir = undef;
isa_ok($diasql_ir, 'Parse::Dia::SQL');
t/651-output-get-create-associations-sybase.t view on Meta::CPAN
my $association_m2m_arrayref = $diasql_m2m->get_associations_ref();
#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'
]
];
is_deeply( $association_m2m_arrayref, $expected_m2m );
# or diag( q{association_m2m_arrayref: }
# . Dumper($association_m2m_arrayref)
# . q{ expected }
# . Dumper($expected_m2m) );
t/651-output-get-create-associations-sybase.t view on Meta::CPAN
isa_ok($output_m2m, 'Parse::Dia::SQL::Output::Sybase')
or diag(Dumper($output_m2m));
can_ok($output_m2m, 'get_associations_create');
# associations = foreign keys + indices
my $association_str_m2m = $output_m2m->get_associations_create();
# 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);
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);
__END__
( run in 1.420 second using v1.01-cache-2.11-cpan-49f99fa48dc )