#!/usr/bin/perl
use strict;
use warnings;
######################################################################
+########
# perltoxmi - extract class definitions from oo perl code, and write o
+ut xmi
# for import into CASE tools
# Charles Colbourn June 2006
#
######################################################################
+########
# HISTORY
#
# 0.01 CColbourn 20060616 Rough first version
#
######################################################################
+########
# TO DO
#
# Error checking
# Write to file instead of STDOUT
# Clean up, abstract and make readable
# detect require as well as use
# detect double quoted attrib names just in case
#
######################################################################
+########
# Usage
# perltoxmi MyClass.pm MyOtherClass.pm > classes.xmi
# OR
# cat *.pm |perltoxmi >classes.xmi
#
######################################################################
+########
# Notes
#
# The XMI output is cut and pasted from ArgoUML output. Pretty it isn'
+t, but
# it seems to work
# Export your classes into xmi, then import xmi into Argo (works with
+v0.20
# definitely). Can use 'add namespace
# to class diagram', and 'layout' to do an
# initial layout.
# It exports any classes included with 'use' but outside the files it'
+s been
# passed as interfaces (which aren't automatically added into class di
+agrams,
# handily - otherwise there would be hundreds of association lines to
+'strict')
# To extract attributes, they need to have been used in the form
# $self->{attrib} (single quotes permitted, but
# '$self' is essential).
#
# It's a dirty, dirty hack, but it does what I need :-)
#
######################################################################
+########
# 16 hex digits in counter
my ($header, $classtemplate, $attribtemplate, $methodtemplate, $genera
+lisetemplate, $footer, $interfacetemplate, $associationtemplate);
{
local $/ = '%%ENDOFTEMPLATE%%';
$header = <DATA>;
$classtemplate = <DATA>;
$interfacetemplate = <DATA>;
$attribtemplate = <DATA>;
$methodtemplate = <DATA>;
$generalisetemplate = <DATA>;
$associationtemplate = <DATA>;
$footer = <DATA>;
}
my $counter = 2000;
my $package;
my %obj;
while (<>)
{
if ($_ =~/package ([\w:]+);/)
{
$package = $1;
$obj{$1} = {};
}
if ($_=~/use\s+([\w\:]+);/)
{
$obj{$package}{uses}{$1}++;
}
if ($_ =~/use base\s+(?:qw\(|\'|\")([\w\:\s]+)/)
{
my (@parents) = $1=~/([\w\:]+)/g;
for (@parents)
{
$obj{$package}{parents}{$_}++
}
}
if ($_ =~/sub\s+(\w+)/)
{
#print $package."::".$1."\n";
$obj{$package}{methods}{$1}++;
}
if ($_ =~/\$self->\{[\']*([\w\s]*)\}/)
{
#print $package."->$1\n"
$obj{$package}{attribs}{$1}++;
}
}
my %classnametocounter;
my %generalisations;
my %associations;
my $interfacexml;
my %interfaces;
my $xml = "";
for $package (keys %obj)
{
my $classprintcounter = sprintf("%016X",++$counter);
my $class = $classtemplate;
$class=~s/%%CLASSNAME%%/$package/g;
$class=~s/%%COUNTER%%/$classprintcounter/g;
my $attribsxml = "";
for (keys %{$obj{$package}{attribs}})
{
my $attrib = $attribtemplate;
$attrib=~s/%%ATTRIBNAME%%/$_/;
my $printcounter = sprintf("%016X",++$counter);
$attrib =~s/%%COUNTER%%/$printcounter/;
my $visibility = "public";
if ($_=~/^\_/){$visibility = "private"}
$attrib =~s/%%VISIBILITY%%/$visibility/g;
$attribsxml .= $attrib;
}
my $methodsxml = "";
for (keys %{$obj{$package}{methods}})
{
my $method = $methodtemplate;
$method=~s/%%METHODNAME%%/$_/;
my $printcounter = sprintf("%016X",++$counter);
$method =~s/%%COUNTER%%/$printcounter/;
my $visibility = "public";
if ($_=~/^\_/){$visibility = "private"}
$method =~s/%%VISIBILITY%%/$visibility/g;
$methodsxml .= $method;
}
$classnametocounter{$package} = $classprintcounter;
for (keys %{$obj{$package}{parents}})
{
$generalisations{$package} = $_;
}
for (keys %{$obj{$package}{uses}})
{
$interfaces{$_}++;
$associations{$package}{$_}++;
}
$class =~s/%%ATTRIBXML%%/$attribsxml/;
$class =~s/%%METHODXML%%/$methodsxml/;
$xml .= $class;
}
for my $intname (keys %interfaces)
{
if ($obj{$intname}){next} # don't create an interface if the class
+ is in read scope
my $printcounter = sprintf("%016X",++$counter);
my $interface = $interfacetemplate;
$interface=~s/%%INTERFACENAME%%/$intname/g;
$interface=~s/%%COUNTER%%/$printcounter/g;
$classnametocounter{$intname} = $printcounter;
$xml .= $interface;
}
for (keys %generalisations)
{
my $generalisation = $generalisetemplate;
my $childcounter = $classnametocounter{$_};
my $parentcounter = $classnametocounter{$generalisations{$_}};
$generalisation =~s/%%CHILDCOUNTER%%/$childcounter/;
$generalisation =~s/%%PARENTCOUNTER%%/$parentcounter/;
my $printcounter = sprintf("%016X",++$counter);
$generalisation =~s/%%COUNTER%%/$printcounter/;
#take out the association - we don't want both a vanilla associati
+on and a generalisation
if ($associations{$_}{$generalisations{$_}}){delete $associations{
+$_}{$generalisations{$_}}}
$xml .= $generalisation;
}
for my $package(keys %associations)
{
for my $association (keys %{$associations{$package}})
{
my $associationxml = $associationtemplate;
my $usingclasscounter = $classnametocounter{$package};
my $usedclasscounter = $classnametocounter{$association};
$associationxml =~s/%%USINGCLASS%%/$usingclasscounter/;
$associationxml =~s/%%USEDCLASS%%/$usedclasscounter/;
my $printcounter = sprintf("%016X",++$counter);
$associationxml =~s/%%COUNTER%%/$printcounter/;
my $usedclassendcounter = sprintf("%016X",++$counter);
$associationxml =~s/%%USEDENDCOUNTER%%/$usedclassendcounter/;
my $usingclassendcounter = sprintf("%016X",++$counter);
$associationxml =~s/%%USINGENDCOUNTER%%/$usingclassendcounter/
+;
$xml .= $associationxml;
}
}
# get rid of the template markers
$xml=~s/%%ENDOFTEMPLATE%%//sg;
$header =~s/%%ENDOFTEMPLATE%%//sg;
$footer=~s/%%ENDOFTEMPLATE%%//sg;
print $header."\n";
print $xml;
print $footer."\n";
__DATA__
<?xml version = '1.0' encoding = 'UTF-8' ?>
<XMI xmi.version = '1.2' xmlns:UML = 'org.omg.xmi.namespace.UML' times
+tamp = 'Thu Jun 15 12:59:02 BST 2006'>
<XMI.header> <XMI.header>
<XMI.documentation>
<XMI.exporter>ArgoUML (using Netbeans XMI Writer version 1.0)</X
+MI.exporter>
<XMI.exporterVersion>0.20.x</XMI.exporterVersion>
</XMI.documentation>
<XMI.metamodel xmi.name="UML" xmi.version="1.4"/> </XMI.header>
</XMI.header>
<XMI.content>
<UML:Model xmi.id = '.:0000000000000001' name = 'UNNAMED' isSpecif
+ication = 'false'
isRoot = 'false' isLeaf = 'false' isAbstract = 'false'>
%%ENDOFTEMPLATE%%
<UML:Namespace.ownedElement>
<UML:Class xmi.id = '.:%%COUNTER%%' name = '%%CLASSNAME%%' vis
+ibility = 'public'
isSpecification = 'false' isRoot = 'false' isLeaf = 'false'
+isAbstract = 'false'
isActive = 'false'>
<UML:Classifier.feature>
%%ATTRIBXML%%
%%METHODXML%%
</UML:Classifier.feature>
</UML:Class>
</UML:Namespace.ownedElement>
%%ENDOFTEMPLATE%%
<UML:Namespace.ownedElement>
<UML:Interface xmi.id = '.:%%COUNTER%%' name = '%%INTERFACENAM
+E%%' visibility = 'public'
isSpecification = 'false' isRoot = 'false' isLeaf = 'false'
+isAbstract = 'false'
isActive = 'false'/>
</UML:Namespace.ownedElement>
%%ENDOFTEMPLATE%%
<UML:Attribute xmi.id = '.:%%COUNTER%%' name = '%%ATTRIBNA
+ME%%' visibility = '%%VISIBILITY%%'
isSpecification = 'false' ownerScope = 'instance' change
+ability = 'changeable'
targetScope = 'instance'>
</UML:Attribute>
%%ENDOFTEMPLATE%%
<UML:Operation xmi.id = '.:%%COUNTER%%' name = '%%METHODNA
+ME%%' visibility = '%%VISIBILITY%%'
isSpecification = 'false' ownerScope = 'instance' isQuer
+y = 'false' concurrency = 'sequential'
isRoot = 'false' isLeaf = 'false' isAbstract = 'false'>
</UML:Operation>
%%ENDOFTEMPLATE%%
<UML:Namespace.ownedElement>
<UML:Generalization xmi.id = '.:%%COUNTER%%' isSpecification =
+ 'false'>
<UML:Generalization.child>
<UML:Class xmi.idref = '.:%%CHILDCOUNTER%%'/>
</UML:Generalization.child>
<UML:Generalization.parent>
<UML:Class xmi.idref = '.:%%PARENTCOUNTER%%'/>
</UML:Generalization.parent>
</UML:Generalization>
</UML:Namespace.ownedElement>
%%ENDOFTEMPLATE%%
<UML:Namespace.ownedElement>
<UML:Association xmi.id = '.:%%COUNTER%%' name = 'uses' isSpec
+ification = 'false'
isRoot = 'false' isLeaf = 'false' isAbstract = 'false'>
<UML:Association.connection>
<UML:AssociationEnd xmi.id = '.:%%USINGENDCOUNTER%%' visib
+ility = 'public'
isSpecification = 'false' isNavigable = 'false' ordering
+ = 'unordered' aggregation = 'none'
targetScope = 'instance' changeability = 'changeable'>
<UML:AssociationEnd.participant>
<UML:Class xmi.idref = '.:%%USINGCLASS%%'/>
</UML:AssociationEnd.participant>
</UML:AssociationEnd>
<UML:AssociationEnd xmi.id = '.:%%USEDENDCOUNTER%%' visibi
+lity = 'public'
isSpecification = 'false' isNavigable = 'true' ordering
+= 'unordered' aggregation = 'none'
targetScope = 'instance' changeability = 'changeable'>
<UML:AssociationEnd.participant>
<UML:Interface xmi.idref = '.:%%USEDCLASS%%'/>
</UML:AssociationEnd.participant>
</UML:AssociationEnd>
</UML:Association.connection>
</UML:Association>
</UML:Namespace.ownedElement>
%%ENDOFTEMPLATE%%
</UML:Model>
</XMI.content>
</XMI>
%%ENDOFTEMPLATE%%
|