[dbsrgits/SQL-Translator.git] / lib / SQL / Translator / Parser / XML / XMI / SQLFairy.pm

package SQL::Translator::Parser::XML::XMI::SQLFairy;

# -------------------------------------------------------------------
# $Id$
# -------------------------------------------------------------------
# Copyright (C) 2003 Mark Addison <mark.addison@itn.co.uk>,
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; version 2.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
# 02111-1307  USA
# -------------------------------------------------------------------

=head1 NAME

SQL::Translator::Parser::XML::XMI::SQLFairy - Create Schema from UML Models.

=cut

use strict;

use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
$VERSION = sprintf "%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/;
$DEBUG   = 0 unless defined $DEBUG;
use Exporter;
use base qw(Exporter);
@EXPORT_OK = qw(parse);

use Data::Dumper;
use SQL::Translator::Parser::XML::XMI;
use SQL::Translator::Utils 'debug';

# Globals for the subs to use, set in parse() and classes2schema()
#
# TODO Should we be giving classes2schema the schema or should they use their
# parse() to get it. Obj parsers maybe?
#our ($schema,$pargs);
use vars qw[ $schema $pargs ];

# Set the parg for the conversion sub then use the XMI parser
sub parse {
    my ( $translator ) = @_;
    local $DEBUG  = $translator->debug;
    local $pargs  = $translator->parser_args;
    #local $schema = $translator->schema;
	$pargs->{classes2schema} = \&classes2schema;
    $pargs->{derive_pkey} ||= "stereotype,auto,first";
    $pargs->{auto_pkey} ||= {
        name => sub {
            my $class = shift;
            $class->{name}."ID";
        },
        data_type => "INT",
        size => 10,
        is_nullable => 0,
        is_auto_increment => 1,
    };

    return SQL::Translator::Parser::XML::XMI::parse(@_);
}


# TODO We could make the tag names a parser arg so people can use their own.
my %TAGS;
$TAGS{data_type} = "sqlfDataType";
$TAGS{size} = "sqlfSize";
$TAGS{is_nullable} = "sqlfIsNullable";
$TAGS{required} = "sqlfRequired";
$TAGS{is_auto_increment} = "sqlfIsAutoIncrement";
$TAGS{default_value} = "sqlfDefaultValue";

sub _parameters_in {
	my $params = shift;
	return grep {$_->{kind} ne "return"} @$params;
}

sub _resolve_tag {
    my ($tag, $things) = @_;
    foreach (@$things) {
        return $_->{_map_taggedValues}{$tag}{dataValue}
        if exists $_->{_map_taggedValues}{$tag}{dataValue}; 
    }
    return;
}


sub classes2schema {
    local $schema = shift;
	my $classes = shift;

    #
    # Create tablles from Classes and collect their associations
    #
    my %associations;
	foreach my $class (@$classes) {
		# Add the table
        debug "Adding class: $class->{name}";
        my $table = $schema->add_table( name => $class->{name} )
            or die "Schema Error: ".$schema->error;

        # Only collect the associations for classes that are tables. Use a hash
        # so we only get them once
        $associations{$_->{"xmi.id"}} = $_
        foreach map $_->{association}, @{$class->{associationEnds}};

        #
        # Fields from Class attributes
        #
        my @flds;
        push @flds, attr2field($_) for @{$class->{attributes}};
            # TODO Filter this e.g no abstract attr or stereotype check
        foreach (@flds) {
            my $extra = delete $_->{extra};
            my $field = $table->add_field( %$_ ) or die $schema->error;
            $field->extra(%$extra) if $extra;
        }

        # Add a pkey
        add_pkey($class,$table);
    }

    #
    # Relationships from Associations
    #
    foreach my $assoc (values %associations) {
        my @end = @{$assoc->{associationEnds}};
        if (
            $end[0]->{multiplicity}{rangeUpper} == 1
            && $end[1]->{multiplicity}{rangeUpper} == 1
        ) {
            # 1:1 or 0:1
            warn "Sorry, 1:1 associations not yet implimented for xmi.id=".$assoc->{"xmi.id"}."\n";
        }
        elsif (
            $end[0]->{multiplicity}{rangeUpper} == 1
            || $end[1]->{multiplicity}{rangeUpper} == 1
        ) {
            one2many($assoc);
        }
        else
        {
            many2many($assoc);
        }

    }

}

