package SQL::Translator::XMI::Parser;
# -------------------------------------------------------------------
-# $Id: Parser.pm,v 1.5 2003-09-29 12:02:35 grommit Exp $
+# $Id: Parser.pm,v 1.8 2003-10-06 15:03:07 grommit Exp $
# -------------------------------------------------------------------
# Copyright (C) 2003 Mark Addison <mark.addison@itn.co.uk>,
#
use strict;
use 5.006_001;
use vars qw/$VERSION/;
-$VERSION = sprintf "%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/;
+$VERSION = sprintf "%d.%02d", q$Revision: 1.8 $ =~ /(\d+)\.(\d+)/;
use Data::Dumper;
use XML::XPath;
#
sub XmiSpec {
my ($me,$spec) = @_;
- init_specs($spec);
- $me->mk_gets($spec);
+ _init_specs($spec);
+ $me->_mk_gets($spec);
}
# Build lookups etc. Its important that each spec item becomes self contained
# so we can build good closures, therefore we do all the lookups 1st.
-sub init_specs {
+sub _init_specs {
my $specs = shift;
foreach my $spec ( values %$specs ) {
# Create get methods from spec
#
-sub mk_gets {
+sub _mk_gets {
my ($proto,$specs) = @_;
my $class = ref($proto) || $proto;
foreach ( values %$specs ) {
# so we can add overrides to both specs.
no strict "refs";
my $meth = "_get_$spec->{plural}";
- *{$meth} = mk_get($spec);
+ *{$meth} = _mk_get($spec);
*{__PACKAGE__."::get_$spec->{plural}"} = sub {shift->$meth(@_);}
unless $class->can("get_$spec->{plural}");
}
}
-# e.g. of overriding both versions.
-#sub get_classes {
-# print "HELLO Both\n";
-# return shift->_get_classes(@_);
-#}
-
#
# Sets up the XML::XPath object and then checks the version of the XMI file and
# blesses its self into either the V10 or V12 class.
}
#
-# mk_get
+# _mk_get
#
# Generates and returns a get_ sub for the spec given.
# So, if you want to change how the get methods (e.g. get_classes) work do it
#
# _xpath => The xpath to use for finding stuff.
#
-sub mk_get {
+sub _mk_get {
my $spec = shift;
# get_* closure using $spec
}
# Get the Tag attributes
+#warn " getting attribs: ",join(" ",@{$spec->{attrib_data}}),"\n";
foreach ( @{$spec->{attrib_data}} ) {
$thing->{$_} = $node->getAttribute($_);
}
+#warn " got attribs: ",(map "$_=$thing->{$_}", keys %$thing),"\n";
# Add the path data
foreach ( @{$spec->{path_data}} ) {
-#warn " $spec->{name} - $_->{name} using:$_->{path}\n";
+#warn " getting path data $_->{name} : $_->{path}\n";
my @nodes = $node->findnodes($_->{path});
$thing->{$_->{name}} = @nodes ? $nodes[0]->getData
: (exists $_->{default} ? $_->{default} : undef);
+#warn " got path data $_->{name}=$thing->{$_->{name}}\n";
}
# Run any filters set
$path =~ s/\$\{(.*?)\}/$thing->{$1}/g;
$data = $me->$meth( _context => $node, _xpath => $path,
filter => $args{"filter_$_->{name}"} );
-
if ( $_->{multiplicity} eq "1" ) {
$thing->{$_->{name}} = shift @$data;
}
return $things;
} # /closure sub
-} # /mk_get
+} # /_mk_get
sub _mk_map {
my ($kids,$key) = @_;
return $map;
}
+sub get_associations {
+ my $assoc = shift->_get_associations(@_);
+ foreach (@$assoc) {
+ next unless defined $_->{associationEnds}; # Wait until we get all of an association
+ my @ends = @{$_->{associationEnds}};
+ if (@ends != 2) {
+ warn "Sorry can't handle otherEnd associations with more than 2 ends";
+ return $assoc;
+ }
+ $ends[0]{otherEnd} = $ends[1];
+ $ends[1]{otherEnd} = $ends[0];
+ }
+ return $assoc;
+}
+
1; #===========================================================================
sub xmiDeref {
my $self = shift;
my ($node, @params) = @_;
+ my $nodeset;
if (@params > 1) {
die "xmiDeref() function takes one or no parameters\n";
}
elsif (@params) {
- my $nodeset = shift(@params);
+ $nodeset = shift(@params);
return $nodeset unless $nodeset->size;
$node = $nodeset->get_node(1);
}
die "xmiDeref() needs an Element node."
unless $node->isa("XML::XPath::Node::Element");
- my $id = $node->getAttribute("xmi.idref") or return $node;
+ my $id = $node->getAttribute("xmi.idref") || return ($nodeset || $node);
return $node->getRootNode->find('//*[@xmi.id="'.$id.'"]');
+ # TODO We should use the tag name to search from the source
}