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