# Take an attribute and return the field data for it
sub attr2field {
    my $attr = shift;
    my $dataType = $attr->{dataType};

    my %data = ( name => $attr->{name} );

    $data{data_type}
        = _resolve_tag($TAGS{data_type},[$attr,$dataType])
        || $dataType->{name};

    $data{size} = _resolve_tag($TAGS{size},[$attr,$dataType]);

    $data{default_value} 
        = _resolve_tag($TAGS{default_value},[$attr,$dataType])
        || $attr->{initialValue};

    my $is_nullable = _resolve_tag($TAGS{is_nullable},[$attr,$dataType]);
    my $required    = _resolve_tag($TAGS{required},[$attr,$dataType]);
    $data{is_nullable} 
        = defined $is_nullable ? $is_nullable 
        : ( defined $required ? ($required ? 0 : 1) : undef);

    $data{is_auto_increment}
        =  $attr->{_map_taggedValues}{$TAGS{is_auto_increment}}{dataValue}
        || $dataType->{_map_taggedValues}{$TAGS{is_auto_increment}}{dataValue}
        || undef;

    #
    # Extras
    # 
    my %tagnames;
    foreach ( keys %{$attr->{_map_taggedValues}} ) {$tagnames{$_}++; }
    delete @tagnames{@TAGS{qw/data_type size default_value is_nullable required is_auto_increment/}}; # Remove the tags we have already done
    my %extra = map { 
        my $val = $attr->{_map_taggedValues}{$_}{dataValue};
        s/^sqlf//;
        ($_,$val);
    } keys %tagnames;
    $data{extra} = \%extra;

    return \%data;
}

# Add a pkey to a table for the class
sub add_pkey {
    my ($class,$table) = @_;

    my @pkeys;
    foreach ( split(",", $pargs->{derive_pkey}) ) {
        if ( $_ eq "stereotype" ) {
            @pkeys = map $_->{name},
            grep($_->{stereotype} eq "PK", @{$class->{attributes}});
        }
        elsif( $_ eq "first" ) {
            @pkeys = $class->{attributes}[0]{name} unless @pkeys;
        }
        elsif( $_ eq "auto" ) {
            if ( my %data = %{$pargs->{auto_pkey}} ) {
                $data{name} = $data{name}->($class,$table);
                my $field = $table->add_field(%data) or die $table->error;
                @pkeys = $field->name;
            }
        }
        last if @pkeys;
    }

    $table->add_constraint(
        type   => "PRIMARY KEY",
        fields => [@pkeys],
    ) or die $table->error;
}

# Maps a 1:M association into the schema
sub one2many
{
    my ($assoc) = @_;
    my @ends = @{$assoc->{associationEnds}};
    my ($end1) = grep $_->{multiplicity}{rangeUpper} == 1, @ends;
    my $endm = $end1->{otherEnd};
    my $table1 = $schema->get_table($end1->{participant}{name});
    my $tablem = $schema->get_table($endm->{participant}{name});

    #
    # Export 1end pkey to many end
    #
    my $con  = $table1->primary_key;
    my @flds = $con->fields;
    foreach (@flds) {
        my $fld = $table1->get_field($_);
        my %data;
        $data{$_} = $fld->$_()
        foreach (qw/name size data_type default_value is_nullable/);
        $data{extra} = { $fld->extra }; # Copy extra hash
        $data{is_unique} = 0; # FKey on many join so not unique
        $data{is_nullable} = $end1->{multiplicity}{rangeLower} == 0 ? 1 : 0;
            # 0:m - allow nulluable on fkey
            # 1:m - dont allow nullable

        $tablem->add_field(%data) or die $tablem->error;
        # Export the pkey if full composite (ie identity) relationship
        $tablem->primary_key($_) if $end1->{aggregation} eq "composite";
    }

    #
    # Add fkey constraint to many end
    # 
    $tablem->add_constraint(
        type   => "FOREIGN_KEY",
        fields => [@flds],
        reference_table => $table1->{name},
        reference_fields => [@flds],
    ) or die $schema->error;
}

