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

   1 package SQL::Translator::Parser::XML::XMI;
   2
   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>,
   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 =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
  45 Currently pulls out all the Classes as tables.
  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
  51 =head2 XMI Format
  52
  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
  55 of XMI!
  56
  57 It should also parse XMI 1.0, such as you get from Rose, but this has had
  58 little testing!
  59
  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
  77 =cut
  78
  79 # -------------------------------------------------------------------
  80
  81 use strict;
  82
  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;
  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';
  94 use SQL::Translator::XMI::Parser;
  95
  96
  97 # SQLFairy Parser
  98 #-----------------------------------------------------------------------------
  99
 100 # is_visible - Used to check visibility in filter subs
 101 {
 102     my %vislevel = (
 103         public => 1,
 104         protected => 2,
 105         private => 3,
 106     );
 107
 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;
 114     }
 115 }
 116
 117 sub parse {
 118     my ( $translator, $data ) = @_;
 119     local $DEBUG  = $translator->debug;
 120     my $schema    = $translator->schema;
 121     my $pargs     = $translator->parser_args;
 122
 123     eval {
 124
 125     debug "Visibility Level:$pargs->{visibility}" if $DEBUG;
 126
 127     my $xmip = SQL::Translator::XMI::Parser->new(xml => $data);
 128
 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.
 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
 146     debug "Found ".scalar(@$classes)." Classes: ".join(", ",
 147         map {$_->{"name"}} @$classes) if $DEBUG;
 148     debug "Classes:",Dumper($classes);
 149     #print "Classes:",Dumper($classes),"\n";
 150
 151         #
 152         # Turn the data from get_classes into a Schema
 153         #
 154         # TODO This is where we will applie different strategies for different UML
 155         # data modeling profiles.
 156         #
 157         foreach my $class (@$classes) {
 158         # Add the table
 159         debug "Adding class: $class->{name}" if $DEBUG;
 160         my $table = $schema->add_table( name => $class->{name} )
 161             or die "Schema Error: ".$schema->error;
 162
 163         #
 164         # Fields from Class attributes
 165         #
 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,
 171                 #is_foreign_key => $stereotype eq "FK" ? 1 : 0,
 172             );
 173                         $data{default_value} = $attr->{initialValue}
 174                                 if exists $attr->{initialValue};
 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:
 182             # - We should be able to make the table obj spot this when
 183             #   we use add_field.
 184             #
 185         }
 186
 187     } # Classes loop
 188
 189     };
 190     print "ERROR:$@" if $@;
 191
 192     return 1;
 193 }
 194
 195 1;
 196
 197
 198 =pod
 199
 200 =head1 BUGS
 201
 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
 204 whole tree.
 205
 206 =head1 TODO
 207
 208 B<field sizes> Don't think UML does this directly so may need to include
 209 it in the datatype names.
 210
 211 B<table_visibility and field_visibility args> Seperate control over what is
 212 parsed, setting visibility arg will set both.
 213
 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
 226
 227