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