# Maps m:n into schema by building a link table.
sub many2many
{
    my ($assoc) = @_;
    my @end = @{$assoc->{associationEnds}};

    # Create the link table
    my $name = $end[0]->{participant}{name}."_".$end[1]->{participant}{name};
    my $link_table = $schema->add_table( name => $name )
    or die "Schema Error: ".$schema->error;

    # Export the pkey(s) from the ends into the link table
    my @pkeys;
    foreach (@end) {
        my $table = $schema->get_table($_->{participant}{name});
        my @fkeys = $table->primary_key->fields;
        push @pkeys,@fkeys;
        foreach ( @fkeys ) {
            my $fld = $table->get_field($_);
            my %data;
            $data{$_} = $fld->$_()
                foreach (
                qw/name size data_type default_value is_nullable is_unique/);
            $data{is_auto_increment} = 0;
            $data{extra} = { $fld->extra }; # Copy
            $link_table->add_field(%data) or die $table->error;
        }
        $link_table->add_constraint(
            type   => "FOREIGN_KEY",
            fields => [@fkeys],
            reference_table => $table->{name},
            reference_fields => [@fkeys],
        ) or die $schema->error;

    }
    # Add pkey constraint
    $link_table->add_constraint( type => "PRIMARY KEY", fields => [@pkeys] )
    or die $link_table->error;


    # Add fkeys to our participants
}
1; #---------------------------------------------------------------------------

__END__

=pod

=head1 SYNOPSIS

  use SQL::Translator;
  use SQL::Translator::Parser::XML::XMI;

  my $translator     = SQL::Translator->new(
      from           => 'XML-XMI-SQLFairy',
      to             => 'MySQL',
      filename       => 'schema.xmi',
  );

  print $obj->translate;

=head1 DESCRIPTION

Converts Class diagrams to Schema trying to use standard UML features as much
as possible, with the minimum use of extension mechanisms (tagged values and
stereotypes) for the database details. The idea is to treat the object model 
like a logical database model and map that to a physical model (the sql). Also
tries to make this mapping as configurable as possible and support all the
schema features of SQLFairy.

=head2 Tables

Classes, all of them! (TODO More control over which tables to do.)

=head2 Fields

The attributes of the class will be converted to fields of the same name.

=head3 Datatypes

Database datatypes are modeled using tagged values; sqlfDataType,
sqlfSize, sqlfIsNullable and sqlfIsAutoIncrement added to the attribute.
The default value is the UML initial value of the attribute or can be overridden
using a sqlfDefaultValue tagged value if you want to have a different default
in the database then the object uses.

For more advanced datatype modeling you can use UML data types by adding the
tagged values to the UML data types in your model and then giving your
attributes those datatypes. Any tagged values set on attributes will override
any they get from their datatype. This allows you to use UML datatypes like
domains.  If no sqlfDataType is given then the name of the UMLDataType is used.

=head3 Primary Keys

If no attribute is marked explicity on the Class as a pkey then one is added.
The default is an INT(10) auto number named after the class with ID on the end.
For many cases this is enough as you don't normally need to model pkeys
explicitly in your object models as its a database thing.

