Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
#!/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%%

In reply to perltoxmi by g0n

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others exploiting the Monastery: (13)
    As of 2014-08-21 14:26 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The best computer themed movie is:











      Results (136 votes), past polls