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

   1 package SQL::Translator::Parser::XML::XMI;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: XMI.pm,v 1.1 2003-09-04 15:55:47 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.1 $ =~ /(\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 sub parse {
  84     my ( $translator, $data ) = @_;
  85     local $DEBUG    = $translator->debug;
  86     my $schema      = $translator->schema;
  87     my $pargs          = $translator->parser_args;
  88
  89     my $xp          = XML::XPath->new(xml => $data);
  90
  91     $xp->set_namespace("UML", "org.omg.xmi.namespace.UML");
  92     #
  93     # TODO
  94     # - Options to set the initial context node so we don't just
  95     #   blindly do all the classes. e.g. Select a diag name to do.
  96     #
  97
  98     #
  99     # Work our way through the classes, creating tables. We only
 100     # want class with xmi.id attributes and not the refs to them,
 101     # which will have xmi.idref attributes.
 102     #
 103     my @nodes = $xp->findnodes('//UML:Class[@xmi.id]');
 104
 105     debug "Found ".scalar(@nodes)." Classes: ".join(", ",
 106         map {$_->getAttribute("name")} @nodes);
 107
 108     for my $classnode (@nodes) {
 109         # Only process classes with <<Table>> and name
 110         next unless my $classname = $classnode->getAttribute("name");
 111         my $stereotype = "".$classnode->find(
 112             'xmideref(UML:ModelElement.stereotype/UML:Stereotype)/@name');
 113         next unless $stereotype eq "Table";
 114
 115         # Add the table
 116         debug "Adding class: $classname as table:$classname";
 117         my $table = $schema->add_table(name=>$classname)
 118             or die "Schema Error: ".$schema->error;
 119
 120         #
 121         # Fields from Class attributes
 122         #
 123         # name data_type size default_value is_nullable
 124         # is_auto_increment is_primary_key is_foreign_key comments
 125         #
 126         foreach my $attrnode ( $classnode->findnodes(
 127             'UML:Classifier.feature/UML:Attribute[@xmi.id]',)
 128         ) {
 129             next unless my $fieldname = $attrnode->getAttribute("name");
 130             my $stereotype = "".$attrnode->findvalue(
 131                 'xmideref(UML:ModelElement.stereotype/UML:Stereotype)/@name');
 132             my %data = (
 133                 name => $fieldname,
 134                 data_type => "".$attrnode->find(
 135                   'xmideref(UML:StructuralFeature.type/UML:DataType)/@name'),
 136                 is_primary_key => $stereotype eq "PK" ? 1 : 0,
 137                 #is_foreign_key => $stereotype eq "FK" ? 1 : 0,
 138             );
 139             if ( my @body = $attrnode->findnodes(
 140                 'UML:Attribute.initialValue/UML:Expression/@body')
 141             ) {
 142                 $data{default_value} = $body[0]->getData;
 143             }
 144
 145             debug "Adding field:",Dumper(\%data);
 146             my $field = $table->add_field( %data ) or die $schema->error;
 147
 148             $table->primary_key( $field->name ) if $data{'is_primary_key'};
 149             #
 150             # TODO:
 151             # - We should be able to make the table obj spot this when
 152             #   we use add_field.
 153             #
 154         }
 155
 156     } # Classes loop
 157
 158     return 1;
 159 }
 160
 161 1;
 162
 163 # -------------------------------------------------------------------
 164
 165 =pod
 166
 167 =head1 SYNOPSIS
 168
 169   use SQL::Translator;
 170   use SQL::Translator::Parser::XML::XMI;
 171
 172   my $translator     = SQL::Translator->new(
 173       from           => 'XML-XMI',
 174       to             => 'MySQL',
 175       filename       => 'schema.xmi',
 176       show_warnings  => 1,
 177       add_drop_table => 1,
 178   );
 179
 180   print $obj->translate;
 181
 182 =head1 DESCRIPTION
 183
 184 =head2 UML Data Modeling
 185
 186 To tell the parser which Classes are tables give them a <<Table>> stereotype.
 187
 188 Any attributes of the class will be used as fields. The datatype of the
 189 attribute must be a UML datatype and not an object, with the datatype's name
 190 being used to set the data_type value in the schema.
 191
 192 Primary keys are attributes marked with <<PK>> stereotype.
 193
 194 =head2 XMI Format
 195
 196 The parser has been built using XMI generated by PoseidonUML 2beta, which
 197 says it uses UML 2. So the current conformance is down to Poseidon's idea
 198 of XMI!
 199
 200 =head1 ARGS
 201
 202 =over 4
 203
 204 =item visibility TODO
 205
 206  visibilty=public|private|protected|package
 207
 208 What visibilty of stuff to translate. e.g when set to 'public' any private
 209 Classes will be ignored and not turned into tables.
 210
 211 =item table_visibility    TODO
 212
 213 =item field_visibility    TODO
 214
 215 =item table_stereotype    Def:Table TODO
 216
 217 What stereotype a class must have to turned into a table.
 218
 219 =item pkey_stereotype    Def:PK TODO
 220
 221 =back
 222
 223 =head1 BUGS
 224
 225 =head1 TODO
 226
 227 Deal with field sizes. Don't think UML does this directly so may need to include
 228 it in the datatype names.
 229
 230 Everything else! Relations, fkeys, constraints, indexes, etc...
 231
 232 =head1 AUTHOR
 233
 234 Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.
 235
 236 =head1 SEE ALSO
 237
 238 perl(1), SQL::Translator, XML::XPath, SQL::Translator::Producer::XML::SQLFairy,
 239 SQL::Translator::Schema.
 240
 241 =cut