The pkey created can be controlled by setting the C<auto_pkey> parser arg to a
hash ref describing the field. The name key is a sub that gets given a ref to
the class (from the xmi) and the table it has been mapped to, and should return the pkey name. e.g. the defualt looks like;

 {
     name => sub {
         my $class = shift;
         $class->{name}."ID";
     },
     data_type => "INT",
     size => 10,
     is_nullable => 0,
     is_auto_increment => 1,
 }

NB You need to return a unique name for the key if it will be used to build
relationships as it will be exported to other tables (see Relationships).

You can also set them explicitly by marking attributes with a <<PK>> stereotype.
Add to multiple attribs to make multi column keys. Usefull when your object
contains an attribute that makes a good candidate for a pkey, e.g. email.

=head2 Relationships

=head2 1:m

Associations where one ends multiplicty is '1' or '0..1' and the other end's
multplicity is more than 1 e.g '*', '0..*', '1..*', '0..3', '4..42' etc.

The pkey field from the 1 end is added to the table for the class at the many
end as a foreign key with is_unique and auto number turned off.

If the 1 end is multiplicity '0..1' (ie a 0:m join) then the the fkey is made
nullable, if its multiplicity '1' (1:m) then its made not nullable.

If the association is a composition then the created fkey is made part of the
many ends pkey. ie It exports the pkey to create an identity join.

=head2 m:n

Model using a standard m:n association and the parser will automatically create
a link table for you in the Schema by exporting pkeys from the tables at 
each end.

=head1 EXAMPLE

TODO An example to help make sense of the above! Probably based on the test.

=head1 ARGS

=head1 BUGS

=head1 TODO

1:1 joins.

Use Role names from associations as field names for exported keys when building
relationships.

Generalizations.

Support for the format_X_name subs in the Translator and format subs for 
generating the link table name in m:n joins.

Lots more...

=head1 AUTHOR

Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.

=head1 SEE ALSO

perl(1), SQL::Translator::Parser::XML::XMI

=cut
Commit	Line	Data
55e462b4	1	package SQL::Translator::Parser::XML::XMI::SQLFairy;
	2
	3	# -------------------------------------------------------------------
821a0fde	4	# $Id$
55e462b4	5	# -------------------------------------------------------------------
	6	# Copyright (C) 2003 Mark Addison <mark.addison@itn.co.uk>,
	7	#
	8	# This program is free software; you can redistribute it and/or
	9	# modify it under the terms of the GNU General Public License as
	10	# published by the Free Software Foundation; version 2.
	11	#
	12	# This program is distributed in the hope that it will be useful, but
	13	# WITHOUT ANY WARRANTY; without even the implied warranty of
	14	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
	15	# General Public License for more details.
	16	#
	17	# You should have received a copy of the GNU General Public License
	18	# along with this program; if not, write to the Free Software
	19	# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
	20	# 02111-1307 USA
	21	# -------------------------------------------------------------------
	22
	23	=head1 NAME
	24
	25	SQL::Translator::Parser::XML::XMI::SQLFairy - Create Schema from UML Models.
	26
	27	=cut
	28
	29	use strict;
	30
	31	use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
821a0fde	32	$VERSION = sprintf "%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/;
55e462b4	33	$DEBUG = 0 unless defined $DEBUG;
	34	use Exporter;
	35	use base qw(Exporter);
	36	@EXPORT_OK = qw(parse);
	37
	38	use Data::Dumper;
	39	use SQL::Translator::Parser::XML::XMI;
	40	use SQL::Translator::Utils 'debug';
	41
f992cfaa	42	# Globals for the subs to use, set in parse() and classes2schema()
	43	#
	44	# TODO Should we be giving classes2schema the schema or should they use their
	45	# parse() to get it. Obj parsers maybe?
	46	#our ($schema,$pargs);
	47	use vars qw[ $schema $pargs ];
	48
