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

   1 package SQL::Translator::Parser::XML::XMI;
   2
   3 # -------------------------------------------------------------------
   4 # $Id: XMI.pm,v 1.5 2003-09-09 01:37:25 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 =head2 UML Data Modeling
  46
  47 To tell the parser which Classes are tables give them a <<Table>> stereotype.
  48
  49 Any attributes of the class will be used as fields. The datatype of the
  50 attribute must be a UML datatype and not an object, with the datatype's name
  51 being used to set the data_type value in the schema.
  52
  53 Primary keys are attributes marked with <<PK>> stereotype.
  54
  55 =head2 XMI Format
  56
  57 The parser has been built using XMI generated by PoseidonUML 2beta, which
  58 says it uses UML 2. So the current conformance is down to Poseidon's idea
  59 of XMI!
  60
  61 =head1 ARGS
  62
  63 =over 4
  64
  65 =item visibility
  66
  67  visibilty=public|protected|private
  68
  69 What visibilty of stuff to translate. e.g when set to 'public' any private
  70 and package Classes will be ignored and not turned into tables. Applies
  71 to Classes and Attributes.
  72
  73 If not set or false (the default) no checks will be made and everything is
  74 translated.
  75
  76 =back
  77
  78 =cut
  79
  80 # -------------------------------------------------------------------
  81
  82 use strict;
  83
  84 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
  85 $VERSION = sprintf "%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/;
  86 $DEBUG   = 0 unless defined $DEBUG;
  87
  88 use Data::Dumper;
  89 use Exporter;
  90 use base qw(Exporter);
  91 @EXPORT_OK = qw(parse);
  92
  93 use base qw/SQL::Translator::Parser/;  # Doesnt do anything at the mo!
  94 use SQL::Translator::Utils 'debug';
  95 use XML::XPath;
  96 use XML::XPath::XMLParser;
  97
  98 # XMI XPath parsing
  99 #-----------------------------------------------------------------------------
 100
 101 #
 102 # get_classes( XPATHOBJ, ARGS );
 103 #
 104 # XPATHOBJ - An XML::XPath object setup and ready to use. You can also use any
 105 #            Node to search from as this sub just calls findnodes() on the arg.
 106 #
 107 # ARGS     - Name/Value list of args.
 108 #
 109 # xpath  =>  The xpath to use for finding classes. Default is //UML:Classes
 110 #            which will find all the classes in the XMI.
 111 #
 112 # test   =>  An XPath predicate (ie the bit between [] ) to test the
 113 #            classes with to decide if we should parse them. ie
 114 #            test => '@name' would only pass out classes with a name.
 115 #            Can also give it an array ref and it will and the tests.
 116 #            It gets tacked onto to xpath so don't put any [] on
 117 #            xpath if you use test as well.
 118 #
 119 # attribute_test => An XPath predicate to pass onto get_attributes.
 120 #
 121
 122 # _add_xpath_tests $path, [qw/@name xmiVisible("public")/]; # and
 123 # _add_xpath_tests $path, [qw/@name xmiVisible("public")/], "or";
 124 sub _add_xpath_tests {
 125     my ($path,$tests,$join) = @_;
 126         return $path unless defined $tests;
 127         my @tests = ref($tests) ? @$tests : $tests;
 128         return $path unless @tests;
 129     $join ||= "and";
 130     return $path."[".join(" $join ", @tests)."]";
 131 }
 132
 133 sub get_stereotype {
 134     my ($xp) = @_;
 135     return "".$xp->findvalue(
 136         'xmiDeref(UML:ModelElement.stereotype/UML:Stereotype)/@name');
 137     # TODO Test for difference between it existing or being "" ?
 138 }
 139
 140 sub get_classes {
 141         my ($xp,%args) = @_;
 142         my $classes;
 143
 144         my $xpath = $args{xpath} ||= '//UML:Class'; # Default: all classes
 145     $xpath = _add_xpath_tests $xpath, $args{test};
 146         debug "Searching for Classes using:$xpath";
 147
 148         my @nodes = $xp->findnodes($xpath);
 149         return unless @nodes;
 150
 151         for my $classnode (@nodes) {
 152         my $class = {};
 153
 154         foreach (
 155                         qw/name visibility isSpecification
 156                            isRoot isLeaf isAbstract isActive/
 157                 ) {
 158                         $class->{$_} = $classnode->getAttribute($_);
 159                 }
 160                 $class->{stereotype} = get_stereotype($classnode);
 161
 162         $class->{attributes} = get_attributes( $classnode,
 163             xpath => 'UML:Classifier.feature/UML:Attribute',
 164             test => $args{attribute_test} );
 165
 166         $class->{operations} = get_operations( $classnode,
 167             xpath => '//UML:Classifier.feature/UML:Operation',
 168             test => $args{operation_test} );
 169
 170         push @$classes, $class;
 171         }
 172         return wantarray ? @$classes : $classes;
 173 };
 174
 175 sub get_attributes {
 176     my ($xp, %args) = @_;
 177
 178         my $xpath = $args{xpath} ||= '//UML:Classifier.feature/UML:Attribute';
 179     $xpath = _add_xpath_tests $xpath, $args{test};
 180         debug "Searching for Attributes using:$xpath";
 181
 182     my $attributes;
 183     foreach my $node ( $xp->findnodes($xpath) ) {
 184         my $attr = {};
 185
 186         foreach (qw/name visibility isSpecification ownerScope/) {
 187             $attr->{$_} = $node->getAttribute($_);
 188         }
 189         $attr->{stereotype} = get_stereotype($node);
 190
 191         # Get datatype name and the body of the initial value
 192         $attr->{datatype} = "".$node->find(
 193               'xmiDeref(UML:StructuralFeature.type/UML:DataType)/@name');
 194         if ( my @body = $node->findnodes(
 195             'UML:Attribute.initialValue/UML:Expression/@body')
 196         ) {
 197             $attr->{initialValue} = $body[0]->getData;
 198         }
 199
 200         push @$attributes, $attr;
 201     }
 202     return wantarray ? @$attributes : $attributes;
 203 }
 204
 205 sub get_operations {
 206     my ($xp, %args) = @_;
 207
 208         my $xpath = $args{xpath} ||= '//UML:Classifier.feature/UML:Operation';
 209     $xpath = _add_xpath_tests $xpath, $args{test};
 210         debug "Searching for operations using:$xpath";
 211
 212     my $operations;
 213     foreach my $node ( $xp->findnodes($xpath) ) {
 214         my $operation = {};
 215
 216         foreach (qw/name visibility isSpecification ownerScope isQuery
 217             concurrency isRoot isLeaf isAbstract/) {
 218             $operation->{$_} = $node->getAttribute($_);
 219         }
 220         $operation->{stereotype} = get_stereotype($node);
 221
 222         $operation->{parameters} = get_parameters( $node,
 223             xpath => 'UML:BehavioralFeature.parameter/UML:Parameter',
 224             test  => $args{attribute_test}
 225         );
 226
 227         push @$operations, $operation;
 228     }
 229     return wantarray ? @$operations : $operations;
 230 }
 231
 232 sub get_parameters {
 233     my ($xp, %args) = @_;
 234
 235         my $xpath = $args{xpath} ||= '//UML:Classifier.feature/UML:Attribute';
 236     $xpath = _add_xpath_tests $xpath, $args{test};
 237         debug "Searching for Attributes using:$xpath";
 238
 239     my $parameters;
 240     foreach my $node ( $xp->findnodes($xpath) ) {
 241         my $parameter = {};
 242
 243         foreach (qw/name isSpecification kind/) {
 244             $parameter->{$_} = $node->getAttribute($_);
 245         }
 246         $parameter->{stereotype} = get_stereotype($node);
 247
 248         $parameter->{datatype} = "".$node->find(
 249               'xmiDeref(UML:Parameter.type/UML:DataType)/@name');
 250
 251         push @$parameters, $parameter;
 252     }
 253     return wantarray ? @$parameters : $parameters;
 254 }
 255
 256 # SQLFairy Parser
 257 #-----------------------------------------------------------------------------
 258
 259 sub parse {
 260         eval {
 261
 262     my ( $translator, $data ) = @_;
 263     local $DEBUG    = $translator->debug;
 264     my $schema      = $translator->schema;
 265     my $pargs       = $translator->parser_args;
 266
 267     debug "Visibility Level:$pargs->{visibility}" if $DEBUG;
 268
 269     my $xp = XML::XPath->new(xml => $data);
 270     $xp->set_namespace("UML", "org.omg.xmi.namespace.UML");
 271     #
 272     # TODO
 273     # - Options to set the initial context node so we don't just
 274     #   blindly do all the classes. e.g. Select a diag name to do.
 275
 276         #
 277     # Build an XPath for the classes and attributes we want...
 278         #
 279     # Only classes with an id (so we don't get any refs to classes ie
 280     # xmi.idref classes). They also need a name to be usefull.
 281     my @tests = ('@xmi.id and @name');
 282         push @tests, "xmiVisible('$pargs->{visibility}')" if $pargs->{visibility};
 283
 284         my $attrib_test = '@name and @xmi.id';
 285         $attrib_test .= " and xmiVisible('$pargs->{visibility}')"
 286             if $pargs->{visibility};
 287
 288         # ...and parse them out
 289         my $classes = get_classes( $xp,
 290                 xpath => "//UML:Class", test => [@tests], attribute_test => $attrib_test);
 291
 292     debug "Found ".scalar(@$classes)." Classes: ".join(", ",
 293         map {$_->{"name"}} @$classes) if $DEBUG;
 294         debug "Classes:",Dumper($classes);
 295
 296         #
 297         # Turn the data from get_classes into a Schema
 298         #
 299         foreach my $class (@$classes) {
 300         next unless $class->{stereotype} eq "Table";
 301
 302         # Add the table
 303         debug "Adding class: $class->{name}" if $DEBUG;
 304         my $table = $schema->add_table( name => $class->{name} )
 305             or die "Schema Error: ".$schema->error;
 306
 307         #
 308         # Fields from Class attributes
 309         #
 310         # name data_type size default_value is_nullable
 311         # is_auto_increment is_primary_key is_foreign_key comments
 312         #
 313         foreach my $attr ( @{$class->{attributes}} ) {
 314                         my %data = (
 315                 name           => $attr->{name},
 316                 data_type      => $attr->{datatype},
 317                 is_primary_key => $attr->{stereotype} eq "PK" ? 1 : 0,
 318                 #is_foreign_key => $stereotype eq "FK" ? 1 : 0,
 319             );
 320                         $data{default_value} = $attr->{initialValue}
 321                                 if exists $attr->{initialValue};
 322
 323             debug "Adding field:",Dumper(\%data);
 324             my $field = $table->add_field( %data ) or die $schema->error;
 325
 326             $table->primary_key( $field->name ) if $data{'is_primary_key'};
 327             #
 328             # TODO:
 329             # - We should be able to make the table obj spot this when
 330             #   we use add_field.
 331             #
 332         }
 333
 334     } # Classes loop
 335
 336     return 1;
 337
 338         };
 339         print "ERROR: $@\n" if $@;
 340         return 1;
 341 }
 342
 343 1;
 344
 345 #=============================================================================
 346 #
 347 # XML::XPath extensions
 348 #
 349 #=============================================================================
 350
 351 package XML::XPath::Function;
 352
 353 =head1 XMI XPath Functions
 354
 355 The Parser adds the following extra XPath functions.
 356
 357 =head2 xmiDeref
 358
 359 Deals with xmi.id/xmi.idref pairs of attributes. You give it an
 360 xPath e.g 'UML:ModelElement.stereotype/UML:stereotype' if the the
 361 tag it points at has an xmi.idref it looks up the tag with that
 362 xmi.id and returns it.
 363
 364 If it doesn't have an xmi.id, the path is returned as normal.
 365
 366 e.g. given
 367
 368  <UML:ModelElement.stereotype>
 369      <UML:Stereotype xmi.idref = 'stTable'/>
 370  </UML:ModelElement.stereotype>
 371   ...
 372  <UML:Stereotype xmi.id='stTable' name='Table' visibility='public'
 373      isAbstract='false' isSpecification='false' isRoot='false' isLeaf='false'>
 374      <UML:Stereotype.baseClass>Class</UML:Stereotype.baseClass>
 375  </UML:Stereotype>
 376
 377 Using xmideref(//UML:ModelElement.stereotype/UML:stereotype) would return the
 378 <UML:Stereotype xmi.id = '3b4b1e:f762a35f6b:-7fb6' ...> tag.
 379
 380 Using xmideref(//UML:ModelElement.stereotype/UML:stereotype)/@name would give
 381 "Table".
 382
 383 =head xmiVisible
 384
 385  is_visible( VISLEVEL )
 386
 387 Returns true or false for whether the visibility of something e.g. a Class or
 388 Attribute, is visible at the level given. e.g.
 389
 390  //UML:Class[xmiVisible('public')]       - Find all public classes
 391  //UML:Class[xmiVisible('protected')]    - Find all public and protected classes
 392
 393 Supports the 3 UML visibility levels of public, protected and private.
 394
 395 Note: Currently any element tested that doesn't have a visibility="" attribute
 396 is assumed to be visible and so xmiVisible will return true. This is probably
 397 the wrong thing to do and is very likley to change. It is probably best to
 398 throw an error if we try to test something that doesn't do visibility.
 399
 400 =cut
 401
 402 sub xmiDeref {
 403     my $self = shift;
 404     my ($node, @params) = @_;
 405     if (@params > 1) {
 406         die "xmiDeref() function takes one or no parameters\n";
 407     }
 408     elsif (@params) {
 409         my $nodeset = shift(@params);
 410         return $nodeset unless $nodeset->size;
 411         $node = $nodeset->get_node(1);
 412     }
 413     die "xmiDeref() needs an Element node."
 414     unless $node->isa("XML::XPath::Node::Element");
 415
 416     my $id = $node->getAttribute("xmi.idref") or return $node;
 417     return $node->getRootNode->find('//*[@xmi.id="'.$id.'"]');
 418 }
 419
 420 {
 421     my %vislevel = (
 422         public => 1,
 423         protected => 2,
 424         private => 3,
 425     );
 426
 427     sub xmiVisible {
 428                 my $self = shift;
 429                 my ($node, @params) = @_;
 430                 if (@params < 1 or @params > 2) {
 431                         die "xmiVisible() function takes 1 or 2 parameters\n";
 432                 }
 433                 elsif (@params == 2) {
 434                         my $nodeset = shift(@params);
 435                         return unless $nodeset->size;
 436                         $node = $nodeset->get_node(1);
 437                 }
 438                 die "xmiVisible() needs an Element node."
 439                 unless $node->isa("XML::XPath::Node::Element");
 440
 441                 my $vis = shift(@params) || return XML::XPath::Boolean->True;
 442                 my $nodevis = $node->getAttribute("visibility")
 443                         || return XML::XPath::Boolean->True;
 444         return XML::XPath::Boolean->True
 445                         if $vislevel{$vis} >= $vislevel{$nodevis};
 446         return XML::XPath::Boolean->False;
 447     }
 448 }
 449
 450 # Test of custom xpath function.
 451 sub hello {
 452     return XML::XPath::Literal->new("Hello World");
 453 }
 454
 455 #=============================================================================
 456 package main;
 457
 458
 459 =pod
 460
 461 =head1 BUGS
 462
 463 Seems to be slow. I think this is because the XMI files can get pretty
 464 big and complex, especially all the diagram info.
 465
 466 =head1 TODO
 467
 468 B<field sizes> Don't think UML does this directly so may need to include
 469 it in the datatype names.
 470
 471 B<Check the Tag Attribute lists in get_* subs> I have taken them from looking
 472 at Poseidon so need to check against XMI spec.
 473
 474 B<table_visibility and field_visibility args> Seperate control over what is
 475 parsed, setting visibility arg will set both.
 476
 477 Everything else! Relations, fkeys, constraints, indexes, etc...
 478
 479 =head1 AUTHOR
 480
 481 Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.
 482
 483 =head1 SEE ALSO
 484
 485 perl(1), SQL::Translator, XML::XPath, SQL::Translator::Producer::XML::SQLFairy,
 486 SQL::Translator::Schema.
 487
 488 =cut
 489
 490