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

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