55e462b4	49	# Set the parg for the conversion sub then use the XMI parser
	50	sub parse {
	51	my ( $translator ) = @_;
	52	local $DEBUG = $translator->debug;
f992cfaa	53	local $pargs = $translator->parser_args;
f992cfaa	54	#local $schema = $translator->schema;
55e462b4	55	$pargs->{classes2schema} = \&classes2schema;
f992cfaa	56	$pargs->{derive_pkey} \|\|= "stereotype,auto,first";
	57	$pargs->{auto_pkey} \|\|= {
	58	name => sub {
	59	my $class = shift;
	60	$class->{name}."ID";
	61	},
	62	data_type => "INT",
	63	size => 10,
	64	is_nullable => 0,
	65	is_auto_increment => 1,
	66	};
	67
	68	return SQL::Translator::Parser::XML::XMI::parse(@_);
55e462b4	69	}
	70
	71
	72
	73	# TODO We could make the tag names a parser arg so people can use their own.
	74	my %TAGS;
	75	$TAGS{data_type} = "sqlfDataType";
	76	$TAGS{size} = "sqlfSize";
	77	$TAGS{is_nullable} = "sqlfIsNullable";
	78	$TAGS{required} = "sqlfRequired";
	79	$TAGS{is_auto_increment} = "sqlfIsAutoIncrement";
	80	$TAGS{default_value} = "sqlfDefaultValue";
	81
	82	sub _parameters_in {
	83	my $params = shift;
	84	return grep {$_->{kind} ne "return"} @$params;
	85	}
	86
	87	sub _resolve_tag {
	88	my ($tag, $things) = @_;
	89	foreach (@$things) {
	90	return $_->{_map_taggedValues}{$tag}{dataValue}
	91	if exists $_->{_map_taggedValues}{$tag}{dataValue};
	92	}
	93	return;
	94	}
	95
	96
	97	sub classes2schema {
f992cfaa	98	local $schema = shift;
f992cfaa	99	my $classes = shift;
55e462b4	100
f992cfaa	101	#
	102	# Create tablles from Classes and collect their associations
	103	#
55e462b4	104	my %associations;
	105	foreach my $class (@$classes) {
	106	# Add the table
	107	debug "Adding class: $class->{name}";
	108	my $table = $schema->add_table( name => $class->{name} )
	109	or die "Schema Error: ".$schema->error;
	110
	111	# Only collect the associations for classes that are tables. Use a hash
	112	# so we only get them once
	113	$associations{$_->{"xmi.id"}} = $_
	114	foreach map $_->{association}, @{$class->{associationEnds}};
	115
	116	#
	117	# Fields from Class attributes
	118	#
	119	my @flds;
	120	push @flds, attr2field($_) for @{$class->{attributes}};
	121	# TODO Filter this e.g no abstract attr or stereotype check
	122	foreach (@flds) {
	123	my $extra = delete $_->{extra};
	124	my $field = $table->add_field( %$_ ) or die $schema->error;
	125	$field->extra(%$extra) if $extra;
	126	}
	127
f992cfaa	128	# Add a pkey
f992cfaa	129	add_pkey($class,$table);
55e462b4	130	}
	131
	132	#
	133	# Relationships from Associations
	134	#
	135	foreach my $assoc (values %associations) {
	136	my @end = @{$assoc->{associationEnds}};
	137	if (
f992cfaa	138	$end[0]->{multiplicity}{rangeUpper} == 1
f992cfaa	139	&& $end[1]->{multiplicity}{rangeUpper} == 1
55e462b4	140	) {
55e462b4	141	# 1:1 or 0:1
f992cfaa	142	warn "Sorry, 1:1 associations not yet implimented for xmi.id=".$assoc->{"xmi.id"}."\n";
55e462b4	143	}
55e462b4	144	elsif (
f992cfaa	145	$end[0]->{multiplicity}{rangeUpper} == 1
f992cfaa	146	\|\| $end[1]->{multiplicity}{rangeUpper} == 1
55e462b4	147	) {
f992cfaa	148	one2many($assoc);
55e462b4	149	}
	150	else
	151	{
ae15bb99	152	many2many($assoc);
55e462b4	153	}
55e462b4	154
f992cfaa	155	}
55e462b4	156
	157	}
	158
