Commit | Line | Data |
1223c9b2 |
1 | package SQL::Translator::Parser::XML::XMI; |
2 | |
3 | # ------------------------------------------------------------------- |
f42065cb |
4 | # $Id: XMI.pm,v 1.6 2003-09-16 16:29:49 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 | |
f8ec05fa |
28 | =head1 SYNOPSIS |
29 | |
30 | use SQL::Translator; |
31 | use SQL::Translator::Parser::XML::XMI; |
32 | |
33 | my $translator = SQL::Translator->new( |
34 | from => 'XML-XMI', |
35 | to => 'MySQL', |
36 | filename => 'schema.xmi', |
37 | show_warnings => 1, |
38 | add_drop_table => 1, |
39 | ); |
40 | |
41 | print $obj->translate; |
42 | |
43 | =head1 DESCRIPTION |
44 | |
f42065cb |
45 | Currently pulls out all the Classes as tables. |
f8ec05fa |
46 | |
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. |
50 | |
f8ec05fa |
51 | =head2 XMI Format |
52 | |
f42065cb |
53 | The parser has been built using XMI 1.2 generated by PoseidonUML 2beta, which |
f8ec05fa |
54 | says it uses UML 2. So the current conformance is down to Poseidon's idea |
55 | of XMI! |
56 | |
f42065cb |
57 | It should also parse XMI 1.0, such as you get from Rose, but this has had |
58 | little testing! |
59 | |
f8ec05fa |
60 | =head1 ARGS |
61 | |
62 | =over 4 |
63 | |
64 | =item visibility |
65 | |
66 | visibilty=public|protected|private |
67 | |
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. |
71 | |
72 | If not set or false (the default) no checks will be made and everything is |
73 | translated. |
74 | |
75 | =back |
76 | |
1223c9b2 |
77 | =cut |
78 | |
79 | # ------------------------------------------------------------------- |
80 | |
81 | use strict; |
82 | |
83 | use vars qw[ $DEBUG $VERSION @EXPORT_OK ]; |
f42065cb |
84 | $VERSION = sprintf "%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/; |
1223c9b2 |
85 | $DEBUG = 0 unless defined $DEBUG; |
86 | |
87 | use Data::Dumper; |
88 | use Exporter; |
89 | use base qw(Exporter); |
90 | @EXPORT_OK = qw(parse); |
91 | |
92 | use base qw/SQL::Translator::Parser/; # Doesnt do anything at the mo! |
93 | use SQL::Translator::Utils 'debug'; |
f42065cb |
94 | use SQL::Translator::XMI::Parser; |
91ed9c32 |
95 | |
91ed9c32 |
96 | |
f42065cb |
97 | # SQLFairy Parser |
98 | #----------------------------------------------------------------------------- |
91ed9c32 |
99 | |
f42065cb |
100 | # is_visible - Used to check visibility in filter subs |
101 | { |
102 | my %vislevel = ( |
103 | public => 1, |
104 | protected => 2, |
105 | private => 3, |
106 | ); |
5cb154e5 |
107 | |
f42065cb |
108 | sub is_visible { |
109 | my ($nodevis, $vis) = @_; |
110 | $nodevis = ref $_[0] ? $_[0]->{visibility} : $_[0]; |
111 | return 1 unless $vis; |
112 | return 1 if $vislevel{$vis} >= $vislevel{$nodevis}; |
113 | return 0; |
5cb154e5 |
114 | } |
5cb154e5 |
115 | } |
91ed9c32 |
116 | |
1223c9b2 |
117 | sub parse { |
118 | my ( $translator, $data ) = @_; |
f42065cb |
119 | local $DEBUG = $translator->debug; |
120 | my $schema = $translator->schema; |
121 | my $pargs = $translator->parser_args; |
122 | |
123 | eval { |
124 | |
ef2d7798 |
125 | debug "Visibility Level:$pargs->{visibility}" if $DEBUG; |
126 | |
f42065cb |
127 | my $xmip = SQL::Translator::XMI::Parser->new(xml => $data); |
128 | |
1223c9b2 |
129 | # TODO |
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. |
f42065cb |
132 | |
133 | my $classes = $xmip->get_classes( |
134 | filter => sub { |
135 | return unless $_->{name}; |
136 | return unless is_visible($_, $pargs->{visibility}); |
137 | return 1; |
138 | }, |
139 | filter_attributes => sub { |
140 | return unless $_->{name}; |
141 | return unless is_visible($_, $pargs->{visibility}); |
142 | return 1; |
143 | }, |
144 | ); |
145 | |
f8ec05fa |
146 | debug "Found ".scalar(@$classes)." Classes: ".join(", ", |
147 | map {$_->{"name"}} @$classes) if $DEBUG; |
f42065cb |
148 | debug "Classes:",Dumper($classes); |
149 | #print "Classes:",Dumper($classes),"\n"; |
f8ec05fa |
150 | |
151 | # |
152 | # Turn the data from get_classes into a Schema |
153 | # |
f42065cb |
154 | # TODO This is where we will applie different strategies for different UML |
155 | # data modeling profiles. |
156 | # |
f8ec05fa |
157 | foreach my $class (@$classes) { |
1223c9b2 |
158 | # Add the table |
f8ec05fa |
159 | debug "Adding class: $class->{name}" if $DEBUG; |
160 | my $table = $schema->add_table( name => $class->{name} ) |
1223c9b2 |
161 | or die "Schema Error: ".$schema->error; |
162 | |
163 | # |
164 | # Fields from Class attributes |
165 | # |
f8ec05fa |
166 | foreach my $attr ( @{$class->{attributes}} ) { |
167 | my %data = ( |
168 | name => $attr->{name}, |
169 | data_type => $attr->{datatype}, |
170 | is_primary_key => $attr->{stereotype} eq "PK" ? 1 : 0, |
1223c9b2 |
171 | #is_foreign_key => $stereotype eq "FK" ? 1 : 0, |
172 | ); |
f8ec05fa |
173 | $data{default_value} = $attr->{initialValue} |
174 | if exists $attr->{initialValue}; |
1223c9b2 |
175 | |
176 | debug "Adding field:",Dumper(\%data); |
177 | my $field = $table->add_field( %data ) or die $schema->error; |
178 | |
179 | $table->primary_key( $field->name ) if $data{'is_primary_key'}; |
180 | # |
181 | # TODO: |
ef2d7798 |
182 | # - We should be able to make the table obj spot this when |
1223c9b2 |
183 | # we use add_field. |
184 | # |
185 | } |
186 | |
187 | } # Classes loop |
f42065cb |
188 | |
189 | }; |
190 | print "ERROR:$@" if $@; |
1223c9b2 |
191 | |
192 | return 1; |
193 | } |
194 | |
195 | 1; |
196 | |
f8ec05fa |
197 | |
198 | =pod |
1223c9b2 |
199 | |
200 | =head1 BUGS |
201 | |
ef2d7798 |
202 | Seems to be slow. I think this is because the XMI files can get pretty |
f42065cb |
203 | big and complex, especially all the diagram info, and XPath needs to load the |
204 | whole tree. |
ef2d7798 |
205 | |
1223c9b2 |
206 | =head1 TODO |
207 | |
ef2d7798 |
208 | B<field sizes> Don't think UML does this directly so may need to include |
1223c9b2 |
209 | it in the datatype names. |
210 | |
ef2d7798 |
211 | B<table_visibility and field_visibility args> Seperate control over what is |
212 | parsed, setting visibility arg will set both. |
213 | |
1223c9b2 |
214 | Everything else! Relations, fkeys, constraints, indexes, etc... |
215 | |
216 | =head1 AUTHOR |
217 | |
218 | Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>. |
219 | |
220 | =head1 SEE ALSO |
221 | |
222 | perl(1), SQL::Translator, XML::XPath, SQL::Translator::Producer::XML::SQLFairy, |
223 | SQL::Translator::Schema. |
224 | |
225 | =cut |
f8ec05fa |
226 | |
227 | |