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

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