f992cfaa	159	# Take an attribute and return the field data for it
55e462b4	160	sub attr2field {
	161	my $attr = shift;
	162	my $dataType = $attr->{dataType};
	163
	164	my %data = ( name => $attr->{name} );
	165
	166	$data{data_type}
	167	= _resolve_tag($TAGS{data_type},[$attr,$dataType])
	168	\|\| $dataType->{name};
	169
	170	$data{size} = _resolve_tag($TAGS{size},[$attr,$dataType]);
	171
	172	$data{default_value}
f992cfaa	173	= _resolve_tag($TAGS{default_value},[$attr,$dataType])
f992cfaa	174	\|\| $attr->{initialValue};
55e462b4	175
	176	my $is_nullable = _resolve_tag($TAGS{is_nullable},[$attr,$dataType]);
	177	my $required = _resolve_tag($TAGS{required},[$attr,$dataType]);
	178	$data{is_nullable}
	179	= defined $is_nullable ? $is_nullable
	180	: ( defined $required ? ($required ? 0 : 1) : undef);
	181
	182	$data{is_auto_increment}
	183	= $attr->{_map_taggedValues}{$TAGS{is_auto_increment}}{dataValue}
	184	\|\| $dataType->{_map_taggedValues}{$TAGS{is_auto_increment}}{dataValue}
	185	\|\| undef;
	186
	187	#
	188	# Extras
	189	#
	190	my %tagnames;
	191	foreach ( keys %{$attr->{_map_taggedValues}} ) {$tagnames{$_}++; }
	192	delete @tagnames{@TAGS{qw/data_type size default_value is_nullable required is_auto_increment/}}; # Remove the tags we have already done
	193	my %extra = map {
	194	my $val = $attr->{_map_taggedValues}{$_}{dataValue};
	195	s/^sqlf//;
	196	($_,$val);
	197	} keys %tagnames;
	198	$data{extra} = \%extra;
	199
	200	return \%data;
	201	}
	202
f992cfaa	203	# Add a pkey to a table for the class
	204	sub add_pkey {
	205	my ($class,$table) = @_;
	206
	207	my @pkeys;
	208	foreach ( split(",", $pargs->{derive_pkey}) ) {
	209	if ( $_ eq "stereotype" ) {
	210	@pkeys = map $_->{name},
	211	grep($_->{stereotype} eq "PK", @{$class->{attributes}});
	212	}
	213	elsif( $_ eq "first" ) {
	214	@pkeys = $class->{attributes}[0]{name} unless @pkeys;
	215	}
	216	elsif( $_ eq "auto" ) {
	217	if ( my %data = %{$pargs->{auto_pkey}} ) {
	218	$data{name} = $data{name}->($class,$table);
	219	my $field = $table->add_field(%data) or die $table->error;
	220	@pkeys = $field->name;
	221	}
	222	}
	223	last if @pkeys;
	224	}
	225
	226	$table->add_constraint(
	227	type => "PRIMARY KEY",
	228	fields => [@pkeys],
	229	) or die $table->error;
	230	}
	231
