lib/SQL/Translator/Parser/XML/XMI.pm

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