Commit | Line | Data |
1223c9b2 |
1 | package SQL::Translator::Parser::XML::XMI; |
2 | |
3 | # ------------------------------------------------------------------- |
5365ac89 |
4 | # $Id: XMI.pm,v 1.10 2003-10-03 13:17:28 grommit Exp $ |
1223c9b2 |
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 - Parser to create Schema from UML |
26 | Class diagrams stored in XMI format. |
27 | |
28 | =cut |
29 | |
1223c9b2 |
30 | use strict; |
31 | |
32 | use vars qw[ $DEBUG $VERSION @EXPORT_OK ]; |
5365ac89 |
33 | $VERSION = sprintf "%d.%02d", q$Revision: 1.10 $ =~ /(\d+)\.(\d+)/; |
1223c9b2 |
34 | $DEBUG = 0 unless defined $DEBUG; |
35 | |
36 | use Data::Dumper; |
37 | use Exporter; |
38 | use base qw(Exporter); |
39 | @EXPORT_OK = qw(parse); |
40 | |
41 | use base qw/SQL::Translator::Parser/; # Doesnt do anything at the mo! |
42 | use SQL::Translator::Utils 'debug'; |
f42065cb |
43 | use SQL::Translator::XMI::Parser; |
91ed9c32 |
44 | |
f42065cb |
45 | # SQLFairy Parser |
46 | #----------------------------------------------------------------------------- |
91ed9c32 |
47 | |
f42065cb |
48 | # is_visible - Used to check visibility in filter subs |
49 | { |
50 | my %vislevel = ( |
51 | public => 1, |
52 | protected => 2, |
53 | private => 3, |
54 | ); |
5cb154e5 |
55 | |
f42065cb |
56 | sub is_visible { |
57 | my ($nodevis, $vis) = @_; |
58 | $nodevis = ref $_[0] ? $_[0]->{visibility} : $_[0]; |
59 | return 1 unless $vis; |
60 | return 1 if $vislevel{$vis} >= $vislevel{$nodevis}; |
61 | return 0; |
5cb154e5 |
62 | } |
5cb154e5 |
63 | } |
91ed9c32 |
64 | |
538293f0 |
65 | my ($schema, $pargs); |
66 | |
1223c9b2 |
67 | sub parse { |
68 | my ( $translator, $data ) = @_; |
f42065cb |
69 | local $DEBUG = $translator->debug; |
538293f0 |
70 | $schema = $translator->schema; |
71 | $pargs = $translator->parser_args; |
b2a00f50 |
72 | $pargs->{classes2schema} ||= \&classes2schema; |
538293f0 |
73 | |
ef2d7798 |
74 | debug "Visibility Level:$pargs->{visibility}" if $DEBUG; |
75 | |
7f1e42e5 |
76 | my $xmip = SQL::Translator::XMI::Parser->new(xml => $data); |
f42065cb |
77 | |
1223c9b2 |
78 | # TODO |
79 | # - Options to set the initial context node so we don't just |
80 | # blindly do all the classes. e.g. Select a diag name to do. |
538293f0 |
81 | |
f42065cb |
82 | my $classes = $xmip->get_classes( |
83 | filter => sub { |
84 | return unless $_->{name}; |
85 | return unless is_visible($_, $pargs->{visibility}); |
86 | return 1; |
87 | }, |
88 | filter_attributes => sub { |
89 | return unless $_->{name}; |
90 | return unless is_visible($_, $pargs->{visibility}); |
91 | return 1; |
92 | }, |
93 | ); |
f8ec05fa |
94 | debug "Found ".scalar(@$classes)." Classes: ".join(", ", |
95 | map {$_->{"name"}} @$classes) if $DEBUG; |
7f1e42e5 |
96 | debug "Model:",Dumper($xmip->{model}) if $DEBUG; |
f8ec05fa |
97 | |
98 | # |
99 | # Turn the data from get_classes into a Schema |
100 | # |
b2a00f50 |
101 | $pargs->{classes2schema}->($schema, $classes); |
538293f0 |
102 | |
103 | return 1; |
104 | } |
105 | |
b2a00f50 |
106 | 1; |
107 | |
108 | # Default conversion sub. Makes all classes into tables using all their |
109 | # attributes. |
110 | sub classes2schema { |
111 | my ($schema, $classes) = @_; |
538293f0 |
112 | |
f8ec05fa |
113 | foreach my $class (@$classes) { |
1223c9b2 |
114 | # Add the table |
b2a00f50 |
115 | debug "Adding class: $class->{name}"; |
f8ec05fa |
116 | my $table = $schema->add_table( name => $class->{name} ) |
1223c9b2 |
117 | or die "Schema Error: ".$schema->error; |
118 | |
119 | # |
120 | # Fields from Class attributes |
121 | # |
f8ec05fa |
122 | foreach my $attr ( @{$class->{attributes}} ) { |
123 | my %data = ( |
124 | name => $attr->{name}, |
f8ec05fa |
125 | is_primary_key => $attr->{stereotype} eq "PK" ? 1 : 0, |
1223c9b2 |
126 | #is_foreign_key => $stereotype eq "FK" ? 1 : 0, |
127 | ); |
f8ec05fa |
128 | $data{default_value} = $attr->{initialValue} |
129 | if exists $attr->{initialValue}; |
b2a00f50 |
130 | $data{data_type} = $attr->{_map_taggedValues}{dataType}{dataValue} |
5365ac89 |
131 | || $attr->{dataType}{name}; |
b2a00f50 |
132 | $data{size} = $attr->{_map_taggedValues}{size}{dataValue}; |
133 | $data{is_nullable}=$attr->{_map_taggedValues}{nullable}{dataValue}; |
1223c9b2 |
134 | |
1223c9b2 |
135 | my $field = $table->add_field( %data ) or die $schema->error; |
1223c9b2 |
136 | $table->primary_key( $field->name ) if $data{'is_primary_key'}; |
1223c9b2 |
137 | } |
138 | |
139 | } # Classes loop |
538293f0 |
140 | } |
1223c9b2 |
141 | |
b2a00f50 |
142 | 1; |
538293f0 |
143 | |
b2a00f50 |
144 | __END__ |
538293f0 |
145 | |
b2a00f50 |
146 | =pod |
538293f0 |
147 | |
b2a00f50 |
148 | =head1 SYNOPSIS |
538293f0 |
149 | |
b2a00f50 |
150 | use SQL::Translator; |
151 | use SQL::Translator::Parser::XML::XMI; |
538293f0 |
152 | |
b2a00f50 |
153 | my $translator = SQL::Translator->new( |
154 | from => 'XML-XMI', |
155 | to => 'MySQL', |
156 | filename => 'schema.xmi', |
157 | show_warnings => 1, |
158 | add_drop_table => 1, |
159 | ); |
160 | |
161 | print $obj->translate; |
1223c9b2 |
162 | |
b2a00f50 |
163 | =head1 DESCRIPTION |
1223c9b2 |
164 | |
b2a00f50 |
165 | Translates XMI (UML models in XML format) into Schema. This basic parser |
166 | will just pull out all the classes as tables with fields from their attributes. |
167 | |
168 | For more detail you will need to use a UML profile for data modelling. These are |
169 | supported by sub parsers. See their docs for details. |
170 | |
171 | =over 4 |
172 | |
173 | =item XML::XMI::Rational |
174 | |
175 | The Rational Software UML Data Modeling Profile |
176 | |
177 | =back |
178 | |
179 | =head1 ARGS |
180 | |
181 | =over 4 |
182 | |
183 | =item visibility |
184 | |
185 | visibilty=public|protected|private |
186 | |
187 | What visibilty of stuff to translate. e.g when set to 'public' any private |
188 | and package Classes will be ignored and not turned into tables. Applies |
189 | to Classes and Attributes. |
190 | |
191 | If not set or false (the default) no checks will be made and everything is |
192 | translated. |
193 | |
194 | =back |
195 | |
196 | =head1 XMI Format |
197 | |
198 | Uses either XMI v1.0 or v1.2. The version to use is detected automatically |
199 | from the <XMI> tag in the source file. |
200 | |
201 | The parser has been built using XMI 1.2 generated by PoseidonUML 2, which |
202 | says it uses UML 2. So the current conformance is down to Poseidon's idea |
203 | of XMI! 1.0 support is based on a Rose file, is less complete and has little |
204 | testing. |
f8ec05fa |
205 | |
1223c9b2 |
206 | |
207 | =head1 BUGS |
208 | |
ef2d7798 |
209 | Seems to be slow. I think this is because the XMI files can get pretty |
f42065cb |
210 | big and complex, especially all the diagram info, and XPath needs to load the |
211 | whole tree. |
ef2d7798 |
212 | |
b2a00f50 |
213 | Deleting the diagrams from an XMI1.2 file (make a backup!) will really speed |
214 | things up. Remove <UML:Diagram> tags and all their contents. |
1223c9b2 |
215 | |
b2a00f50 |
216 | =head1 TODO |
ef2d7798 |
217 | |
b2a00f50 |
218 | More profiles. |
1223c9b2 |
219 | |
220 | =head1 AUTHOR |
221 | |
222 | Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>. |
223 | |
224 | =head1 SEE ALSO |
225 | |
226 | perl(1), SQL::Translator, XML::XPath, SQL::Translator::Producer::XML::SQLFairy, |
227 | SQL::Translator::Schema. |
228 | |
229 | =cut |
f8ec05fa |
230 | |
231 | |