55e462b4	232	# Maps a 1:M association into the schema
ae15bb99	233	sub one2many
ae15bb99	234	{
f992cfaa	235	my ($assoc) = @_;
55e462b4	236	my @ends = @{$assoc->{associationEnds}};
	237	my ($end1) = grep $_->{multiplicity}{rangeUpper} == 1, @ends;
	238	my $endm = $end1->{otherEnd};
f992cfaa	239	my $table1 = $schema->get_table($end1->{participant}{name});
f992cfaa	240	my $tablem = $schema->get_table($endm->{participant}{name});
55e462b4	241
	242	#
	243	# Export 1end pkey to many end
f992cfaa	244	#
f992cfaa	245	my $con = $table1->primary_key;
55e462b4	246	my @flds = $con->fields;
	247	foreach (@flds) {
	248	my $fld = $table1->get_field($_);
	249	my %data;
	250	$data{$_} = $fld->$_()
f992cfaa	251	foreach (qw/name size data_type default_value is_nullable/);
55e462b4	252	$data{extra} = { $fld->extra }; # Copy extra hash
	253	$data{is_unique} = 0; # FKey on many join so not unique
	254	$data{is_nullable} = $end1->{multiplicity}{rangeLower} == 0 ? 1 : 0;
	255	# 0:m - allow nulluable on fkey
	256	# 1:m - dont allow nullable
	257
f992cfaa	258	$tablem->add_field(%data) or die $tablem->error;
55e462b4	259	# Export the pkey if full composite (ie identity) relationship
	260	$tablem->primary_key($_) if $end1->{aggregation} eq "composite";
	261	}
	262
	263	#
	264	# Add fkey constraint to many end
	265	#
	266	$tablem->add_constraint(
	267	type => "FOREIGN_KEY",
	268	fields => [@flds],
	269	reference_table => $table1->{name},
	270	reference_fields => [@flds],
f992cfaa	271	) or die $schema->error;
55e462b4	272	}
55e462b4	273
ae15bb99	274	# Maps m:n into schema by building a link table.
	275	sub many2many
	276	{
	277	my ($assoc) = @_;
	278	my @end = @{$assoc->{associationEnds}};
	279
	280	# Create the link table
	281	my $name = $end[0]->{participant}{name}."_".$end[1]->{participant}{name};
	282	my $link_table = $schema->add_table( name => $name )
	283	or die "Schema Error: ".$schema->error;
	284
	285	# Export the pkey(s) from the ends into the link table
	286	my @pkeys;
	287	foreach (@end) {
	288	my $table = $schema->get_table($_->{participant}{name});
	289	my @fkeys = $table->primary_key->fields;
	290	push @pkeys,@fkeys;
	291	foreach ( @fkeys ) {
	292	my $fld = $table->get_field($_);
	293	my %data;
	294	$data{$_} = $fld->$_()
	295	foreach (
	296	qw/name size data_type default_value is_nullable is_unique/);
	297	$data{is_auto_increment} = 0;
	298	$data{extra} = { $fld->extra }; # Copy
	299	$link_table->add_field(%data) or die $table->error;
	300	}
	301	$link_table->add_constraint(
	302	type => "FOREIGN_KEY",
	303	fields => [@fkeys],
	304	reference_table => $table->{name},
	305	reference_fields => [@fkeys],
	306	) or die $schema->error;
	307
	308	}
	309	# Add pkey constraint
	310	$link_table->add_constraint( type => "PRIMARY KEY", fields => [@pkeys] )
	311	or die $link_table->error;
	312
	313
	314	# Add fkeys to our participants
	315	}
55e462b4	316	1; #---------------------------------------------------------------------------
	317
	318	__END__
	319
	320	=pod
	321
	322	=head1 SYNOPSIS
	323
	324	use SQL::Translator;
	325	use SQL::Translator::Parser::XML::XMI;
	326
	327	my $translator = SQL::Translator->new(
	328	from => 'XML-XMI-SQLFairy',
	329	to => 'MySQL',
	330	filename => 'schema.xmi',
	331	);
	332
	333	print $obj->translate;
	334
	335	=head1 DESCRIPTION
	336
	337	Converts Class diagrams to Schema trying to use standard UML features as much
	338	as possible, with the minimum use of extension mechanisms (tagged values and
	339	stereotypes) for the database details. The idea is to treat the object model
	340	like a logical database model and map that to a physical model (the sql). Also
	341	tries to make this mapping as configurable as possible and support all the
f992cfaa	342	schema features of SQLFairy.
55e462b4	343
	344	=head2 Tables
	345
	346	Classes, all of them! (TODO More control over which tables to do.)
	347
	348	=head2 Fields
	349
