1 package SQL::Translator::Parser::XML::XMI;
3 # -------------------------------------------------------------------
4 # $Id: XMI.pm,v 1.6 2003-09-16 16:29:49 grommit Exp $
5 # -------------------------------------------------------------------
6 # Copyright (C) 2003 Mark Addison <mark.addison@itn.co.uk>,
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.
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.
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
21 # -------------------------------------------------------------------
25 SQL::Translator::Parser::XML::XMI - Parser to create Schema from UML
26 Class diagrams stored in XMI format.
31 use SQL::Translator::Parser::XML::XMI;
33 my $translator = SQL::Translator->new(
36 filename => 'schema.xmi',
41 print $obj->translate;
45 Currently pulls out all the Classes as tables.
47 Any attributes of the class will be used as fields. The datatype of the
48 attribute must be a UML datatype and not an object, with the datatype's name
49 being used to set the data_type value in the schema.
53 The parser has been built using XMI 1.2 generated by PoseidonUML 2beta, which
54 says it uses UML 2. So the current conformance is down to Poseidon's idea
57 It should also parse XMI 1.0, such as you get from Rose, but this has had
66 visibilty=public|protected|private
68 What visibilty of stuff to translate. e.g when set to 'public' any private
69 and package Classes will be ignored and not turned into tables. Applies
70 to Classes and Attributes.
72 If not set or false (the default) no checks will be made and everything is
79 # -------------------------------------------------------------------
83 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
84 $VERSION = sprintf "%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/;
85 $DEBUG = 0 unless defined $DEBUG;
89 use base qw(Exporter);
90 @EXPORT_OK = qw(parse);
92 use base qw/SQL::Translator::Parser/; # Doesnt do anything at the mo!
93 use SQL::Translator::Utils 'debug';
94 use SQL::Translator::XMI::Parser;
98 #-----------------------------------------------------------------------------
100 # is_visible - Used to check visibility in filter subs
109 my ($nodevis, $vis) = @_;
110 $nodevis = ref $_[0] ? $_[0]->{visibility} : $_[0];
111 return 1 unless $vis;
112 return 1 if $vislevel{$vis} >= $vislevel{$nodevis};
118 my ( $translator, $data ) = @_;
119 local $DEBUG = $translator->debug;
120 my $schema = $translator->schema;
121 my $pargs = $translator->parser_args;
125 debug "Visibility Level:$pargs->{visibility}" if $DEBUG;
127 my $xmip = SQL::Translator::XMI::Parser->new(xml => $data);
130 # - Options to set the initial context node so we don't just
131 # blindly do all the classes. e.g. Select a diag name to do.
133 my $classes = $xmip->get_classes(
135 return unless $_->{name};
136 return unless is_visible($_, $pargs->{visibility});
139 filter_attributes => sub {
140 return unless $_->{name};
141 return unless is_visible($_, $pargs->{visibility});
146 debug "Found ".scalar(@$classes)." Classes: ".join(", ",
147 map {$_->{"name"}} @$classes) if $DEBUG;
148 debug "Classes:",Dumper($classes);
149 #print "Classes:",Dumper($classes),"\n";
152 # Turn the data from get_classes into a Schema
154 # TODO This is where we will applie different strategies for different UML
155 # data modeling profiles.
157 foreach my $class (@$classes) {
159 debug "Adding class: $class->{name}" if $DEBUG;
160 my $table = $schema->add_table( name => $class->{name} )
161 or die "Schema Error: ".$schema->error;
164 # Fields from Class attributes
166 foreach my $attr ( @{$class->{attributes}} ) {
168 name => $attr->{name},
169 data_type => $attr->{datatype},
170 is_primary_key => $attr->{stereotype} eq "PK" ? 1 : 0,
171 #is_foreign_key => $stereotype eq "FK" ? 1 : 0,
173 $data{default_value} = $attr->{initialValue}
174 if exists $attr->{initialValue};
176 debug "Adding field:",Dumper(\%data);
177 my $field = $table->add_field( %data ) or die $schema->error;
179 $table->primary_key( $field->name ) if $data{'is_primary_key'};
182 # - We should be able to make the table obj spot this when
190 print "ERROR:$@" if $@;
202 Seems to be slow. I think this is because the XMI files can get pretty
203 big and complex, especially all the diagram info, and XPath needs to load the
208 B<field sizes> Don't think UML does this directly so may need to include
209 it in the datatype names.
211 B<table_visibility and field_visibility args> Seperate control over what is
212 parsed, setting visibility arg will set both.
214 Everything else! Relations, fkeys, constraints, indexes, etc...
218 Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.
222 perl(1), SQL::Translator, XML::XPath, SQL::Translator::Producer::XML::SQLFairy,
223 SQL::Translator::Schema.