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

   1 package SQL::Translator::Parser::XML::XMI;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: XMI.pm,v 1.2 2003-09-08 12:27:29 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 =cut
  29
  30 # -------------------------------------------------------------------
  31
  32 use strict;
  33
  34 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
  35 $VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/;
  36 $DEBUG   = 0 unless defined $DEBUG;
  37
  38 use Data::Dumper;
  39 use Exporter;
  40 use base qw(Exporter);
  41 @EXPORT_OK = qw(parse);
  42
  43 use base qw/SQL::Translator::Parser/;  # Doesnt do anything at the mo!
  44 use SQL::Translator::Utils 'debug';
  45 use XML::XPath;
  46 use XML::XPath::XMLParser;
  47
  48
  49 # Custom XPath functions
  50 #-----------------------------------------------------------------------------
  51
  52 #
  53 # Pass a nodeset. If the first node has an xmi.idref attrib then return
  54 # the nodeset for that id
  55 #
  56 sub XML::XPath::Function::xmideref {
  57     my $self = shift;
  58     my ($node, @params) = @_;
  59     if (@params > 1) {
  60         die "xmideref() function takes one or no parameters\n";
  61     }
  62     elsif (@params) {
  63         my $nodeset = shift(@params);
  64         return $nodeset unless $nodeset->size;
  65         $node = $nodeset->get_node(1);
  66     }
  67     die "xmideref() needs an Element node."
  68     unless $node->isa("XML::XPath::Node::Element");
  69
  70     my $id = $node->getAttribute("xmi.idref") or return $node;
  71     return $node->getRootNode->find('//*[@xmi.id="'.$id.'"]');
  72 }
  73
  74 sub XML::XPath::Function::hello {
  75     return XML::XPath::Literal->new("Hello World");
  76 }
  77
  78
  79
  80 # Parser
  81 #-----------------------------------------------------------------------------
  82
  83 #
  84 # is_visible( {ELEMENT|VIS_OF_THING}, VISLEVEL)
  85 #
  86 # Returns true or false for whether the visibility of something e.g. Class,
  87 # Attribute, is visible at the level given.
  88 #
  89 {
  90     my %vislevel = (
  91         public => 1,
  92         protected => 2,
  93         private => 3,
  94     );
  95
  96     sub is_visible {
  97         my ($arg, $vis) = @_;
  98         return 1 unless $vis;
  99         my $foo;
 100         die "is_visible : Needs something to test" unless $arg;
 101         if ( $arg->isa("XML::XPath::Node::Element") ) {
 102             $foo = $arg->getAttribute("visibility");
 103         }
 104         else {
 105             $foo = $arg;
 106         }
 107         return 1 if $vislevel{$vis} >= $vislevel{$foo};
 108         return 0;
 109     }
 110 }
 111
 112 sub parse {
 113     my ( $translator, $data ) = @_;
 114     local $DEBUG    = $translator->debug;
 115     my $schema      = $translator->schema;
 116     my $pargs       = $translator->parser_args;
 117
 118     debug "Visibility Level:$pargs->{visibility}" if $DEBUG;
 119
 120     my $xp = XML::XPath->new(xml => $data);
 121     $xp->set_namespace("UML", "org.omg.xmi.namespace.UML");
 122     #
 123     # TODO
 124     # - Options to set the initial context node so we don't just
 125     #   blindly do all the classes. e.g. Select a diag name to do.
 126
 127     #
 128     # Work our way through the classes, creating tables. We only
 129     # want class with xmi.id attributes and not the refs to them,
 130     # which will have xmi.idref attributes.
 131     #
 132     my @nodes = $xp->findnodes('//UML:Class[@xmi.id]');
 133
 134     debug "Found ".scalar(@nodes)." Classes: ".join(", ",
 135         map {$_->getAttribute("name")} @nodes) if $DEBUG;
 136
 137     for my $classnode (@nodes) {
 138         # Only process classes with <<Table>> and name
 139         next unless my $classname = $classnode->getAttribute("name");
 140         next unless !$pargs->{visibility}
 141             or is_visible($classnode, $pargs->{visibility});
 142
 143         my $stereotype = "".$classnode->find(
 144             'xmideref(UML:ModelElement.stereotype/UML:Stereotype)/@name');
 145         next unless $stereotype eq "Table";
 146
 147         # Add the table
 148         debug "Adding class: $classname as table:$classname" if $DEBUG;
 149         my $table = $schema->add_table(name=>$classname)
 150             or die "Schema Error: ".$schema->error;
 151
 152         #
 153         # Fields from Class attributes
 154         #
 155         # name data_type size default_value is_nullable
 156         # is_auto_increment is_primary_key is_foreign_key comments
 157         #
 158         foreach my $attrnode ( $classnode->findnodes(
 159             'UML:Classifier.feature/UML:Attribute[@xmi.id]',)
 160         ) {
 161             next unless my $fieldname = $attrnode->getAttribute("name");
 162             next unless !$pargs->{visibility}
 163                 or is_visible($attrnode, $pargs->{visibility});
 164
 165             my $stereotype = "".$attrnode->findvalue(
 166                 'xmideref(UML:ModelElement.stereotype/UML:Stereotype)/@name');
 167             my %data = (
 168                 name => $fieldname,
 169                 data_type => "".$attrnode->find(
 170                   'xmideref(UML:StructuralFeature.type/UML:DataType)/@name'),
 171                 is_primary_key => $stereotype eq "PK" ? 1 : 0,
 172                 #is_foreign_key => $stereotype eq "FK" ? 1 : 0,
 173             );
 174             if ( my @body = $attrnode->findnodes(
 175                 'UML:Attribute.initialValue/UML:Expression/@body')
 176             ) {
 177                 $data{default_value} = $body[0]->getData;
 178             }
 179
 180             debug "Adding field:",Dumper(\%data);
 181             my $field = $table->add_field( %data ) or die $schema->error;
 182
 183             $table->primary_key( $field->name ) if $data{'is_primary_key'};
 184             #
 185             # TODO:
 186             # - We should be able to make the table obj spot this when
 187             #   we use add_field.
 188             #
 189         }
 190
 191     } # Classes loop
 192
 193     return 1;
 194 }
 195
 196 1;
 197
 198 # -------------------------------------------------------------------
 199
 200 =pod
 201
 202 =head1 SYNOPSIS
 203
 204   use SQL::Translator;
 205   use SQL::Translator::Parser::XML::XMI;
 206
 207   my $translator     = SQL::Translator->new(
 208       from           => 'XML-XMI',
 209       to             => 'MySQL',
 210       filename       => 'schema.xmi',
 211       show_warnings  => 1,
 212       add_drop_table => 1,
 213   );
 214
 215   print $obj->translate;
 216
 217 =head1 DESCRIPTION
 218
 219 =head2 UML Data Modeling
 220
 221 To tell the parser which Classes are tables give them a <<Table>> stereotype.
 222
 223 Any attributes of the class will be used as fields. The datatype of the
 224 attribute must be a UML datatype and not an object, with the datatype's name
 225 being used to set the data_type value in the schema.
 226
 227 Primary keys are attributes marked with <<PK>> stereotype.
 228
 229 =head2 XMI Format
 230
 231 The parser has been built using XMI generated by PoseidonUML 2beta, which
 232 says it uses UML 2. So the current conformance is down to Poseidon's idea
 233 of XMI!
 234
 235 =head1 ARGS
 236
 237 =over 4
 238
 239 =item visibility
 240
 241  visibilty=public|protected|private
 242
 243 What visibilty of stuff to translate. e.g when set to 'public' any private
 244 and package Classes will be ignored and not turned into tables. Applies
 245 to Classes and Attributes.
 246
 247 If not set or false (the default) no checks will be made and everything is
 248 translated.
 249
 250 =back
 251
 252 =head1 BUGS
 253
 254 Seems to be slow. I think this is because the XMI files can get pretty
 255 big and complex, especially all the diagram info.
 256
 257 =head1 TODO
 258
 259 B<field sizes> Don't think UML does this directly so may need to include
 260 it in the datatype names.
 261
 262 B<table_visibility and field_visibility args> Seperate control over what is
 263 parsed, setting visibility arg will set both.
 264
 265 Everything else! Relations, fkeys, constraints, indexes, etc...
 266
 267 =head1 AUTHOR
 268
 269 Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.
 270
 271 =head1 SEE ALSO
 272
 273 perl(1), SQL::Translator, XML::XPath, SQL::Translator::Producer::XML::SQLFairy,
 274 SQL::Translator::Schema.
 275
 276 =cut