f992cfaa	350	The attributes of the class will be converted to fields of the same name.
	351
	352	=head3 Datatypes
55e462b4	353
55e462b4	354	Database datatypes are modeled using tagged values; sqlfDataType,
f992cfaa	355	sqlfSize, sqlfIsNullable and sqlfIsAutoIncrement added to the attribute.
	356	The default value is the UML initial value of the attribute or can be overridden
	357	using a sqlfDefaultValue tagged value if you want to have a different default
	358	in the database then the object uses.
	359
	360	For more advanced datatype modeling you can use UML data types by adding the
	361	tagged values to the UML data types in your model and then giving your
	362	attributes those datatypes. Any tagged values set on attributes will override
	363	any they get from their datatype. This allows you to use UML datatypes like
	364	domains. If no sqlfDataType is given then the name of the UMLDataType is used.
55e462b4	365
	366	=head3 Primary Keys
	367
f992cfaa	368	If no attribute is marked explicity on the Class as a pkey then one is added.
	369	The default is an INT(10) auto number named after the class with ID on the end.
	370	For many cases this is enough as you don't normally need to model pkeys
	371	explicitly in your object models as its a database thing.
	372
	373	The pkey created can be controlled by setting the C<auto_pkey> parser arg to a
	374	hash ref describing the field. The name key is a sub that gets given a ref to
	375	the class (from the xmi) and the table it has been mapped to, and should return the pkey name. e.g. the defualt looks like;
	376
	377	{
	378	name => sub {
	379	my $class = shift;
	380	$class->{name}."ID";
	381	},
	382	data_type => "INT",
	383	size => 10,
	384	is_nullable => 0,
	385	is_auto_increment => 1,
	386	}
	387
	388	NB You need to return a unique name for the key if it will be used to build
	389	relationships as it will be exported to other tables (see Relationships).
	390
	391	You can also set them explicitly by marking attributes with a <<PK>> stereotype.
	392	Add to multiple attribs to make multi column keys. Usefull when your object
	393	contains an attribute that makes a good candidate for a pkey, e.g. email.
55e462b4	394
	395	=head2 Relationships
	396
fd682c03	397	=head2 1:m
62682f29	398
62682f29	399	Associations where one ends multiplicty is '1' or '0..1' and the other end's
f992cfaa	400	multplicity is more than 1 e.g '', '0..', '1..*', '0..3', '4..42' etc.
55e462b4	401
f992cfaa	402	The pkey field from the 1 end is added to the table for the class at the many
f992cfaa	403	end as a foreign key with is_unique and auto number turned off.
55e462b4	404
	405	If the 1 end is multiplicity '0..1' (ie a 0:m join) then the the fkey is made
	406	nullable, if its multiplicity '1' (1:m) then its made not nullable.
	407
f992cfaa	408	If the association is a composition then the created fkey is made part of the
	409	many ends pkey. ie It exports the pkey to create an identity join.
	410
62682f29	411	=head2 m:n
	412
	413	Model using a standard m:n association and the parser will automatically create
	414	a link table for you in the Schema by exporting pkeys from the tables at
	415	each end.
	416
f992cfaa	417	=head1 EXAMPLE
	418
	419	TODO An example to help make sense of the above! Probably based on the test.
55e462b4	420
	421	=head1 ARGS
	422
	423	=head1 BUGS
	424
	425	=head1 TODO
	426
62682f29	427	1:1 joins.
	428
	429	Use Role names from associations as field names for exported keys when building
	430	relationships.
f992cfaa	431
	432	Generalizations.
	433
62682f29	434	Support for the format_X_name subs in the Translator and format subs for
62682f29	435	generating the link table name in m:n joins.
f992cfaa	436
	437	Lots more...
	438
55e462b4	439	=head1 AUTHOR
	440
	441	Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.
	442
	443	=head1 SEE ALSO
	444
	445	perl(1), SQL::Translator::Parser::XML::XMI
	446
	447	=cut