Autodia-2.14/0000755000076400007640000000000011567257122012372 5ustar teejayteejayAutodia-2.14/README0000644000076400007640000000576411014517225013254 0ustar teejayteejayINTRODUCTION ------------ AutoDia is an open-source, auto-documentation and auto-diagramming system allowing you to automatically generate Images, XML, HTML or Dia files. It has been written to make GNOME Dia and any Diagram Application that can use similar XML more powerful. I hope to make Dia more popular than the commerical equivilents because of the ability to vastly extend it in this way. It is based on Object Oriented Perl and uses Template Toolkit, GraphViz, and INLINE::Java. AutoDia's design goals have been good Object Orientation such as plenty of abstraction, use of inheritance, extensability, robustness and elegance. Speed and security are not concerns as this application is designed to generate xml for documents in a batch processing manner, not an interactive manner, and is a single user application for use from the console. AutoDia has been previously known as autodial. The output file is still called autodia.out.dia by default. The executable files are now called autodia.pl and autodia_java.pl, the only difference being an additional section near the start of the latter to enable INLINE::Java. STATUS ------ AutoDia currently works on most perl applications, it seems to work on CGI.pm, itself, various projects of my own and friends. If it doesn't work on something, please email aaron.trevena@gmail.com the error message and any extra information or fixes you have. AutoDia now supports any language that has a handler registered in AutoDia.pm. Currently this is a reasonable perl handler and a useful C++ handler. Any language can be supported easily by creating a class that inherits from Handler, as Autodia::Handler::Perl does - the perl handler is a good example and best documented - the C++ and PHP handlers can also be helpful when writing a new handler. I feel that AutoDia does a reasonable job most of the time. There is very little chance of it damaging any files although generated output may crash applications if files are corrupted or contain errors. COPYRIGHT AND LICENSE --------------------- AutoDia is Copyright (c) 2001 Aaron Trevena Licensed under the GNU General Public License (GPL, see file COPYING). CONTACT ------- email me at aaron.trevena@gmail.com, and put "[AutoDia]" in the subject line. DOCUMENTATION ------------- README : this file. COPYING : The GPL License allowing your use and distribution of this code INSTALL : installation guide. UPGRADE : instructions for upgrading older installations. CHANGES : list of changes, new features and bugfixes. FIXES : list of bugfixes (in stable releases only). FAQ : questions and answers for admins. DEVELOP : info for people who want to extend or customize AutoDia BUGS : bugs and caveats not yet fixed CONTRIBUTING ------------ Want to contribute? - Find bugs and submit detailed bug reports - Create/update translations - Create external handler modules To contribute to AutoDia mail me at the below address. -- Aaron Trevena aaron.trevena@gmail.com Author and maintainer. Autodia-2.14/templates/0000755000076400007640000000000011567257122014370 5ustar teejayteejayAutodia-2.14/templates/pod.tt0000644000076400007640000000445511253521455015526 0ustar teejayteejay[% classes = diagram.Classes %] [% FOREACH class = classes %] [% SET filename = class.Name.split('::').join('_') _ ".pod" %] [% USE String %] [% SET filename = String.new(class.Name).replace('::', '_') _ '.pod' %] creating pod for [% class.Name %] : [% filename %] [% FILTER redirect(filename) %] =head1 NAME [%class.Name%] - package for [% class.Name %] =head1 DESCRIPTION description goes here. lorum ipsum =head1 VERSION version 0.00 =head1 SYNOPSIS Quick summary of what the module does. Perhaps a little code snippet. use [%class.Name%]; my $foo = [%class.Name%]->new; [% FOREACH op = class.Operations %] my $xxx = [% class.Name %]->[% op.name %]( .. ); [% END %] [% IF class.Attributes %] =head1 ATTRIBUTES =over 4 [% FOREACH at = class.Attributes %] =item [% at.name %] [% END %] =back [% END %] [% IF class.Operations %] =head1 METHODS [% FOREACH op = class.Operations %] =head2 [% op.name %] my $xxx = [% class.Name %]->[% op.name %] ( [% FOREACH par = op.Param %] [% par.Name %] => xxx [% IF loop.last %] [% ELSE %], [% END %] [% END %] ); takes arguments : [% FOREACH par = op.Param %] [% par.Name %] [% IF loop.last %] [% ELSE %], [% END %] [% END %] returns : [% END %] [% END %] =cut ### CODE GOES HERE ### =head1 NOTES Created using Autodia (http://www.aarontrevena.co.uk/opensource/autodia/index.html) : autodia.pl -l perl -r -d path/to/files -t /path/to/pod.tt -F -O =head1 SEE ALSO [% IF class.Inheritances %] Inherits from : =over 4 [% FOREACH inheritence = class.Inheritances %] [% SET superclass = diagram.object_from_id(inheritence.Parent) %] =item [% superclass.Name%] [% END %] =back [% END %] [% IF class.Dependancies %] Requires / Uses : =over 4 [% FOREACH dependancy = class.Dependancies %] [% SET component = diagram.object_from_id(dependancy.Parent) %] =item [% component.Name %] [% END %] =back [% END %] =head1 AUTHOR A U Thor, C<< >> =head1 BUGS Report bugs via http://rt.cpan.org =head1 COPYRIGHT & LICENSE Copyright A U Thor 2007 All Rights Reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.1 or, at your option, any later version of Perl 5 you may have available. =cut 1; # End of [% class.Name %] [% END %] [% END %] Autodia-2.14/templates/mysql_ddl.tt0000644000076400007640000000065711001402615016717 0ustar teejayteejay[% classes = diagram.Classes %] [% FOREACH class = classes %] CREATE TABLE [% class.Name %] ( [% FOREACH at = class.Attributes %] [% at.name %] [% at.type %] [% IF loop.last %] [% ELSE %], [% END %] [% END %] [% IF class.Operations %] [% FOREACH op = class.Operations %] , [% op.name %] ( [% FOREACH par = op.Param %] [% par.Name %] [% IF loop.last %] ) [% ELSE %], [% END %] [% END %] [% END %] [% END %] ); [% END %] Autodia-2.14/lib/0000755000076400007640000000000011567257122013140 5ustar teejayteejayAutodia-2.14/lib/Autodia.pm0000644000076400007640000001443111567251364015071 0ustar teejayteejaypackage Autodia; use strict; =head1 NAME Autodia.pm - The configuration and Utility perl module for AutoDia. =head1 VERSION 2.14 =head1 DESCRIPTION AutoDia takes source files as input and using a handler parses them to create documentation through templates. The handlers allow AutoDia to parse any language by providing a handler and registering in in autodia.pm. The templates allow the output to be heavily customised from Dia XML to simple HTML and seperates the logic of the application from the presentation of the results. AutoDia is written in perl and defaults to the perl handler and file extension matching unless a language is specified using the -l switch. AutoDia requires Template Toolkit and Perl 5. Some handlers and templates may require additional software. Helpful information, links and news can be found at the autodia website - http://www.aarontrevena.co.uk/opensource/autodia/ =head1 METHODS =over 4 =item getHandlers =item getPattern =item setConfig =back =head1 Configuring AutoDia via Autodia.pm To add handlers or languages edit this file. =over 4 =item To add a handler/parser Add the language or name of the parser and the name of the module to the %handlers hash in the getHandlers function. for example : "perl" => 'HandlerPerl', Documentation on writing your own handler can be found in the HandlerPerl and Handler perl modules =item To add a new language or file extension or file matching patter Add the name of the pattern and a hashreference to its properties to %patterns in the get_patterns function. for example : "perl" => \%perl, Create a hash of its properties that will be pointed to by the above hashref for example : my %perl = ( regex => '\w+\.p[ml]$', wildcards => [ "pl", "pm", ], ); =back =cut ############################################################### BEGIN { use Exporter (); use vars qw($VERSION @ISA @EXPORT); $VERSION = "2.14"; @ISA = qw(Exporter); @EXPORT = qw( &getHandlers &getPattern ); } #--------------- my %config; ############################################################### sub setConfig { %config = %{$_[1]}; } sub getHandlers { my %handlers = ( "perl" => 'Autodia::Handler::Perl', 'c++' => 'Autodia::Handler::Cpp', "csharp" => 'Autodia::Handler::CSharp', "cpp" => 'Autodia::Handler::Cpp', "php" => 'Autodia::Handler::PHP', "dbi" => 'Autodia::Handler::DBI', "dbi_sqlt" => 'Autodia::Handler::DBI_SQLT', "dia" => 'Autodia::Handler::dia', "sql" => 'Autodia::Handler::SQL', "torque" => 'Autodia::Handler::Torque', "python" => 'Autodia::Handler::python', "umbrello" => 'Autodia::Handler::umbrello', "asp" => 'Autodia::Handler::ASP', "mason" => 'Autodia::Handler::Mason', ); print "getting handlers..\n" unless ( $config{silent} ); return \%handlers; } sub getPattern { my $language = lc($config{language}); print "getting pattern for $language\n" unless ( $config{silent} ); my %perl = ( regex => '\w+\.(?:p[ml]|cgi)$', wildcards => [ "pl", "pm", "cgi", ], ); my %php = ( regex => '\w+\.php(?:3|4)?$', wildcards => [ "php", "php3", "php4", ], ); my %cpp = ( regex => '\w+\.(c|cpp|hh?)$', wildcards => [ "c", "cpp", "h","hh" ], ); my %csharp = ( regex => '\w+\.(cs)$', wildcards => [ "cs" ], ); my %python = ( regex => '\w+.py$', wildcards => [ 'py', ] ); my %dia = ( regex => '\w+.dia', wildcards => ['dia'], ); my %sql = ( regex => '\w+.sql', wildcards => ['sql'], ); my %umbrello = ( regex => '\w+.xmi', wildcards => ['xmi'], ); my %asp = ( regex => '\w+.asp', wildcards => ['asp'], ); my %mason = ( regex => '\w+(.(mas|m?html)|handler)$', wildcards => ['mas', 'html', 'mhtml'], ); my %patterns = ( "perl" => \%perl, 'c++' => \%cpp, "cpp" => \%cpp, "csharp" => \%csharp, "php" => \%php, "dbi" => {}, "dia" => \%dia, "sql" => \%sql, "torque" => {}, "python" => \%python, "umbrello" => \%umbrello, "asp" => \%asp, "mason" => \%mason, ); return \%{$patterns{$language}}; } ############################################################### =head1 USAGE use the autodia.pl script to run autodia. =over 4 =item autodia.pl ([-i filename [-p path] ] or [-d directory [-r] ]) [options] =item autodia.pl -i filename : use filename as input =item autodia.pl -i 'filea fileb filec' : use filea, fileb and filec as input =item autodia.pl -i filename -p .. : use ../filename as input file =item autodia.pl -d directoryname : use *.pl/pm in directoryname as input files =item autodia.pl -d 'foo bar quz' : use *pl/pm in directories foo, bar and quz as input files =item autodia.pl -d directory -r : use *pl/pm in directory and its subdirectories as input files =item autodia.pl -o outfile.xml : use outfile.xml as output file (otherwise uses autodial.out.xml) =item autodia.pl -m [file|directory] : use multiple output files split by file or directory (creates an autodia-files directory containing files) =item autodia.pl -O : output to stdout =item autodia.pl -l language : parse source as language (ie: C) and look for appropriate filename extensions if also -d =item autodia.pl -t templatefile : use templatefile as template (otherwise uses template.xml) =item autodia.pl -S : silent mode, no output to stdout except with -O =item autodia.pl -h : display this help message =back =head1 AUTHOR Aaron Trevena, Eaaron.trevena@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2001 - 2007 by Aaron Trevena This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.1 or, at your option, any later version of Perl 5 you may have available. =cut 1; Autodia-2.14/lib/Autodia/0000755000076400007640000000000011567257122014526 5ustar teejayteejayAutodia-2.14/lib/Autodia/Diagram.pm0000644000076400007640000022300211270655601016422 0ustar teejayteejaypackage Autodia::Diagram; use strict; =head1 NAME Autodia::Diagram - Class to hold a collection of objects representing parts of a Dia Diagram. =head1 SYNOPSIS use Autodia::Diagram; my $Diagram = Autodia::Diagram->new; =head2 Description Diagram is an object that contains a collection of diagram elements and the logic to generate the diagram layout as well as to output the diagram itself in Dia's XML format using template toolkit. =cut use Template; use Data::Dumper; $Data::Dumper::Maxdepth = 2; use Autodia::Diagram::Class; use Autodia::Diagram::Component; use Autodia::Diagram::Superclass; use Autodia::Diagram::Dependancy; use Autodia::Diagram::Inheritance; use Autodia::Diagram::Relation; use Autodia::Diagram::Realization; my %dot_filetypes = ( gif => 'as_gif', png => 'as_png', jpg => 'as_jpeg', jpeg => 'as_jpeg', dot => 'as_canon', svg => 'as_svg', fig => 'as_fig', ); my %vcg_filetypes = ( ps => 'as_ps', pbm => 'as_pbm', ppm => 'as_ppm', vcg => 'as_vcg', plainvcg => 'as_plainvcg', ); #---------------------------------------------------------------- # Constructor Methods =head1 METHODS =head2 Class Methods =over 4 =item new - constructor method creates and returns an unpopulated diagram object. =back =cut sub new { my $class = shift; my $config_ref = shift; my $Diagram = {}; bless ($Diagram, ref($class) || $class); $Diagram->directed(1); $Diagram->_initialise($config_ref); return $Diagram; } =head2 Object methods To get a collection of a objects of a certain type you use the method of the same name. ie $Diagram->Classes() returns an array of 'class' objects. The methods available are Classes(), Components(), Superclasses(), Inheritances(), Relations(), and Dependancies(); These are all called in the template to get the collections of objects to loop through. To add an object to the diagram. You call the add_ method, for example $Diagram->add_class($class_name), passing the name of the object in the case of Class, Superclass and Component but not Inheritance or Dependancy which have their names generated automagically. Objects are not removed, they can only be superceded by another object; Component can be superceded by Superclass which can superceded by Class. This is handled by the object itself rather than the diagram. =head2 Accessing and manipulating the Diagram Elements are added to the Diagram through the add_ method (ie add_classes() ). Collections of elements are retrieved through the method (ie Classes() ). The diagram is laid out and output to a file using the export_xml() method. =cut ################ # Access Methods sub directed { my $self = shift; my $value = shift; $self->{directed} = $value if (defined $value); $self->{directed} ||= 0; return $self->{directed}; } sub add_inputfile { my $self = shift; my $inputfile = shift; $self->{input_files}{$inputfile} = 1; return; } sub is_inputfile { my $self = shift; my $name = shift; return $self->{input_files}{$name}; } sub add_dependancy { my $self = shift; my $dependancy = shift; $self->_package_add($dependancy); $dependancy->Set_Id($self->_object_count); return 1; } sub add_realization { my $self = shift; my $realization = shift; $self->_package_add($realization); $realization->Set_Id( $self->_object_count ); return 1; } sub add_inheritance { my $self = shift; my $inheritance = shift; $self->_package_add($inheritance); $inheritance->Set_Id($self->_object_count); return 1; } sub add_relation { my $self = shift; my $relation = shift; $self->_package_add($relation); $relation->Set_Id($self->_object_count); return 1; } sub add_component { my $self = shift; my $component = shift; my $return = 0; # check to see if package of this name already exists my $exists = $self->_package_exists($component); if (ref($exists)) { if ($exists->Type eq "Component") { # replace self with already present component $component->Redundant($exists); $return = $exists; } } else { # component is new and unique $self->_package_add($component); $component->Set_Id($self->_object_count); } return $return; } sub add_superclass { my $self = shift; my $superclass = shift; my $return = 0; # check to see if package of this name already exists my $exists = $self->_package_exists($superclass); if (ref($exists)) { if ($exists->Type eq "superclass") { $return = $exists;} else { print STDERR "eek!! wrong type of object returned by _package_exists\n"; } } else { $self->_package_add($superclass); $superclass->Set_Id($self->_object_count); } return $return; } sub add_class { my $self = shift; my $class = shift; # some perl modules such as CGI.pm do things by redeclaring packages - eek! # this is a nasty hack to get around that nasty hack. ie class is not added # to diagram and so everything is discarded until next new package declared if (defined $self->{"packages"}{"class"}{$class->Name}) { print STDERR "Diagram.pm : add_class : ignoring duplicate class", $class->Name, "\n"; # warn Dumper (original_class=>$self->{"packages"}{"class"}{$class->Name}); return $self->{"packages"}{"class"}{$class->Name}; } # note : when running benchmark.pl this seems to appear which I guess is a # scoping issue when calling autodial multiple times - odd, beware if using # mod_perl or something similar, not that it breaks anything but you never know $class->Set_Id($self->_object_count); $self->_package_add($class); return $class; } sub remove_duplicates { my $self = shift; if (defined $self->{"packages"}{"superclass"}) { my @superclasses = @{$self->Superclasses}; foreach my $superclass (@superclasses) { # if a component exists with the same name as the superclass if (defined $self->{"packages"}{"Component"}{$superclass->Name}) { my $component = $self->{"packages"}{"Component"}{$superclass->Name}; # mark component redundant $component->Redundant; # remove component $self->_package_remove($component); # kill its dependancies foreach my $dependancy ($component->Dependancies) { # remove dependancy $self->_package_remove($dependancy); } } } } if (defined $self->{"packages"}{"class"}) { my @classes = @{$self->Classes}; foreach my $class (@classes) { # if a superclass exists with the same name as the class if (defined $self->{"packages"}{"superclass"}{$class->Name}) { # mark as redundant, remove and steal its children my $superclass = $self->{"packages"}{"superclass"}{$class->Name}; $superclass->Redundant; $self->_package_remove($superclass); foreach my $inheritance ($superclass->Inheritances) { if (ref($inheritance)) { $inheritance->Parent($class->Id); } else { warn "problem with inheritance : $inheritance - class : ",$class->Name,"\n"; } } $class->has_child(scalar $superclass->Inheritances); foreach my $relation ($superclass->Relations) { $relation->Right($class); } } # if a component exists with the same name as the class if (defined $self->{"packages"}{"Component"}{$class->Name}) { # mark as redundant, remove and steal its children my $component = $self->{"packages"}{"Component"}{$class->Name}; $component->Redundant; $self->_package_remove($component); foreach my $dependancy ($component->Dependancies) { $dependancy->Parent($class->Id); } } } } return 1; } ### sub Classes { my $self = shift; my ($cp, $cf, $cl) = caller; my %config = %{$self->{_config}}; unless (defined $self->{packages}{class}) { print STDERR "Diagram.pm : Classes : no Classes to be printed\n"; return 0; } my @classes; my %classes = %{$self->{"packages"}{"class"}}; my @keys = keys %classes; my $i = 0; foreach my $key (@keys) { $classes[$i++] = $classes{$key}; } my $return = \@classes; if (($config{sort}) && ($cp ne "Diagram")) { $return = $self->_sort(\@classes); } return $return; } sub InputFiles { my $self = shift; return $self->{input_files}; } sub Components { my $self = shift; unless (defined $self->{"packages"}{"Component"}) { print STDERR "Diagram.pm : Components : no Components to be printed\n"; return 0; } my @components; my %components = %{$self->{"packages"}{"Component"}}; my @keys = keys %components; my $i = 0; foreach my $key (@keys) { $components[$i++] = $components{$key}; } return \@components; } sub Superclasses { my $self = shift; unless (defined $self->{"packages"}{"superclass"}) { print STDERR "Diagram.pm : Superclasses : no superclasses to be printed\n"; return 0; } my @superclasses; my %superclasses = %{$self->{"packages"}{"superclass"}}; my @keys = keys %superclasses; my $i = 0; foreach my $key (@keys) { $superclasses[$i++] = $superclasses{$key}; } return \@superclasses; } sub Inheritances { my $self = shift; unless (defined $self->{"packages"}{"inheritance"}) { print STDERR "Diagram.pm : Inheritances : no Inheritances to be printed - ignoring..\n"; return 0; } my @inheritances; my %inheritances = %{$self->{"packages"}{"inheritance"}}; my @keys = keys %inheritances; my $i = 0; foreach my $key (@keys) { $inheritances[$i++] = $inheritances{$key}; } return \@inheritances; } sub Relations { my $self = shift; unless (defined $self->{"packages"}{"relation"}) { print STDERR "Diagram.pm : Relations : no Relations to be printed - ignoring..\n"; return 0; } my @relations; my %relations = %{$self->{"packages"}{"relation"}}; my @keys = keys %relations; my $i = 0; foreach my $key (@keys) { $relations[$i++] = $relations{$key}; } return \@relations; } sub Realizations { my $self = shift; unless( defined $self->{"packages"}{"realization"} ) { print STDERR "Realizations Diagram.pm : none to be printed - ignoring..\n "; return 0; } my @realizations; my %realizations = %{ $self->{"packages"}{"realization"} }; my @keys = keys %realizations; my $i = 0; foreach my $key (@keys) { $realizations[ $i++ ] = $realizations{$key}; } return \@realizations; } sub Dependancies { my $self = shift; unless (defined $self->{"packages"}{"dependancy"}) { print STDERR "Diagram.pm : Dependancies : no dependancies to be printed - ignoring..\n"; return 0; } my @dependancies; my %dependancies = %{$self->{"packages"}{"dependancy"}}; my @keys = keys %dependancies; my $i = 0; foreach my $key (@keys) { $dependancies[$i++] = $dependancies{$key}; } return \@dependancies; } ########################################################## # export_graphviz - output to file via GraphViz.pm and dot sub export_graphviz { my $self = shift; require GraphViz; require Data::Dumper; my %config = %{$self->{_config}}; my $output_filename = $config{outputfile}; my ($extension) = reverse (split(/\./,$output_filename)); $extension = "gif" unless ($dot_filetypes{$extension}); $output_filename =~ s/\.[^\.]+$/.$extension/; my %args = (directed => $self->directed, ratio => 'expand', concentrate => 1, splines=>'false', lines=>1); # $args{layout} = 'fdp' unless ($self->directed); # $args{overlap} = 'false' unless ($self->directed); my $g = GraphViz->new( %args ); my %nodes = (); my $classes = $self->Classes; if (ref $classes) { foreach my $Class (@$classes) { my $node = '{'.$Class->Name."|"; if ($config{methods}) { my @method_strings = (); my ($methods) = ($Class->Operations); foreach my $method (@$methods) { next if ($method->{visibility} == 1 && $config{public}); my $method_string = ($method->{visibility} == 0) ? '+ ' : '- '; $method_string .= $method->{name}."("; if (ref $method->{"Params"} ) { my @args = (); foreach my $argument ( @{$method->{"Params"}} ) { push (@args, ((defined ($argument->{Type}) )? $argument->{Type} . " " . $argument->{Name} : $argument->{Name})); } $method_string .= join (", ",@args) if (scalar @args); } $method_string .= " ) : ". (defined $method->{type} ? $method->{type} : ''); push (@method_strings,$method_string); } foreach my $method_string ( @method_strings ) { $node .= "$method_string".'\l'; } } $node .= "|"; if ($config{attributes}) { my ($attributes) = ($Class->Attributes); foreach my $attribute (@$attributes) { next if ($attribute->{visibility} == 1 && $config{public}); $node .= ($attribute->{visibility} == 0) ? '+ ' : '- '; $node .= $attribute->{name}; # Check if $attribute->{type} is defined. # Otherwise we get warnings like: if (defined $attribute->{type}) { $node .= " : ".$attribute->{type}.'\l'; } else { $node .= '\l'; } } } $node .= '}'; $nodes{$Class->Id} = $node; $g->add_node($node,shape=>'record'); } } else { return 0; } unless ($config{skip_superclasses}) { my $superclasses = $self->Superclasses; if (ref $superclasses) { foreach my $Superclass (@$superclasses) { # warn "superclass name :", $Superclass->Name, " id :", $Superclass->Id, "\n"; my $node = $Superclass->Name; $node=~ s/[\{\}]//g; $node = '{'.$node."|\n}"; # warn "node : $node\n"; $nodes{$Superclass->Id} = $node; $g->add_node($node,shape=>'record'); } } } my $inheritances = $self->Inheritances; if (ref $inheritances) { foreach my $Inheritance (@$inheritances) { next unless ($nodes{$Inheritance->Parent}); # warn "inheritance parent :", $Inheritance->Parent, " child :", $Inheritance->Child, "\n"; $g->add_edge($nodes{$Inheritance->Parent} => $nodes{$Inheritance->Child}, dir => 'back'); } } my $relations = $self->Relations; if (ref $relations) { foreach my $Relation (@$relations) { next unless ($nodes{$Relation->Left}); my %edge_args = (dir => 'none', weight => 1.2 ); $g->add_edge($nodes{$Relation->Left} => $nodes{$Relation->Right}, %edge_args); } } unless ($config{skip_packages}) { my $components = $self->Components; if (ref $components) { foreach my $Component (@$components) { # warn "component name :", $Component->Name, " id :", $Component->Id, "\n"; my $node = '{'.$Component->Name.'}'; # warn "node : $node\n"; $nodes{$Component->Id} = $node; $g->add_node($node, shape=>'record'); } } } my $dependancies = $self->Dependancies; if (ref $dependancies) { foreach my $Dependancy (@$dependancies) { # warn "dependancy parent ", $Dependancy->Parent, " child :", $Dependancy->Child, "\n"; next unless ($nodes{$Dependancy->Parent}); $g->add_edge($nodes{$Dependancy->Parent}=>$nodes{$Dependancy->Child}, dir => 'back', style=>'dashed'); } } open (FILE,">$output_filename") or die "couldn't open $output_filename file for output : $!\n"; binmode FILE; eval 'print FILE $g->'. $dot_filetypes{$extension}; close FILE; return 1; } sub Warn { my ($self,$warning) = @_; warn "warning : $warning\n"; return; } ######################################################## # export_springgraph - output to file via SpringGraph.pm sub export_springgraph { my $self = shift; my %config = %{$self->{_config}}; require SpringGraph; require Data::Dumper; my $output_filename = $config{outputfile}; my ($extension) = reverse (split(/\./,$output_filename)); $extension = "gif" unless ($dot_filetypes{$extension}); $output_filename =~ s/\.[^\.]+$/.$extension/; my $g = new SpringGraph; my %nodes = (); my $classes = $self->Classes; if (ref $classes) { foreach my $Class (@$classes) { my $node = $Class->Name."|"; if ($config{methods}) { my @method_strings = (); my ($methods) = ($Class->Operations); foreach my $method (@$methods) { next if ($method->{visibility} == 1 && $config{public}); my $method_string = ($method->{visibility} == 0) ? '+ ' : '- '; $method_string .= $method->{name}."("; if (ref $method->{"Params"} ) { my @args = (); foreach my $argument ( @{$method->{"Params"}} ) { push (@args, ((defined ($argument->{Type}) )? $argument->{Type} . " " . $argument->{Name} : $argument->{Name})); } $method_string .= join (", ",@args) if (scalar @args); } $method_string .= " ) : ". (defined $method->{type} ? $method->{type} : ''); push (@method_strings,$method_string); } foreach my $method_string ( @method_strings ) { $node .= "$method_string\n"; } } $node .= "|"; if ($config{attributes}) { my ($attributes) = ($Class->Attributes); foreach my $attribute (@$attributes) { next if ($attribute->{visibility} == 1 && $config{public}); $node .= "\n" . ($attribute->{visibility} == 0) ? '+ ' : '- '; $node .= $attribute->{name}; $node .= " : ".$attribute->{type} if (defined $attribute->{type}); $node .= "\n"; } } $nodes{$Class->Id} = $Class->Name; $g->add_node($Class->Name, label=>$node,shape=>'record'); } } else { return 0; } unless ($config{skip_superclasses}) { my $superclasses = $self->Superclasses; if (ref $superclasses) { foreach my $Superclass (@$superclasses) { # warn "superclass name :", $Superclass->Name, " id :", $Superclass->Id, "\n"; my $node = $Superclass->Name; $node=~ s/[\{\}]//g; $node .= "|\n"; # warn "node : $node\n"; $nodes{$Superclass->Id} = $node; $g->add_node($node,label=>$node,shape=>'record'); } } } my $inheritances = $self->Inheritances; if (ref $inheritances) { foreach my $Inheritance (@$inheritances) { next unless ($nodes{$Inheritance->Parent}); # warn "inheritance parent :", $Inheritance->Parent, " child :", $Inheritance->Child, "\n"; $g->add_edge( $nodes{$Inheritance->Parent}=>$nodes{$Inheritance->Child}, dir=>'1', ); } } my $relations = $self->Relations; if (ref $relations) { foreach my $Relation (@$relations) { next unless ($nodes{$Relation->Left}); # warn "relation left :", $Relation->Left, " right :", $Relation->Right, "\n"; my %edge_args = ($nodes{$Relation->Left} => $nodes{$Relation->Right}, style => 'dotted'); $g->add_edge(%edge_args); } } unless ($config{skip_packages}) { my $components = $self->Components; if (ref $components) { foreach my $Component (@$components) { # warn "component name :", $Component->Name, " id :", $Component->Id, "\n"; my $node = $Component->Name; # warn "node : $node\n"; $nodes{$Component->Id} = $node; $g->add_node($node,label=>$node, shape=>'record'); } } } my $dependancies = $self->Dependancies; if (ref $dependancies) { foreach my $Dependancy (@$dependancies) { next unless ($nodes{$Dependancy->Parent}); # warn "dependancy parent ", $Dependancy->Parent, " child :", $Dependancy->Child, "\n"; $g->add_edge( $nodes{$Dependancy->Parent}=>$nodes{$Dependancy->Child}, style=>'dashed',dir=>1); } } $g->as_png($output_filename); return 1; } #################################################### # export_vcg - output to file via VCG.pm and xvcg sub export_vcg { my $self = shift; require VCG; require Data::Dumper; my %config = %{$self->{_config}}; my $output_filename = $config{outputfile}; my ($extension) = reverse (split(/\./,$output_filename)); $extension = "pbm" unless ($vcg_filetypes{$extension}); $output_filename =~ s/\.[^\.]+$/.$extension/; my $vcg = VCG->new(scale=>100,); my %nodes = (); my $classes = $self->Classes; if (ref $classes) { foreach my $Class (@$classes) { # warn "class name : ", $Class->Name , " id :", $Class->Id, "\n"; my $node = $Class->Name."\n----------------\n"; if ($config{methods}) { my @method_strings = (); my ($methods) = ($Class->Operations); foreach my $method (@$methods) { next if ($method->{visibility} == 1 && $config{public}); my $method_string = ($method->{visibility} == 0) ? '+ ' : '- '; $method_string .= $method->{name}."("; if (ref $method->{"Params"} ) { my @args = (); foreach my $argument ( @{$method->{"Params"}} ) { push (@args, $argument->{Type} . " " . $argument->{Name}); } $method_string .= join (", ",@args); } $method_string .= " ) : ". $method->{type}; push (@method_strings,$method_string); } foreach my $method_string ( @method_strings ) { $node .= "$method_string\n"; } } $node .= "----------------\n"; if ($config{attributes}) { my ($attributes) = ($Class->Attributes); foreach my $attribute (@$attributes) { next if ($attribute->{visibility} == 1 && $config{public}); $node .= ($attribute->{visibility} == 0) ? '+ ' : '- '; $node .= $attribute->{name}; $node .= " : $attribute->{type} \n"; } } $nodes{$Class->Id} = $node; $vcg->add_node(label=>$node, title=>$node); } } else { return 0; } unless ($config{skip_superclasses}) { my $superclasses = $self->Superclasses; if (ref $superclasses) { foreach my $Superclass (@$superclasses) { # warn "superclass name :", $Superclass->Name, " id :", $Superclass->Id, "\n"; my $node = $Superclass->Name()."\n----------------\n"; $nodes{$Superclass->Id} = $node; $vcg->add_node(title=>$node, label=> $node); } } } my $inheritances = $self->Inheritances; if (ref $inheritances) { foreach my $Inheritance (@$inheritances) { next unless ($nodes{$Inheritance->Parent}); # warn "inheritance parent :", $Inheritance->Parent, " child :", $Inheritance->Child, "\n"; $vcg->add_edge( source=>$nodes{$Inheritance->Parent}, target=>$nodes{$Inheritance->Child}, ); } } my $relations = $self->Relations; if (ref $relations) { foreach my $Relation (@$relations) { next unless ($nodes{$Relation->Left}); # warn "relation left :", $Relation->Left, " right :", $Relation->Right, "\n"; my %edge_args = (source => $nodes{$Relation->Left}, target => $nodes{$Relation->Right}); $vcg->add_edge(%edge_args); } } unless ($config{skip_packages}) { my $components = $self->Components; if (ref $components) { foreach my $Component (@$components) { # warn "component name :", $Component->Name, " id :", $Component->Id, "\n"; my $node = $Component->Name; $nodes{$Component->Id} = $node; $vcg->add_node(label=>$node, title=>$node); } } } my $dependancies = $self->Dependancies; if (ref $dependancies) { foreach my $Dependancy (@$dependancies) { next unless ($nodes{$Dependancy->Parent}); # warn "dependancy parent ", $Dependancy->Parent, " child :", $Dependancy->Child, "\n"; $vcg->add_edge( source=>$nodes{$Dependancy->Parent}, target=>$nodes{$Dependancy->Child}, ); } } open (FILE,">$output_filename") or die "couldn't open $output_filename file for output : $!\n"; binmode FILE; eval 'print FILE $vcg->'. $vcg_filetypes{$extension} or die "can't eval : $! \n";; close FILE; return 1; } #################################################### # export_xml - output to file via template toolkit sub export_xml { my $self = shift; my %config = %{$self->{_config}}; my $output_filename = $config{outputfile}; my $template_file = $config{templatefile} || get_template(%config); if ($config{no_deps}) { $self->_no_deps; } my $success = $self->_layout_dia_new; return 0 unless $success; if (ref $self->Classes) { foreach my $Class ( @{$self->Classes} ) { # warn "handling $Class->{name}\n"; my ($methods) = ($Class->Operations); foreach my $method (@$methods) { $method->{name}=xml_escape($method->{name}); if (ref $method->{"Params"} ) { foreach my $argument ( @{$method->{"Params"}} ) { $argument->{Type} = xml_escape($argument->{Type}) if (defined $argument->{Type}); $argument->{Name} = xml_escape($argument->{Name}); $argument->{Kind} = xml_escape($argument->{Kind}) if (defined $argument->{Kind}); } } } my ($attributes) = ($Class->Attributes); foreach my $attribute (@$attributes) { $attribute->{name} = xml_escape($attribute->{name}); } } } print "\n\n" if ($config{use_stdout}); # use a template for xml output. my $template_conf = { POST_CHOMP => 1, # EVAL_PERL => 1, # debug # INTERPOLATE =>1, # debug # LOAD_PERL => 1, # debug ABSOLUTE => 1, OUTPUT_PATH => '.', }; # cleanup whitespace and allow absolute paths my $template = Template->new($template_conf); my $template_variables = { "diagram" => $self, config => $self->{_config}}; my @template_args = ($template_file,$template_variables); push (@template_args, $output_filename) unless ( $config{use_stdout} ); $template->process(@template_args) || die $template->error(); return 1; } #--------------------------------------------------------------------------------- # Internal Methods sub _no_deps { my $self = shift; print STDERR "skipping dependancies..\n"; undef $self->{packages}{dependancy}; undef $self->{packages}{Component}; return; } sub _initialise { my $self = shift; $self->{_config} = shift; # ref to %conf $self->{"_object_count"} = 0; # keeps count of objects $self->{_nodes} = {}; return; } sub _package_exists # check to see if a package already exists { my $self = shift; my $object = shift; my $return = 0; # check type of object, and only check for relevent packages. SWITCH: { if ($object->Type eq "class") { last SWITCH; } if ($object->Type eq "superclass") { if ($self->{"packages"}{"superclass"}{$object->Name}) { $return = $self->{"packages"}{"superclass"}{$object->Name}; bless ($return, "Autodia::Diagram::Superclass"); } last SWITCH; } if ($object->Type eq "Component") { if ($self->{"packages"}{"Component"}{$object->Name}) { $return = $self->{"packages"}{"Component"}{$object->Name}; bless ($return, "Autodia::Diagram::Component"); } last SWITCH; } } return $return; } sub _object_count { my $self = shift; my $id = $self->{"_object_count"}; $self->{"_object_count"}++; return $id; } sub _package_add { my $self = shift; my $new_package = shift; my @packages; if (defined $self->{$new_package->Type}) { @packages = @{$self->{$new_package->Type}}; } push(@packages, $self->{"_object_count"}); $self->{$new_package->Type} = \@packages; $new_package->LocalId(scalar @packages); $self->{"packages"}{$new_package->Type}{$new_package->Name} = $new_package; if (defined $new_package->Type && defined $new_package->Id) { $self->{"package_types"}{$new_package->Type}{$new_package->Id} = 1; } return 1; } sub _package_remove { my $self = shift; my $package = shift; my @packages = @{$self->{$package->Type}}; $packages[$package->LocalId] = "removed"; $self->{$package->Type} = \@packages; delete $self->{"packages"}{$package->Type}{$package->Name}; return 1; } sub _get_childless_classes { my $self = shift; my @classes; my $childless = $self->Classes; if (ref $childless) { foreach my $class (@$childless) { unless ($class->has_child) { push (@classes, $class); } } } else { warn "Diagram.pm : _get_childless_classes : no classes!\n"; } return @classes; } sub _get_parent_classes { my $self = shift; my @classes; my $parents = $self->Classes; if (ref $parents) { foreach my $class (@$parents) { if ($class->has_child) { push (@classes, $class); } } } else { warn "Diagram.pm : _get_parent_classes : no classes !\n"; } return @classes; } sub _sort { my $self = shift; my @classes = @{shift()}; print "sorting classes alphabetically\n" unless ( $self->{config}->{silent} ); my @sorted_classes = sort {$a->Name cmp $b->Name} @classes; return \@sorted_classes } # now returns 0 if no classes found sub _layout_dia_new { my $self = shift; my %config = %{$self->{_config}}; # build table of nodes and relationships my %nodes = (); my @edges = (); my @rows = (); my @row_heights = (); my @row_widths = (); # - add classes nodes my $classes = $self->Classes; if (ref $classes) { foreach my $Class (@$classes) { # count methods and attributes to give height my $height = 23; my $width = 3 + ( (length ($Class->Name) - 3) * 0.75 ); my ($methods) = ($Class->Operations); if (uc(ref $methods) eq 'SCALAR') { $height += scalar @$methods; } if ($config{attributes}) { my ($attributes) = ($Class->Attributes); if (uc(ref $attributes) eq 'SCALAR') { $height += (scalar @$attributes * 3.2); } } # warn "creating node for class : ", $Class->Id, "\n"; $nodes{$Class->Id} = {parents=>[], weight=>0, center=>[], height=>$height, children=>[], entity=>$Class, width=>$width}; } } # - add superclasses nodes my $superclasses = $self->Superclasses; if (ref $superclasses) { foreach my $Superclass (@$superclasses) { my $width = 3 + ( (length ($Superclass->Name) - 3) * 0.75 ); # warn "creating node for class : ", $Superclass->Id, "\n"; $nodes{$Superclass->Id} = {parents=>[], weight=>0, center=>[], height=>15, children=>[], entity=>$Superclass, width=>$width}; } } # - add package nodes my $components = $self->Components; if (ref $components) { foreach my $Component (@$components) { # warn "creating node for class : ", $Component->Id, "\n"; my $width = 3 + ( (length ($Component->Name) - 3) * 0.55 ); $nodes{$Component->Id} = {parents=>[], weight=>0, center=>[], height=>15, children=>[], entity=>$Component, width=>$width}; } } # - add inheritance edges my $inheritances = $self->Inheritances; if (ref $inheritances) { foreach my $Inheritance (@$inheritances) { push (@edges, { to => $Inheritance->Child, from => $Inheritance->Parent }); } } # - add dependancy edges my $dependancies = $self->Dependancies; if (ref $dependancies) { foreach my $Dependancy (@$dependancies) { push (@edges, { to => $Dependancy->Child, from => $Dependancy->Parent }); } } # add realization edges my $realizations = $self->Realizations; if( ref $realizations ) { foreach my $Realization (@$realizations) { push( @edges, { to => $Realization->Child, from => $Realization->Parent } ); } } # add relation edges my $relations = $self->Relations; if (ref $relations) { foreach my $Relation (@$relations) { push (@edges, { to => $Relation->Left, from => $Relation->Right }); } } # first pass (build network of edges to and from each node) foreach my $edge (@edges) { # warn Dumper (edge=>$edge) unless ($edge->{from} && $edge->{to}); my ($from,$to) = ($edge->{from},$edge->{to}); push(@{$nodes{$to}{parents}},$from); push(@{$nodes{$from}{children}},$to); } # second pass (establish depth ( ie verticle placement of each node ) foreach my $node (keys %nodes) { my $depth = 0; foreach my $parent (@{$nodes{$node}{parents}}) { my $newdepth = get_depth($parent,$node,\%nodes); $depth = $newdepth if ($depth < $newdepth); } $nodes{$node}{depth} = $depth; push(@{$rows[$depth]},$node) } # calculate height and width of diagram in discrete steps my $i = 0; my $widest_row = 0; my $total_height = 0; my $total_width = 0; foreach my $row (@rows) { unless (ref $row) { $row = []; next } my $tallest_node_height = 0; my $widest_node_width = 0; $widest_row = scalar @$row if ( scalar @$row > $widest_row ); my @newrow = (); foreach my $node (@$row) { # warn Dumper(node=>$node); unless (defined $node && defined $nodes{$node}) { warn "warning : empty class/package encountered, skipping"; Dumper(empty_node=>$nodes{$node}); next;} $tallest_node_height = $nodes{$node}{height} if ($nodes{$node}{height} > $tallest_node_height); $widest_node_width = $nodes{$node}{width} if ($nodes{$node}{width} > $widest_node_width); push (@newrow,$node); } $row = \@newrow; $row_heights[$i] = $tallest_node_height + 0.5; $row_widths[$i] = $widest_node_width; $total_height += $tallest_node_height + 0.5 ; $total_width += $widest_node_width; $i++; } # prepare table of available positions my @positions; foreach (@rows) { my %available; @available{(0 .. ($widest_row + 1))} = 1 x ($widest_row + 1); push (@positions,\%available); } my %done = (); $self->{_dia_done} = \%done; $self->{_dia_nodes} = \%nodes; $self->{_dia_positions} = \@positions; $self->{_dia_rows} = \@rows; $self->{_dia_row_heights} = \@row_heights; $self->{_dia_row_widths} = \@row_widths; $self->{_dia_total_height} = $total_height; $self->{_dia_total_width} = $total_width; $self->{_dia_widest_row} = $widest_row; # # plot (relative) position of nodes (left to right, follow branch) my $side; return 0 unless (ref $rows[0]); my @toprow = sort {$nodes{$b}{weight} <=> $nodes{$a}{weight} } @{$rows[0]}; unshift (@toprow, pop(@toprow)) unless (scalar @toprow < 3); my $increment = $widest_row / ( scalar @toprow + 1 ); my $pos = $increment; my $y = 0 - ( ( $self->{_dia_total_height} / 2) - 5 ); my $done2ndrow = 0; foreach my $node ( @toprow ) { my $x = 0 - ( $self->{_dia_row_widths}[0] * $self->{_dia_widest_row} / 2) + ($pos * $self->{_dia_row_widths}[0]); $nodes{$node}{xx} = $x; $nodes{$node}{yy} = $y; $nodes{$node}{entity}->set_location($x,$y); # if (scalar @{$nodes{$node}{children}} && ( scalar @{$rows[1]} > 0)) { if (defined $nodes{$node}{children} && defined $rows[1]) { if (scalar @{$nodes{$node}{children}} && scalar(@rows) && ( scalar @{$rows[1]} > 0)) { my @sorted_children = sort { $nodes{$b}{weight} <=> $nodes{$a}{weight} } @{$nodes{$node}{children}}; unshift (@sorted_children, pop(@sorted_children)); my $child_increment = $widest_row / (scalar @{$rows[1]}); my $childpos = $child_increment; # foreach my $child (@{$nodes{$node}{children}}) { foreach my $child (@sorted_children) { my $side; if ($childpos <= ( $widest_row * 0.385 ) ) { $side = 'left'; } elsif ( $childpos <= ($widest_row * 0.615 ) ) { $side = 'center'; } else { $side = 'right'; } plot_branch($self,$nodes{$child},$childpos,$side); $childpos += $child_increment; } } elsif ( defined $rows[1] && scalar @{$rows[1]} && $done2ndrow == 0) { $done2ndrow = 1; foreach my $node ( @{$rows[1]} ) { # warn "handling node in next row\n"; # warn Dumper(node=>$node{$node}); my $x = 0 - ( $self->{_dia_row_widths}[1] * $self->{_dia_widest_row} / 2) + ($pos * $self->{_dia_row_widths}[1]); $nodes{$node}{x} = $x; $nodes{$node}{'y'} = $y; if (scalar @{$nodes{$node}{children}} && scalar @{$rows[2]}) { my @sorted_children = sort { $nodes{$b}{weight} <=> $nodes{$a}{weight} } @{$nodes{$node}{children}}; unshift (@sorted_children, pop(@sorted_children)); my $child_increment = $widest_row / (scalar @{$rows[2]}); my $childpos = $child_increment; # foreach my $child (@{$nodes{$node}{children}}) { foreach my $child (@sorted_children) { # warn "child : $child\n"; next unless ($child); my $side; if ($childpos <= ( $widest_row * 0.385 ) ) { $side = 'left'; } elsif ( $childpos <= ($widest_row * 0.615 ) ) { $side = 'center'; } else { $side = 'right'; } plot_branch($self,$nodes{$child},$childpos,$side); $childpos += $child_increment; } } } } } $nodes{$node}{pos} = $pos; $pos += $increment; $done{$node} = 1; } my @relationships = (); if (ref $self->Dependancies) { push(@relationships, @{$self->Dependancies}); } if( ref $self->Realizations ) { push( @relationships, @{ $self->Realizations } );} if (ref $self->Inheritances) { push(@relationships, @{$self->Inheritances}); } if (ref $self->Relations) { push(@relationships, @{$self->Relations}); } foreach my $relationship (@relationships) { $relationship->Reposition; } $self->{_nodes} = \%nodes; return 1; } sub object_from_id { my ($self, $id) = @_; my $object; if (ref $self->{_nodes}) { $object = $self->{_nodes}{$id}{entity}; }; return $object; } # ## Functions used by _layout_dia_new method # # recursively calculate the depth of a node by following edges to its parents sub get_depth { my ($node,$child,$nodes) = @_; my $depth = 0; $nodes->{$node}{weight}++; if (exists $nodes->{$node}{depth}) { $depth = $nodes->{$node}{depth} + 1; } else { $nodes->{$node}{depth} = 1; my @parents = @{$nodes->{$node}{parents}}; if (scalar @parents > 0) { foreach my $parent (@parents) { my $newdepth = get_depth($parent,$node,$nodes); $depth = $newdepth if ($depth < $newdepth); } $depth++; } else { $depth = 1; $nodes->{$node}{depth} = 0; } } return $depth; } # recursively plot the branches of a tree sub plot_branch { my ($self,$node,$pos,$side) = @_; # warn "plotting branch : ", $node->{entity}->Name," , $pos, $side\n"; my $depth = $node->{depth}; my $offset = 0.8; my $h = 0; while ( $h < $depth ) { $offset += $self->{_dia_row_heights}[$h++] + 0.1; } # warn Dumper(node=>$node); my (@parents,@children) = ($node->{parents},$node->{children}); if ( $self->{_dia_done}{$node->{entity}->Id} && (scalar @children < 1) ) { if (scalar @parents > 1 ) { $self->{_dia_done}{$node}++; my $sum = 0; foreach my $parent (@parents) { return 0 unless (exists $self->{_dia_nodes}{$parent->{entity}->Id}{pos}); $sum += $self->{_dia_nodes}{$parent->{entity}->Id}{pos}; } $self->{_dia_positions}[$depth]{int($pos)} = 1; my $newpos = ( $sum / scalar @parents ); unless (exists $self->{_dia_positions}[$depth]{int($newpos)}) { # use wherever is free if position already taken my $best_available = $pos; my $diff = ($best_available > $newpos ) ? $best_available - $newpos : $newpos - $best_available ; foreach my $available (keys %{$self->{_dia_positions}[$depth]}) { my $newdiff = ($available > $newpos ) ? $available - $newpos : $newpos - $available ; if ($newdiff < $diff) { $best_available = $available; $diff = $newdiff; } } $pos = $best_available; } else { $pos = $newpos; } } my $y = 0 - ( ( $self->{_dia_total_height} / 2) - 4 ) + $offset; print "y : $y\n"; my $x = 0 - ( $self->{_dia_row_widths}[$depth] * $self->{_dia_widest_row} / 2) + ($pos * $self->{_dia_row_widths}[$depth]); # my $x = 0 - ( $self->{_dia_widest_row} / 2) + ($pos * $self->{_dia_row_widths}[$depth]); $node->{xx} = int($x); $node->{yy} = int($y); $node->{entity}->set_location($x,$y); $node->{pos} = $pos; delete $self->{_dia_positions}[$depth]{int($pos)}; # warn "node ", $node->{entity}->Name(), " : $pos xx : ", $node->{xx} ," yy : ",$node->{yy} ,"\n"; return 0; } elsif ($self->{_dia_done}{$node}) { # warn "node ", $node->{entity}->Name(), " : $node->{pos}\n"; return 0; } unless (exists $self->{_dia_positions}[$depth]{int($pos)}) { my $best_available; my $diff = $self->{_dia_widest_row} + 5; foreach my $available (keys %{$self->{_dia_positions}[$depth]}) { $best_available ||= $available; my $newdiff = ($available > $pos ) ? $available - $pos : $pos - $available ; if ($newdiff < $diff) { $best_available = $available; $diff = $newdiff; } } $pos = $best_available; } delete $self->{_dia_positions}[$depth]{int($pos)}; my $y = 0 - ( ( $self->{_dia_total_height} / 2) - 1 ) + $offset; my $x = 0 - ( $self->{_dia_row_widths}[0] * $self->{_dia_widest_row} / 2) + ($pos * $self->{_dia_row_widths}[0]); # my $x = 0 - ( $self->{_dia_widest_row} / 2) + ($pos * $self->{_dia_row_widths}[$depth]); # my $x = 0 - ( ( $pos * $self->{_dia_row_widths}[0] ) / 2); $node->{xx} = int($x); $node->{yy} = int($y); $node->{entity}->set_location($x,$y); $self->{_dia_done}{$node} = 1; $node->{pos} = $pos; if (scalar @{$node->{children}}) { my @sorted_children = sort { $self->{_dia_nodes}{$b}{weight} <=> $self->{_dia_nodes}{$a}{weight} } @{$node->{children}}; unshift (@sorted_children, pop(@sorted_children)); my $child_increment = (ref $self->{_dia_rows}[$depth + 1]) ? $self->{_dia_widest_row} / (scalar @{$self->{_dia_rows}[$depth + 1]} || 1) : 0 ; my $childpos = 0; if ( $side eq 'left' ) { $childpos = 0 } elsif ( $side eq 'center' ) { $childpos = $pos; } else { $childpos = $pos + $child_increment; } foreach my $child (@{$node->{children}}) { $childpos += $child_increment if (plot_branch($self,$self->{_dia_nodes}{$child},$childpos,$side)); } } elsif ( scalar @parents == 1 ) { my $y = 0 - ( ( $self->{_dia_total_height} / 2) - 1 ) + $offset; my $x = 0 - ( $self->{_dia_row_widths}[0] * $self->{_dia_widest_row} / 2) + ($pos * $self->{_dia_row_widths}[0]); # my $x = 0 - ( $self->{_dia_widest_row} / 2) + ($pos * $self->{_dia_row_widths}[$depth]); # my $x = 0 - ( ( $pos * $self->{_dia_row_widths}[0] ) / 2); $node->{xx} = int($x); $node->{yy} = int($y); $node->{entity}->set_location($x,$y); } # warn "node ", $node->{entity}->Name(), " : $pos xx : ", $node->{xx} ," yy : ",$node->{yy} ,"\n"; return 1; } # ######################################## # sub _layout { my $self = shift; my @columns; my @orphan_classes; my $column_count=0; # populate a grid to be used for laying out the diagram. # put each parent class in a column my @parent_classes = $self->_get_parent_classes; my %parent_class; foreach my $class (@parent_classes) { $parent_class{$class->Id} = $column_count; if (defined $columns[$column_count][2][0]) { push (@{$columns[$column_count][2]},$class); } else { $columns[$column_count][2][0] = $class; } $column_count++; } $column_count = 0; my @childless_classes = $self->_get_childless_classes; # put each child class in its parent column foreach my $class (@childless_classes) { if (defined $class->Inheritances) { my ($inheritance) = $class->Inheritances; my $parents_column = $parent_class{$inheritance->Parent} || 0; push (@{$columns[$parents_column][3]},$class); } else { push (@orphan_classes,$class); } } $column_count++; foreach my $orphan (@orphan_classes) { push (@{$columns[$column_count][3]}, $orphan); } # put components in columns with the most of their kids if (ref $self->Components) { my @components = @{$self->Components}; foreach my $component (@components) { my $i =0; my $current_column = 0; my $current_children = 0; # find column with most children my %child_ids = (); my @children = $component->Dependancies; foreach my $child (@children) { $child_ids{$child->Child} = 1; } foreach my $column (@columns) { if (ref $column) { my @column = @$column; next unless (defined $column); my $children = 0; foreach my $subcolumn (@column) { foreach my $child (@$subcolumn) { if (defined $child_ids{$child->Id}) { $children++; } } } if ($children > $current_children) { $current_column = $i; $current_children = $children; } $i++; } else { print STDERR "Diagram.pm : _layout() : empty column .. skipping\n"; } } push(@{$columns[$current_column][0]},$component); } } else { print STDERR "Diagram.pm : _layout() : no components / dependancies\n"; } if (ref $self->Superclasses) { my @superclasses = @{$self->Superclasses}; # put superclasses in columns with most of their kids foreach my $superclass (@superclasses) { my $i=0; my $current_column = 0; my $current_children = 0; # find column with most children my %child_ids = (); my @children = $superclass->Inheritances; foreach my $child (@children) { $child_ids{$child->Child} = 1; } foreach my $column (@columns) { if (ref $column) { my @column = @$column; my $children = 0; foreach my $subcolumn (@column) { foreach my $child (@$subcolumn) { if (defined $child_ids{$child->Id}) { $children++; } } } if ($children > $current_children) { $current_column = $i; $current_children = $children; } $i++; } else { print STDERR "Diagram.pm : _layout() : empty column .. skipping\n"; } } push(@{$columns[$current_column][1]},$superclass); } } else { print STDERR "Diagram.pm : _layout() : no superclasses / inheritances\n"; } # grid now created - Components in top row, superclasses in second, # classes with subclasses in 3rd row, childless & orphan classes in 4th row. # now we position the contents of the grid. my $next_row_y = 0; my $next_col_x = 0; my ($colspace, $rowspace) = (1.5 , 0.5); foreach my $column (@columns) { my $x = $next_col_x; foreach my $subcolumn (@$column) { my $count = 0; my $y = $next_row_y; $next_row_y += 3; foreach my $entity (@$subcolumn) { my $next_xy = $entity->set_location($x,$y); ($x,$y) = @$next_xy; $x-=3; $y-=(2+($entity->Height/5)); if ($count >= 4) { $next_row_y = 0; $y = 0; $x += $colspace; $count = 0; } $count++; } $y += $rowspace; } $x += $colspace; $next_col_x = $x; } my @relationships = (); if (ref $self->Dependancies) { push(@relationships, @{$self->Dependancies}); } if( ref $self->Realizations ) { push( @relationships, @{ $self->Realizations } );} if (ref $self->Inheritances) { push(@relationships, @{$self->Inheritances}); } foreach my $relationship (@relationships) { $relationship->Reposition; } return 1; } sub xml_escape { my $retval = shift; return '' unless $retval; $retval =~ s/\&/\&/; $retval =~ s/\'/\"/; $retval =~ s/\"/\"/; $retval =~ s/\/\>/; return $retval; } sub get_template { my %config = @_; # warn "get_template called : outfile -- $config{outputfile}\n"; my $template; TEMPLATE_SWITCH: { if ($config{outputfile} =~ /\.xmi$/) { $template = get_umbrello_template($config{outputfile}); last TEMPLATE_SWITCH; } $template = get_default_template($config{outputfile}); } # end of TEMPLATE_SWITCH # warn "template : ", $template, "\n"; # NOTE: $template should always be a ref to a string return $template; } sub get_umbrello_template { my $outfile = shift; warn "using umbrello template for $outfile\n"; my $pwd = $ENV{PWD}; my $template =< umbrello uml modeller http://uml.sf.net 1.1 [%# -------------------------------------------- %] [% classes = diagram.Classes %] [% xmictr = 1 %] [% FOREACH class = classes %] [% xmictr = xmictr + 1 %] [% FOREACH at = class.Attributes %] [% END %] [% FOREACH op = class.Operations %] [% FOREACH par = op.Params %] [% END %] [% END %] [% END %] [% SET superclasses = diagram.Superclasses %] [% FOREACH superclass = superclasses %] [% END %] [% SET components = diagram.Components %] [% FOREACH component = components %] [% FOREACH at = class.Attributes %] [% xmictr = xmictr + 1 %] [% END %] [% FOREACH op = class.Operations %] [% xmictr = xmictr + 1 %] [% FOREACH par = op.Params %] [% xmictr = xmictr + 1 %] [% END %] [% END %] [% END %] [% SET inheritances = diagram.Inheritances %] [% FOREACH inheritance = inheritances %] [%- IF inheritance.Parent >0 AND inheritance.Child >0 -%] [%- END %] [% END %] [% SET dependencies = diagram.Dependancies %] [% FOREACH dependency = dependencies %] [% END %] [%# -------------------------------------------- %] [% classes = diagram.Classes %] [% FOREACH class = classes %] [% END %] [% SET superclasses = diagram.Superclasses %] [% FOREACH class = superclasses %] [% xmictr = xmictr + 1 %] [% END %] [% SET inheritances = diagram.Inheritances %] [% FOREACH inheritance = inheritances %] [%- IF inheritance.Parent >0 AND inheritance.Child >0 -%] [%- END %] [% END %] [% SET dependencies = diagram.Dependancies %] [% FOREACH dependency = dependencies %] [%- IF dependency.Parent >0 AND dependency.Child >0 -%] [%- END %] [% END %] END_UMBRELLO_TEMPLATE return \$template; } sub get_default_template { warn "using default (dia) template\n"; my $template = <<'END_TEMPLATE'; [%# #################################################### %] [%# Autodia Template for Dia XML. (c)Copyright 2001-2004 %] [%# #################################################### %] #A4# [%# -------------------------------------------- %] [% classes = diagram.Classes %] [% FOREACH class = classes %] #[% class.Name | html %]# [% IF class.Parent %] #[% class.Parent | html %]# [% ELSE %] [% END %] [% IF class.Attributes %] [% FOREACH at = class.Attributes %] #[% at.name FILTER html %]# #[% at.type FILTER html %]# [% at.value | html %] [% END %] [% ELSE %] [% END %] [% IF class.Operations %] [% FOREACH op = class.Operations %] #[% op.name FILTER html %]# [% IF op.type %] #[% op.type FILTER html %]# [% ELSE %] [% END %] [% IF op.Params.0 %] [% FOREACH par = op.Params %] #[% par.Name FILTER html %]# #[% par.Type FILTER html %]# [% IF par.Value %] [% ELSE %] [% END %] [% IF par.Kind %] [% ELSE %] [% END %] [% END %] [% ELSE %] [% END %] [% END %] [% ELSE %] [% END %] [% END %] [%#%] [% UNLESS config.skip_packages %] [% SET components = diagram.Components %] [%#%] [% FOREACH component = components %] #[% component.Name | html %]# [% END %] [% # %] [% SET realizations = diagram.Realizations %] [% # %] [% FOREACH realization = realizations %] [% END %] [% # %] [% SET dependancies = diagram.Dependancies %] [% # %] [% FOREACH dependancy = dependancies %] [% END %] [% END %] [% # %] [% UNLESS config.skip_superclasses %] [% SET superclasses = diagram.Superclasses %] [% # %] [% FOREACH superclass = superclasses %] #[% superclass.Name %]# [% END %] [% END %] [% #### %] [% SET inheritances = diagram.Inheritances %] [% FOREACH inheritance = inheritances %] [% IF config.skip_superclasses %] [% SET parent = inheritance.Parent %] [% UNLESS diagram.package_types.class.$parent %] [% NEXT %] [% END %] [% END %] [% END %] [% SET relations = diagram.Relations %] [% FOREACH relation = relations %] ## ## ## ## ## [% END %] END_TEMPLATE return \$template; } 1; ################################################################## =head2 See Also Autodia Autodia::Diagram::Object Autodia::Diagram::Class Autodia::Diagram::Superclass Autodia::Diagram::Component Autodia::Diagram::Inheritance Autodia::Diagram::Relation Autodia::Diagram::Dependancy =head1 AUTHOR Aaron Trevena, Eaaron.trevena@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2004 by Aaron Trevena This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.1 or, at your option, any later version of Perl 5 you may have available. =cut ######################################################################## Autodia-2.14/lib/Autodia/Handler.pm0000644000076400007640000001172411566443227016450 0ustar teejayteejay################################################################ # AutoDIA - Automatic Dia XML. (C)Copyright 2001 A Trevena # # # # AutoDIA comes with ABSOLUTELY NO WARRANTY; see COPYING file # # This is free software, and you are welcome to redistribute # # it under certain conditions; see COPYING file for details # ################################################################ package Autodia::Handler; use strict; require Exporter; use vars qw($VERSION @ISA @EXPORT); @ISA = qw(Exporter); use Autodia::Diagram; #--------------------------------------------------------------- ##################### # Constructor Methods sub new { my $class = shift(); my $self = {}; my $config = shift; bless ($self, ref($class) || $class); $self->_initialise($config); return $self; } #------------------------------------------------------------------------ # Access Methods =head2 process parse file(s), takes hashref of configuration, returns no of files processed =cut sub process { my $self = shift; my %config = %{$self->{Config}}; my $processed_files = 0; my ($ignore_path) = grep { warn "$_" && $config{inputpath} eq $_.'/' } @{$config{directory}}; foreach my $filename (@{$config{filenames}}) { my $current_file = ($ignore_path) ? $filename : $config{inputpath} . $filename ; $current_file =~ s|\/+|/|g; print "opening $current_file\n" unless ( $config{silent} ); $self->_reset() if ($config{singlefile}); $self->_parse_file($current_file) or warn "no such file / database - $current_file \n"; $self->output($current_file) if ($config{singlefile}); $processed_files++; } return $processed_files; } sub skip { my ($self,$object_name) = @_; my $skip = 0; my $skip_list = $self->{Config}{skip_patterns}; if (ref $skip_list) { foreach my $pattern (@$skip_list) { chomp($pattern); if ($object_name =~ m/$pattern/) { warn "skipping $object_name : matches $pattern\n" unless ($self->{_config}{silent}); $skip = 1; last; } } } return $skip; } sub output { my $self = shift; my $alternative_filename = shift; my $Diagram = $self->{Diagram}; my %config = %{$self->{Config}}; if (defined $alternative_filename ) { foreach my $dir (@{$config{'directory'}}) { $alternative_filename =~ s|^$dir||g; } $alternative_filename =~ s|\/|-|g; $alternative_filename =~ s|^-||; } $Diagram->remove_duplicates; # export output my $success = 0; OUTPUT_TYPE: { if ($config{graphviz}) { $self->{Config}{outputfile} = "$alternative_filename.png" if ($config{singlefile}); $success = $Diagram->export_graphviz(\%config); last; } if ($config{springgraph}) { $self->{Config}{outputfile} = "$alternative_filename.png" if ($config{singlefile}); $success = $Diagram->export_springgraph(\%config); last; } if ($config{vcg}) { $self->{Config}{outputfile} = "$alternative_filename.ps" if ($config{singlefile}); $success = $Diagram->export_vcg(\%config); last; } # default to XML output $self->{Config}{outputfile} = "$alternative_filename.xml" if ($config{singlefile}); $success = $Diagram->export_xml(\%config); } # end of OUTPUT_TYPE; if ($success) { warn "written outfile : $config{outputfile} successfully \n"; } else { warn "nothing to output using $config{language} handler - are you sure you set the language correctly ?\n"; } return 1; } #----------------------------------------------------------------------------- # Internal Methods sub _initialise { my $self = shift; my $config_ref = shift; my $Diagram = Autodia::Diagram->new($config_ref); $self->{Config} = $config_ref || (); $self->{Diagram} = $Diagram; return 1; } sub _reset { my $self = shift; my $config_ref = $self->{Config}; my $Diagram = Autodia::Diagram->new($config_ref); $self->{Diagram} = $Diagram; return 1; } sub _error_file { my $self = shift; $self->{file_open_error} = 1; print "Handler.pm : _error_file : error opening file $! \n"; #$error_message\n"; return 1; } sub _parse { print "parsing file \n"; return; } sub _parse_file { my $self = shift(); my $filename = shift(); my %config = %{$self->{Config}}; my $infile = (defined $config{inputpath}) ? $config{inputpath} . $filename : $filename ; $self->{file_open_error} = 0; open (INFILE, "<$infile") or $self->_error_file(); if ($self->{file_open_error} == 1) { warn " couldn't open file $infile \n"; print "skipping $infile..\n"; return 0; } $self->_parse (\*INFILE,$filename); close INFILE; return 1; } 1; ############################################################################### =head1 NAME Handler.pm - generic language handler superclass =head1 CONSTRUCTION METHOD Not actually used but subclassed ie HandlerPerl or HandlerC as below: my $handler = HandlerPerl->New(\%Config); =cut Autodia-2.14/lib/Autodia/Diagram/0000755000076400007640000000000011567257122016072 5ustar teejayteejayAutodia-2.14/lib/Autodia/Diagram/Realization.pm0000644000076400007640000000650411220401547020702 0ustar teejayteejay################################################################ # AutoDia - Automatic Dia XML.(C)Copyright 2001-2009 A Trevena # # # # AutoDia comes with ABSOLUTELY NO WARRANTY; see COPYING file # # This is free software, and you are welcome to redistribute # # it under certain conditions; see COPYING file for details # ################################################################ package Autodia::Diagram::Realization; use strict; use vars qw($VERSION @ISA @EXPORT); use Exporter; use Autodia::Diagram::Object; use Data::Dumper; @ISA = qw(Autodia::Diagram::Object); my $dependancy_count = 0; #--------------------------------------------------------------------- # Constructor Methods sub new { my $class = shift; my $child = shift; my $parent = shift; my $DiagramDependancy = {}; bless( $DiagramDependancy, ref($class) || $class ); $DiagramDependancy->_initialise( $child, $parent ); return $DiagramDependancy; } #----------------------------------------------------------------------- # Access Methods sub Parent { my $self = shift; my $parent = shift; my $return_val = 1; if( defined $parent ) { $self->{"parent"} = $parent; } else { $return_val = $self->{"parent"}; } return $return_val; } sub Child { my $self = shift; my $child = shift; my $return_val = 1; if( defined $child ) { $self->{"child"} = $child; } else { $return_val = $self->{"child"}; } return $return_val; } sub Name { my $self = shift; my $name = shift; if( defined $name ) { $self->{"name"} = $name; return 1; } else { return $self->{"name"}; } } sub Orth_Top_Right { my $self = shift; return $self->{"top_connection"}; } sub Orth_Bottom_Left { my $self = shift; return $self->{"bottom_connection"}; } sub Orth_Mid_Left { my $self = shift; my $return = ( $self->{"left_x"} ) . "," . $self->{"mid_y"}; return $return; } sub Orth_Mid_Right { my $self = shift; my $return = ( $self->{"right_x"} ) . "," . $self->{"mid_y"}; return $return; } sub Reposition { my $self = shift; my $child = $self->{"_child"}; my( $left_x, $bottom_y ) = split( ",", $child->TopLeftPos ); my $mid_y = $bottom_y - 1.5; my $top_y = $mid_y - 1.5; $left_x += 2 + ( $child->Width / 2 ); my $right_x = $left_x + 5; $self->{"left_x"} = $left_x; ( $self->{"right_x"}, $self->{"top_y"}, $self->{"mid_y"}, $self->{"bottom_y"} ) = ( $right_x, $top_y, $mid_y, $bottom_y ); $self->{"top_connection"} = $self->{right_x} . "," . $self->{"top_y"}; $self->{"bottom_connection"} = $left_x . "," . $bottom_y; return 1; } #----------------------------------------------------------- # Internal Methods sub _initialise # over-rides method in DiagramObject { my $self = shift; my $child = shift; my $parent = shift; $self->{"_child"} = $child; $self->{"child"} = $child->Id; $self->{"type"} = "realization"; $self->{"_parent"} = $parent; $self->{"parent"} = $parent->Id; $self->{"name"} = $self->{"parent"} . "-" . $self->{"child"}; return 1; } sub _update # over-rides method in DiagramObject { my $self = shift; $self->Reposition(); return 1; } 1; ############################################################################ =head1 =cut Autodia-2.14/lib/Autodia/Diagram/Object.pm0000644000076400007640000000637111001402615017623 0ustar teejayteejay################################################################ # AutoDia - Automatic Dia XML. (C)Copyright 2001 A Trevena # # # # AutoDia comes with ABSOLUTELY NO WARRANTY; see COPYING file # # This is free software, and you are welcome to redistribute # # it under certain conditions; see COPYING file for details # ################################################################ package Autodia::Diagram::Object; use strict; require Exporter; use vars qw($VERSION @ISA @EXPORT); @ISA = qw(Exporter); #--------------------------------------------------------------- ##################### # Constructor Methods sub new { my $class = shift; my $self = {}; bless ($self, ref($class) || $class); $self->_initialise(); return $self; } #------------------------------------------------------------------------ # Access Methods sub set_location { my $self = shift; my $new_x = shift || 1; my $new_y = shift || 1; if (defined $new_x ) { $self->{"left_x"} = $new_x; $self->{"top_y"} = $new_y; } my @bottom_right_xy = split(",",$self->BottomRightPos); return \@bottom_right_xy; } sub TopLeftPos { my $self = shift; my $return = sprintf("%.3f",$self->{"left_x"}) . "," . sprintf("%.3f",$self->{"top_y"}); return $return; } sub BottomRightPos { my $self = shift; $self->{"left_x"} ||= 1; # hack $self->{"width"} ||= 1; # these aren't getting initialised for some reason $self->{"top_y"} ||= 1; $self->{"height"} ||= 1; my $x = sprintf("%.3f",$self->{"width"} + $self->{"left_x"}); my $y = sprintf("%.3f",$self->{"top_y"} + $self->{"height"}); return "$x,$y"; } sub Width { my $self = shift; return sprintf("%.3f",$self->{"width"}); } sub Height { my $self = shift; return sprintf("%.3f",$self->{"height"}); } sub Id { my $self = shift; return $self->{"id"}; } sub Set_Id { my $self = shift; $self->{"id"} = shift; return 1; } sub Type { my $self = shift; my $return_val = "-"; my $type = $self->{"type"} || 0; if ($type) { $return_val = $type; } return $return_val; } sub Name { my $self = shift; my $name = shift; if ($name) { $self->{"name"} = $name; return 1; } else { return $self->{"name"}; } } sub LocalId { my $self = shift; my $new_id = shift; my $return = 1; if (defined $new_id) { $self->{"local_id"} = $new_id; } else { $return = $self->{"local_id"}; } return $return; } #----------------------------------------------------------------------------- # Internal Methods sub _initialise { my $self = shift; $self->{"width"} = 1; $self->{"height"} = 1; $self->{"name"} = ""; $self->{"top_y"} = 0; $self->{"left_x"} = 0; return; } sub _update { return 1; } sub _width { my $self = shift; $self->{"width"} = 0.5 + (0.6 * length($self->{"name"})); return 1; } sub _height { my $self = shift; $self->{"height"} = 2.5; return 1; } sub _set_updated { my $self = shift; my $field = shift; ${$self->{"_updated"}}{$field} = 1; return 1; } 1; ############################################################################### =head1 =cut Autodia-2.14/lib/Autodia/Diagram/Relation.pm0000644000076400007640000000617611015050661020202 0ustar teejayteejay################################################################ # Autodia - Automatic Dia XML. Copyright 2001 - 2008 A Trevena # # # # AutoDIA comes with ABSOLUTELY NO WARRANTY; see COPYING file # # This is free software, and you are welcome to redistribute # # it under certain conditions; see COPYING file for details # ################################################################ package Autodia::Diagram::Relation; use strict; use vars qw($VERSION @ISA @EXPORT); use Exporter; use Autodia::Diagram::Object; @ISA = qw(Autodia::Diagram::Object); my $relation_count = 0; #-------------------------------------------------------------------- # Constructor Methods sub new { my $class = shift; my $left = shift; my $right = shift; my $DiagramRelation = {}; bless ($DiagramRelation, ref($class) || $class); $DiagramRelation->_initialise($left, $right); return $DiagramRelation; } #-------------------------------------------------------------------- # Access Methods sub Left { my $self = shift; my $left = shift; if (defined $left) { $self->{"left"} = $left; } return $self->{"left"}; } sub Right { my $self = shift; my $right = shift; if (defined $right){ $self->{"_right"} = $right; $self->{"right"} = $right->Id; } return $self->{"right"}; } sub Name { my $self = shift; my $name = shift; if (defined $name) { $self->{"name"} = $name; } return $self->{"name"}; } sub Orth_Top_Left { my $self = shift; return $self->{"top_connection"}; } sub Orth_Bottom_Right { my $self = shift; return $self->{"bottom_connection"}; } sub Orth_Mid_Left { my $self = shift; my $return = ($self->{"left_x"}). "," . $self->{"mid_y"}; return $return; } sub Orth_Mid_Right { my $self = shift; my $return = ($self->{"right_x"}). "," . $self->{"mid_y"}; return $return; } sub Reposition { my $self = shift; my $right = $self->{"_right"}; my ($right_x,$bottom_y) = split (",",$right->TopLeftPos); my $mid_y = $bottom_y - 1.5; my $top_y= $mid_y - 1.5; $right_x += 2 + ($right->Width / 2); my $left_x = $right_x - 5; $self->{"left_x"} = $left_x; ($self->{"right_x"}, $self->{"top_y"}, $self->{"mid_y"}, $self->{"bottom_y"}) = ($right_x, $top_y, $mid_y, $bottom_y); $self->{"top_connection"} = $self->{left_x} . "," . $self->{"top_y"}; $self->{"bottom_connection"} = $right_x . "," . $bottom_y; return 1; } #------------------------------------------------------ # Internal Methods sub _initialise # over-rides method in DiagramObject { my $self = shift; my $left = shift; my $right = shift; $self->{"_right"} = $right; $self->{"right"} = $right->Id; $self->{"type"} = "relation"; $self->{"_left"} = $left; $self->{"left"} = $left->Id; $self->{"name"} = $self->{"left"}."-".$self->{"right"}; # TODO: # add left label and right label # check for existing relationship between two objects, re-use that one if exists and set reverse label from that return 1; } sub _update # over-rides method in DiagramObject { my $self = shift; $self->reposition(); return 1; } 1; Autodia-2.14/lib/Autodia/Diagram/Dependancy.pm0000644000076400007640000000635611001402615020472 0ustar teejayteejay################################################################ # AutoDIAL - Automatic Dia XML. (C)Copyright 2001 A Trevena # # # # AutoDIAL comes with ABSOLUTELY NO WARRANTY; see COPYING file # # This is free software, and you are welcome to redistribute # # it under certain conditions; see COPYING file for details # ################################################################ package Autodia::Diagram::Dependancy; use strict; use vars qw($VERSION @ISA @EXPORT); use Exporter; use Autodia::Diagram::Object; use Data::Dumper; @ISA = qw(Autodia::Diagram::Object); my $dependancy_count = 0; #--------------------------------------------------------------------- # Constructor Methods sub new { my $class = shift; my $child = shift; my $parent = shift; my $DiagramDependancy = {}; bless ($DiagramDependancy, ref($class) || $class); $DiagramDependancy->_initialise($child, $parent); return $DiagramDependancy; } #----------------------------------------------------------------------- # Access Methods sub Parent { my $self = shift; my $parent = shift; my $return_val = 1; if (defined $parent) { $self->{"parent"} = $parent; } else { $return_val = $self->{"parent"}; } return $return_val; } sub Child { my $self = shift; my $child = shift; my $return_val = 1; if (defined $child) { $self->{"child"} = $child; } else { $return_val = $self->{"child"}; } return $return_val; } sub Name { my $self = shift; my $name = shift; if (defined $name) { $self->{"name"} = $name; return 1; } else { return $self->{"name"}; } } sub Orth_Top_Right { my $self = shift; return $self->{"top_connection"}; } sub Orth_Bottom_Left { my $self = shift; return $self->{"bottom_connection"}; } sub Orth_Mid_Left { my $self = shift; my $return = ($self->{"left_x"}). "," . $self->{"mid_y"}; return $return; } sub Orth_Mid_Right { my $self = shift; my $return = ($self->{"right_x"}). "," . $self->{"mid_y"}; return $return; } sub Reposition { my $self = shift; my $child = $self->{"_child"}; my ($left_x,$bottom_y) = split (",",$child->TopLeftPos); my $mid_y = $bottom_y - 1.5; my $top_y= $mid_y - 1.5; $left_x += 2 + ($child->Width / 2); my $right_x = $left_x + 5; $self->{"left_x"} = $left_x; ($self->{"right_x"}, $self->{"top_y"}, $self->{"mid_y"}, $self->{"bottom_y"}) = ($right_x, $top_y, $mid_y, $bottom_y); $self->{"top_connection"} = $self->{right_x} . "," . $self->{"top_y"}; $self->{"bottom_connection"} = $left_x . "," . $bottom_y; return 1; } #----------------------------------------------------------- # Internal Methods sub _initialise # over-rides method in DiagramObject { my $self = shift; my $child = shift; my $parent = shift; $self->{"_child"} = $child; $self->{"child"} = $child->Id; $self->{"type"} = "dependancy"; $self->{"_parent"} = $parent; $self->{"parent"} = $parent->Id; $self->{"name"} = $self->{"parent"}."-".$self->{"child"}; return 1; } sub _update # over-rides method in DiagramObject { my $self = shift; $self->Reposition(); return 1; } 1; ############################################################################ =head1 =cut Autodia-2.14/lib/Autodia/Diagram/Superclass.pm0000644000076400007640000000570311220446736020556 0ustar teejayteejay################################################################ # Autodia - Automatic Dia XML.(C)Copyright 2001-2009 A Trevena # # # # AutoDia comes with ABSOLUTELY NO WARRANTY; see COPYING file # # This is free software, and you are welcome to redistribute # # it under certain conditions; see COPYING file for details # ################################################################ package Autodia::Diagram::Superclass; use strict; use Carp qw(cluck); use base qw(Autodia::Diagram::Object); #--------------------------------------------------------------------- ##################### # Constructor Methods sub new { my $class = shift; my $name = shift; cluck "new method called with no name\n" unless ($name); my $DiagramSuperclass = {}; bless ($DiagramSuperclass, ref($class) || $class); $DiagramSuperclass->_initialise($name); return $DiagramSuperclass; } #-------------------------------------------------------------------- # Access Methods sub Inheritances { my $self = shift; my @inheritances = (); if (ref $self->{"inheritances"}) { @inheritances = @{$self->{"inheritances"}}; } return @inheritances; } sub add_inheritance { my $self = shift; my $new_inheritance = shift; my @inheritances; $new_inheritance->Parent($self->Id); if (defined $self->{"inheritances"}) { @inheritances = @{$self->{"inheritances"}}; } push(@inheritances, $new_inheritance); $self->{"inheritances"} = \@inheritances; return scalar(@inheritances); } sub Relations { my $self = shift; return (ref $self->{"relations"}) ? @{$self->{"relations"}} : () ; } sub add_relation { my $self = shift; my $new_relation = shift; $self->{relations} ||= []; push(@{$self->{relations}}, $new_relation); return 1; } sub Redundant { my $self = shift; my $replacement = shift || 0; if ($replacement) { if ($self->{"_redundant"}) { my $current_replacement = $self->{"_redundant"}; return -1; } $self->{"_redundant"} = $replacement; return 1; } $self->{_redundant} = 0; return 0; } sub Name { my $self = shift; my $name = shift; if ($name) { $self->{"name"} = $name; return 1; } else { return $self->{"name"}; } } sub LocalId { my $self = shift; my $return_val = 1; my $new_id = shift; if ($new_id) { $self->{"local_id"} = $new_id } else { $return_val = $self->{"local_id"}; } return $return_val; } #-------------------------------------------------------------------------- # Internal Methods sub _initialise # over-rides method in DiagramObject { my $self = shift; my $name = shift; $self->{"name"} = $name; $self->{"type"} = "superclass"; return 1; } sub _update # over-rides method in DiagramObject { my $self = shift; $self->reposition(); return 1; } 1; ########################################################################## =head1 =cut Autodia-2.14/lib/Autodia/Diagram/Class.pm0000644000076400007640000002054511220427450017470 0ustar teejayteejaypackage Autodia::Diagram::Class; use strict; =head1 NAME Autodia::Diagram::Class - Class that holds, updates and outputs the values of a diagram element of type class. =head1 SYNOPSIS use Autodia::Diagram::Class; my $Class = Autodia::Diagram::Class->new; =head2 Description Autodia::Diagram::Class is an object that represents the Dia UML Class element within a Dia diagram. It holds, outputs and allows the addition of attributes, relationships and methods. =cut use Data::Dumper; use base qw(Autodia::Diagram::Object); =head1 METHODS =head2 Constructor my $Class = Autodia::Diagram::Class->new($name); creates and returns a simple Autodia::Diagram::Class object, containing its name and its original position (default 0,0). =head2 Accessors Autodia::Diagram::Class attributes are accessed through methods, rather than directly. Each attribute is available through calling the method of its name, ie Inheritances(). The methods available are : Operations, Attributes, Inheritances, Dependancies, Parent, and has_child. The first 4 return a list, the later return a string. Adding elements to the Autodia::Diagram::Class is acheived through the add_ methods, ie add_inheritance(). Rather than remove an element from the diagram it is marked as redundant and replaced with a superceding element, as Autodia::Diagram::Class has highest precedence it won't be superceded and so doesn't have a redundant() method. Superclass and Component do. =head2 Accessing and manipulating the Autodia::Diagram::Class $Class->Attributes(), Inheritances(), Operations(), and Dependancies() all return a list of their respective elements. $Class->Parent(), and has_child() return the value of the parent or child respectively if present otherwise a false. $Class->add_attribute(), add_inheritance(), add_operation(), and add_dependancy() all add a new element of their respective types. =cut ##################### # Constructor Methods sub new { my $class = shift; my $name = shift; my $self = {}; bless ($self, ref($class) || $class); $self->_initialise($name); return $self; } #------------------------------------------------------------------------- ################ # Access Methods sub Dependancies { my $self = shift; if (defined $self->{"dependancies"}) { my @dependancies = @{$self->{"dependancies"}}; return @dependancies; } else { return; } } sub add_dependancy { my $self = shift; my $new_dependancy = shift; my @dependancies; if (defined $self->{"dependancies"}) { @dependancies = @{$self->{"dependancies"}}; } push(@dependancies, $new_dependancy); $self->{"dependancies"} = \@dependancies; return scalar(@dependancies); } sub Inheritances { my $self = shift; if (ref $self->{"inheritances"}) { return $self->{"inheritances"}; } else { return undef; } } sub add_inheritance { my $self = shift; my $new_inheritance = shift; my @inheritances; if (defined $self->{"inheritances"}) { @inheritances = @{$self->{"inheritances"}}; } push(@inheritances, $new_inheritance); $self->{"inheritances"} = \@inheritances; $self->Parent($new_inheritance->Id); return scalar(@inheritances); } sub Relations { my $self = shift; return (ref $self->{"relations"}) ? @{$self->{"relations"}} : () ; } sub add_relation { my $self = shift; my $new_relation = shift; $self->{relations} ||= []; push(@{$self->{relations}}, $new_relation); return 1; } sub Attributes { my $self = shift; if (defined $self->{"attributes"}) { my @attributes = @{$self->{"attributes"}}; return \@attributes; } else { return; } } sub add_attribute { my $self = shift; my %new_attribute = %{shift()}; # discard new attribute if duplicate my $discard = 0; foreach my $attribute ( @{$self->{"attributes"}} ) { my %attribute = %$attribute; if ($attribute{name} eq $new_attribute{name}) { $discard = 1; } } unless ($discard) { push (@{$self->{"attributes"}},\%new_attribute); $self->_set_updated("attributes"); $self->_update; } return scalar(@{$self->{"attributes"}}); } sub has_child { my $self = shift; my $child = shift; my $return = 0; if (defined $child) { $self->{"child"} = $child; } else { $return = $self->{"child"}; } } sub Parent { my $self = shift; my $parent = shift; my $return = 0; if (defined $parent) { $self->{"parent"} = $parent; } else { $return = $self->{"parent"}; } } sub replace_superclass { my $self = shift; my $superclass = shift; if (ref ($superclass->Inheritances)) { my @inheritances = @{$superclass->Inheritances}; foreach my $inheritance (@inheritances) { $inheritance->Parent($self->Id); } } if (ref ($superclass->Relations)) { my @relations = @{$superclass->Relations}; foreach my $relation (@relations) { $relation->Parent($self->Id); } } return 1; } sub replace_component { my $self = shift; my $component = shift; if (ref ($component->Dependancies) ) { my @dependancies = $component->Dependancies; foreach my $dependancy (@dependancies) { $dependancy->Parent($self->Id); } } return 1; } sub Operations { my $self = shift; if (defined $self->{"operations"}) { my @operations = $self->{"operations"}; return @operations; } else { return; } } sub add_operation { my $self = shift; my $operation = shift(); $operation->{_id} = ( ref $self->{"operations"} ) ? scalar @{$self->{"operations"}} : 0 ; push (@{$self->{"operations"}},$operation); $self->{operation_index}{$operation->{name}} = $operation; $self->_set_updated("operations"); $self->_update; return scalar(@{$self->{"operations"}}); } sub get_operation { my ($self, $name) = @_; return $self->{operation_index}{$name}; } sub update_operation { my $self = shift; my $operation = shift; $self->{"operations"}[$operation->{_id}] = $operation; $self->{operation_index}{$operation->{name}} = $operation; $self->_set_updated("operations"); $self->_update; return; } sub Realizations { my $self = shift; if( defined $self->{"realizations"} ) { my @realizations = @{ $self->{"realizations"} }; return @realizations; } else { return; } } sub add_realization { my $self = shift; my $new_realization = shift; my @realizations; if( defined $self->{"realizations"} ) { @realizations = @{ $self->{"realizations"} }; } push( @realizations, $new_realization ); $self->{"realizations"} = \@realizations; return scalar(@realizations); } #----------------------------------------------------------------------- ################## # Internal Methods # over-rides method in DiagramObject sub _initialise { my $self = shift; $self->{"name"} = shift; $self->{"type"} = "class"; $self->{"top_y"} = 1; $self->{"left_x"} = 1; $self->{"width"} = 2; # arbitary $self->{"height"} = 2; # arbitary #$self->{"operations"} = []; #$self->{"attributes"} = []; $self->{operation_index} = {}; return 1; } sub _update { my $self = shift; my %updated = %{$self->{_updated}}; if ($updated{"attributes"}) { my $longest_element = ($self->{"width"} -1) / 0.5; my @attributes = @{$self->{"attributes"}}; my $last_element = pop @attributes; if (length $last_element > $longest_element) { $self->{"width"} = (length $last_element * 0.5) + 1; } $self->{height} += 0.8; } if ($updated{"operations"}) { my $longest_element = ($self->{width} -1) / 0.5; my @operations = @{$self->{"operations"}}; my $last_element = pop @operations; if (length $last_element > $longest_element) { $self->{"width"} = (length $last_element * 0.5) + 1; } $self->{"height"} += 0.8; } undef $self->{"_updated"}; return 1; } 1; ############################################################################## =head2 See Also L L L L =head1 AUTHOR Aaron Trevena, Eaaron.trevena@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2004 by Aaron Trevena This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.1 or, at your option, any later version of Perl 5 you may have available. =cut ######################################################################## Autodia-2.14/lib/Autodia/Diagram/Inheritance.pm0000644000076400007640000000632411014541644020656 0ustar teejayteejay################################################################ # Autodia - Automatic Dia XML. Copyright 2001 - 2008 A Trevena # # # # AutoDIA comes with ABSOLUTELY NO WARRANTY; see COPYING file # # This is free software, and you are welcome to redistribute # # it under certain conditions; see COPYING file for details # ################################################################ package Autodia::Diagram::Inheritance; use strict; use vars qw($VERSION @ISA @EXPORT); use Exporter; use Autodia::Diagram::Object; @ISA = qw(Autodia::Diagram::Object); my $inheritance_count = 0; #-------------------------------------------------------------------- # Constructor Methods sub new { my $class = shift; my $child = shift; my $parent = shift; my $DiagramInheritance = {}; bless ($DiagramInheritance, ref($class) || $class); $DiagramInheritance->_initialise($child, $parent); return $DiagramInheritance; } #-------------------------------------------------------------------- # Access Methods sub Parent { my $self = shift; my $parent = shift; my $return_val = 1; if (defined $parent) { $self->{"parent"} = $parent; } else { $return_val = $self->{"parent"}; } return $return_val; } sub Child { my $self = shift; my $child = shift; my $return_val = 1; if (defined $child) { $self->{"child"} = $child; } else { $return_val = $self->{"child"}; } return $return_val; } sub Name { my $self = shift; my $name = shift; if (defined $name) { $self->{"name"} = $name; return 1; } else { return $self->{"name"}; } } sub Orth_Top_Left { my $self = shift; return $self->{"top_connection"}; } sub Orth_Bottom_Right { my $self = shift; return $self->{"bottom_connection"}; } sub Orth_Mid_Left { my $self = shift; my $return = ($self->{"left_x"}). "," . $self->{"mid_y"}; return $return; } sub Orth_Mid_Right { my $self = shift; my $return = ($self->{"right_x"}). "," . $self->{"mid_y"}; return $return; } sub Reposition { my $self = shift; my $child = $self->{"_child"}; my ($right_x,$bottom_y) = split (",",$child->TopLeftPos); my $mid_y = $bottom_y - 1.5; my $top_y= $mid_y - 1.5; $right_x += 2 + ($child->Width / 2); my $left_x = $right_x - 5; $self->{"left_x"} = $left_x; ($self->{"right_x"}, $self->{"top_y"}, $self->{"mid_y"}, $self->{"bottom_y"}) = ($right_x, $top_y, $mid_y, $bottom_y); $self->{"top_connection"} = $self->{left_x} . "," . $self->{"top_y"}; $self->{"bottom_connection"} = $right_x . "," . $bottom_y; return 1; } #------------------------------------------------------ # Internal Methods sub _initialise # over-rides method in DiagramObject { my $self = shift; my $child = shift; my $parent = shift; $self->{"_child"} = $child; $self->{"child"} = $child->Id; $self->{"type"} = "inheritance"; $self->{"_parent"} = $parent; $self->{"parent"} = $parent->Id; $self->{"name"} = $self->{"parent"}."-".$self->{"child"}; return 1; } sub _update # over-rides method in DiagramObject { my $self = shift; $self->reposition(); return 1; } 1; ############################################################## =head1 =cut Autodia-2.14/lib/Autodia/Diagram/Component.pm0000644000076400007640000000647111220446743020375 0ustar teejayteejay################################################################ # Autodia - Automatic Dia XML.(C)Copyright 2001-2009 A Trevena # # # # Autodia comes with ABSOLUTELY NO WARRANTY; see COPYING file # # This is free software, and you are welcome to redistribute # # it under certain conditions; see COPYING file for details # ################################################################ package Autodia::Diagram::Component; use strict; use Carp qw(cluck); use base qw(Autodia::Diagram::Object); #------------------------------------------------------------------------------- ##################### # Constructor Methods sub new { my $class = shift; my $name = shift; cluck "new method called with no name\n" unless ($name); my $DiagramComponent = {}; bless ($DiagramComponent, ref($class) || $class); $DiagramComponent->_initialise($name); return $DiagramComponent; } #------------------------------------------------------------------------------- # Access Methods sub Dependancies { my $self = shift; if (defined $self->{"dependancies"}) { my @dependancies = @{$self->{"dependancies"}}; return @dependancies; } else { return -1; } # erk! this component has no dependancies } sub add_dependancy { my $self = shift; my $new_dependancy = shift; my @dependancies; if (defined $self->{"dependancies"}) { @dependancies = @{$self->{"dependancies"}}; push(@dependancies, $new_dependancy); } else { $dependancies[0] = $new_dependancy; } $self->{"dependancies"} = \@dependancies; $new_dependancy->Parent($self->Id); return scalar(@dependancies) ; } sub Redundant { my $self = shift; my $replacement = shift; if (defined $replacement) { if ($self->{"_redundant"}) { my $current_replacement = $self->{"_redundant"}; return -1; } $self->{"_redundant"} = $replacement; } return $self->{"_redundant"}; } sub Name { my $self = shift; my $name = shift; if ($name) { $self->{"name"} = $name; return 1; } else { return $self->{"name"}; } } sub LocalId { my $self = shift; my $return_val = 1; my $new_id = shift; if ($new_id) { $self->{"local_id"} = $new_id } else { $return_val = $self->{"local_id"}; } return $return_val; } sub TextPos { my $self = shift; my $text_pos = $self->{"left_x"}+0.285; $text_pos .= ","; $text_pos .= $self->{"top_y"}+0.895; return $text_pos; } #----------------------------------------------------------------------------- # Internal Methods sub _initialise # over-rides method in DiagramObject { my $self = shift; $self->{"name"} = shift; $self->{"type"} = "Component"; # Component in caps rest lower case (fix this) $self->{"left_x"} = 0; $self->{"top_y"} = 0; return 1; } sub _update # over-rides method in DiagramObject { # might use this later my $self = shift; $self->reposition(); return 1; } 1; ############################################################################ =head1 NAME DiagramComponent - Handles elements of type UML Smallpackage This is a subclass of DiagramObject, which acts as a UML package. Used by autodia.pl and Handler (and handlers inheriting from Handler) used as in $Component = DiagramComponent->New($name); =cut Autodia-2.14/lib/Autodia/Handler/0000755000076400007640000000000011567257122016103 5ustar teejayteejayAutodia-2.14/lib/Autodia/Handler/SQL.pm0000644000076400007640000001510511566444676017115 0ustar teejayteejay################################################################ # AutoDIA - Automatic Dia XML. (C)Copyright 2003 A Trevena # # # # AutoDIA comes with ABSOLUTELY NO WARRANTY; see COPYING file # # This is free software, and you are welcome to redistribute # # it under certain conditions; see COPYING file for details # ################################################################ package Autodia::Handler::SQL; require Exporter; use strict; use vars qw($VERSION @ISA @EXPORT); use Autodia::Handler; @ISA = qw(Autodia::Handler Exporter); use Autodia::Diagram; use Data::Dumper; #--------------------------------------------------------------- my %data_types = ( varchar => [qw/varchar2 nvarchar varchar/], char => [qw/char nchar/], integer => [qw/longint shortint int bigint smallint tinyint/], text => [qw/ntext text/], blob => [qw/blob binary varbinary image/], float => [qw/long curr currency doublef float decimal numeric real money smallmoney/], date => [qw/datetime smalldate smalldatetime time date/], boolean => [qw/bool boolean bit/], set => [qw/enum set/], ); ##################### # Constructor Methods # new inherited from Autodia::Handler #------------------------------------------------------------------------ # Access Methods # parse_file inherited from Autodia::Handler #----------------------------------------------------------------------------- # Internal Methods # _initialise inherited from Autodia::Handler sub _parse { my $self = shift; my $fh = shift; my $filename = shift; my $Diagram = $self->{Diagram}; # process tables my %fields = (); my %primary_keys = (); my $in_table = 0; my ($Class,$table); foreach my $fileline (<$fh>) { next if ($self->_discard_line($fileline)); # discard comments and garbage # If we have a create line, then we need to finish off the # last table (if any) and start a new one. if ($fileline =~ /^\s*create\s+table\s+(?:\[\w+\]\.)?[\`\'\"\[]?([\w\s]+)[\`\'\"\]]? ?\(?/i) { $table = $1; # create new 'class' representing table $Class = Autodia::Diagram::Class->new($table); # add 'class' to diagram my $exists = $self->{Diagram}->add_class($Class); $Class = $exists if ($exists); } else { # recognise lines that define columns my $matched = 0; foreach my $type (keys %data_types) { my $pattern = join('|', ($type,@{$data_types{$type}})); if ($fileline =~ /\s*\[?(\S+?)\]?\s+\[?($pattern)\]?\s*([\w\s\(\)]*),?\s*/i) { $matched = 1; my ($field,$field_type,$extra_info) = ($1,$2,$3); if ($extra_info =~ /^\s*(\([\d\s]+\))/) { $field_type .= $1; } $Class->add_attribute({ name => $field, visibility => 0, type => $field_type, }); if (my $dep = $self->_is_foreign_key($table, $field)) { my $Superclass = Autodia::Diagram::Superclass->new($dep); my $exists_already = $self->{Diagram}->add_superclass($Superclass); if (ref $exists_already) { $Superclass = $exists_already; } # create new relationship my $Relationship = Autodia::Diagram::Inheritance->new($Class, $Superclass); # add Relationship to superclass $Superclass->add_inheritance($Relationship); # add Relationship to class $Class->add_inheritance($Relationship); # add Relationship to diagram $self->{Diagram}->add_inheritance($Relationship); } else { push (@{$fields{$field}}, $Class); } if ($extra_info =~ m/(identity|primary[\s_-]key)\s*/i ) { my $pk_fields = $field; my $primary_key = { name=>'Primary Key', type=>'pk', Param=>[], visibility=>0, }; foreach my $pk_field (split(/\s*,\s*/,$pk_fields) ) { push (@{$primary_key->{Param}}, { Name=>$pk_field, Type=>''}); $primary_keys{$pk_field}= $Class; } $Class->add_operation($primary_key); } last; } } unless ($matched) { # check for indexes and primary keys if ( $fileline =~ m/primary[\s_-]key\s*\((.*)\)\s*/i ) { my $pk_fields = $1; my $primary_key = { name=>'Primary Key', type=>'pk', Param=>[], visibility=>0, }; foreach my $pk_field (split(/\s*,\s*/,$pk_fields) ) { push (@{$primary_key->{Param}}, { Name=>$pk_field, Type=>''}); $primary_keys{$pk_field} = $Class; } $Class->add_operation($primary_key); } } } } # build additional fk's foreach my $primary_key (keys %primary_keys) { my $Superclass = $primary_keys{$primary_key}; foreach my $Class (@{$fields{$primary_key}}) { # create new relationship my $Relationship = Autodia::Diagram::Inheritance->new($Class, $Superclass); # add Relationship to superclass $Superclass->add_inheritance($Relationship); # add Relationship to class $Class->add_inheritance($Relationship); # add Relationship to diagram $self->{Diagram}->add_inheritance($Relationship); } } } sub _is_foreign_key { my ($self, $table, $field) = @_; my $is_fk = undef; if (($field !~ m/$table.u?id/i) && ($field =~ m/^(.*)[_-]u?id$/i)) { $is_fk = $1; } return $is_fk; } sub _discard_line { my $self = shift; my $line = shift; my $return = 0; $return = 1 if ( $line =~ m/^(INSERT|DROP|LOCK|ALTER|EXEC|GO)/i ); $return = 1 if ( $line =~ m/^\s*(#|--|\/\*|\d+|\))/); $return = 1 if ( $line =~ m/^\s*$/); return $return; } ####----- 1; ############################################################################### =head1 NAME Autodia::Handler::SQL.pm - AutoDia handler for SQL =head1 INTRODUCTION Autodia::Handler::SQL parses files into a Diagram Object, which all handlers use. The role of the handler is to parse through the file extracting information such as table names, field names, relationships and keys. SQL is registered in the Autodia.pm module, which contains a hash of language names and the name of their respective language - in this case: %language_handlers = { .. , sql => "Autodia::Handler::SQL", .. }; =head1 CONSTRUCTION METHOD use Autodia::Handler::SQL; my $handler = Autodia::Handler::SQL->New(\%Config); This creates a new handler using the Configuration hash to provide rules selected at the command line. =head1 ACCESS METHODS $handler->Parse(filename); # where filename includes full or relative path. This parses the named file and returns 1 if successful or 0 if the file could not be opened. $handler->output(); This outputs the Dia XML file according to the rules in the %Config hash passed at initialisation of the object. It also allows you to output VCG, Dot or images rendered through GraphViz and VCG. =cut Autodia-2.14/lib/Autodia/Handler/Cpp.pm0000644000076400007640000004344011337330561017162 0ustar teejayteejay################################################################ # AutoDIA - Automatic Dia XML. (C)Copyright 2001 A Trevena # # # # AutoDIA comes with ABSOLUTELY NO WARRANTY; see COPYING file # # This is free software, and you are welcome to redistribute # # it under certain conditions; see COPYING file for details # ################################################################ # Now actually works (ish) thanks to Ekkehard ! significant # # amounts of this code contributed by Ekkehard Goerlach # package Autodia::Handler::Cpp; require Exporter; use strict; use vars qw($VERSION @ISA @EXPORT); use Autodia::Handler; @ISA = qw(Autodia::Handler Exporter); use Autodia::Diagram; #--------------------------------------------------------------- ##################### # Constructor Methods # new inherited from Autodia::Handler #------------------------------------------------------------------------ # Access Methods # parse_file inherited from Autodia::Handler #----------------------------------------------------------------------------- # Internal Methods # _initialise inherited from Autodia::Handler sub _parse { my $self = shift; my $fh = shift; my $filename = shift; my $Diagram = $self->{Diagram}; # print "processing file : $filename \n"; my $Class; $self->{current_package} = $filename; $self->{privacy} = 0; $self->{comment} = 0; $self->{in_class} = 0; $self->{in_declaration} = 0; $self->{in_method} = 0; $self->{brace_depth} = 0; my $i = 0; # parse through file looking for stuff while (<$fh>) { LINE: { chomp(my $line=$_); if ($self->_discard_line($line)) { last LINE; } # print "line $i : $line \n"; $i++; # check for class declaration if ($line =~ m/^\s*class\s+(\w+)/) { # print "found class : $line \n"; my $classname = $1; $self->{in_class} = 1; $self->{privacy} = "private"; $self->{visibility} = 1; $classname =~ s/[\{\}]//g; last if ($self->skip($classname)); $Class = Autodia::Diagram::Class->new($classname); my $exists = $Diagram->add_class($Class); $Class = $exists if ($exists); # handle superclass(es) if ($line =~ m/^\s*class\s+\w+\s*\:\s*([^{]+)\s*/) { my $superclasses = $1; $superclasses =~ s/public\s*//i; warn "found superclasses : $superclasses\n"; my @superclasses = split (/\s*,\s*/, $superclasses); foreach my $super (@superclasses) { $super =~ s/\s*//ig; # warn "superclass : $super\n"; $super =~ s/^\s*(\w+\s+)?([A-Za-z0-9\_]+)\s*$/$2/; # warn "superclass : $super\n"; my $Superclass = Autodia::Diagram::Superclass->new($super); my $exists_already = $Diagram->add_superclass($Superclass); if (ref $exists_already) { $Superclass = $exists_already; } my $Inheritance = Autodia::Diagram::Inheritance->new($Class, $Superclass); $Superclass->add_inheritance($Inheritance); $Class->add_inheritance($Inheritance); $Diagram->add_inheritance($Inheritance); } } last LINE; } # check for end of class declaration if ($self->{in_class} && ($line =~ m|^\s*\}\;|)) { # print "found end of class\n"; $self->{in_class} = 0; $self->{privacy} = 0; last LINE; } # check for abstraction/data hiding if ($self->{in_class}) { if ($line =~ m/^\s*protected\s*\:/) { # print "found protected variables/classes\n"; $self->{privacy} = "protected"; $self->{visibility} = 2; $self->_parse_private_things($line,$Class); last LINE; } if ($line =~ m/^\s*private\s*\w*\:/) { # print "found private variables/classes\n"; $self->{privacy} = "private"; $self->{visibility} = 1; # check for attributes and methods $self->_parse_private_things($line,$Class); last LINE; } if ($line =~ m/^\s*public\s*\w*\:/) { # print "found public variables/classes\n"; $self->{privacy} = "public"; $self->{visibility} = 0; $self->_parse_private_things($line,$Class); last LINE; } if ($line =~ m/operator/) { # print "found overloaded operator\n"; last LINE if $line =~ /;/; while ($line !~ /{/) { $line = <$fh>; # print "waiting for start of overload def: $line\n"; } my $start_brace_cnt = $line =~ tr/{/{/ ; my $end_brace_cnt = $line =~ tr/}/}/ ; $self->{brace_depth} = $start_brace_cnt - $end_brace_cnt; $self->{in_method} = 1 unless $self->{brace_depth} == 0; # print "OvStart: ",$start_brace_cnt, $end_brace_cnt, $self->{brace_depth}, $self->{in_method} ,"\n"; last LINE; } # if inside a class method then discard line if ($self->{in_method}) { # count number of braces and increment decrement depth accordingly # if depth = 0 then reset in_method and next; # else next; my $start_brace_cnt = $line =~ tr/{/{/ ; my $end_brace_cnt = $line =~ tr/}/}/ ; $self->{brace_depth} = $self->{brace_depth} + $start_brace_cnt - $end_brace_cnt; $self->{in_method} = $self->{brace_depth} == 0 ? 0 : 1; # print "In method: ",$start_brace_cnt, $end_brace_cnt, $self->{brace_depth}, $self->{in_method} ,"\n"; last LINE; } # check for simple declarations # space* const? space+ (namespace::)* type space* modifier? space+ name; if ($line =~ m/^\s*\w*?\s*((\w+\s*::\s*)*[\w<>]+\s*[\*&]?)\s*(\w+)\s*\;.*$/) # Added support for pointers/refs/namespaces { my $name = $3; my $type = $1; # print "found simple variable declaration : name = $name, type = $type\n"; #my $visibility = ( $name =~ m/^\_/ ) ? 1 : 0; $Class->add_attribute({ name => $name, visibility => $self->{visibility}, #was: $visibility, type => $type, }); last LINE; } # check for simple sub if ($line =~ m/^ # start of line \s* # whitespace (\w*?\s*?(\w+\s*::\s*)*[\w<>]*?\s*[\*&]?) # type of the method: $1. Added support for namespaces \s* # whitespace (~?\w+) # name of the method: $3 \s* # whitespace \(\s* # start of parameter list ([:\w\,\s\*=&\"<>\\\d\-]*) # all parameters: $4 (\)?) # may be an ending bracket: $5 [\w\s=]*(;?) # possibly end of signature $6 .*$/x ) { my $name = $3; my $type = $1 || "void"; my $params = $4; my $end_bracket = $5; my $end_semicolon = $6; my $have_continuation = 0; my $have_end_semicolon= 0; if ($name eq $Class->{"name"}) { # print "found constructor declaration : name = $name\n"; $type = ""; } else { if ($name eq "~".$Class->{"name"}) { # print "found destructor declaration : name = $name\n"; $type = ""; } else { # print "found simple function declaration : name = $name, type = $type\n"; } } $have_continuation = 1 unless $end_bracket eq ")"; $have_end_semicolon = 1 if $end_semicolon eq ";"; # print $have_continuation ? "no ":"with " ,"end bracket : $end_bracket\n"; # print $have_end_semicolon ? "with ":"no " ,"end semicolon : $end_semicolon\n"; $params =~ s|\s+$||; my @params = split(",",$params); my $pc = 0; # parameter count my %subroutine = ( name => $name, type => $type, visibility => $self->{visibility}, ); # If we have continuation lines for the parameters get them all while ($have_continuation) { my $line = <$fh>; last unless ($line); chomp $line; if ($line =~ m/^ # start of line \s* # whitespace ([:\w\,\|\s\*=&\"<>\\]*) # all parameters: $1 (\)?) # may be an ending bracket: $2 [\w\s=]*(;?) # possibly end of signature $3 .*$/x) { my $cparams = $1; $end_bracket = $2; $end_semicolon = $3; $cparams =~ s|\s+$||; my @cparams = split(",",$cparams); push @params, @cparams; # print "More parameters: >$cparams<\n"; $have_continuation = 0 if ($end_bracket eq ")"); $have_end_semicolon = 1 if ($end_semicolon eq ";"); # print $have_continuation ? "no ":"with " ,"end bracket : $end_bracket\n"; # print $have_end_semicolon ? "with ":"no " ,"end semicolon : $end_semicolon\n"; } } # then get parameters and types my @parameters = (); # print "All parameters: ",join(';',@params),"\n"; foreach my $parameter (@params) { $parameter =~ s/const\s+//; $parameter =~ m/\s*((\w+::)*[\w<>]+\s*[\*|\&]?)\s*(\w+)/ ; my ($type, $name) = ($1,$3); $type =~ s/\s//g; $name =~ s/\s//g; $parameters[$pc] = { Name => $name, Type => $type, }; $pc++; } $subroutine{"Params"} = \@parameters; $Class->add_operation(\%subroutine); # Now finished with parameters. If there was no end # semicolon we have an inline method: we read on until we # see the start of the method. This deals with (multi-line) # constructor initialization lists as well. last LINE if $have_end_semicolon; while ($line !~ /{/) { $line = <$fh>; print "waiting for start of method def: $line\n"; } my $start_brace_cnt = $line =~ tr/{/{/ ; my $end_brace_cnt = $line =~ tr/}/}/ ; $self->{brace_depth} = $start_brace_cnt - $end_brace_cnt; $self->{in_method} = 1 unless $self->{brace_depth} == 0; # print "Start: ",$start_brace_cnt, $end_brace_cnt, $self->{brace_depth}, $self->{in_method} ,"\n"; last LINE; } # if line starts with word,space,word then its a declaration (probably) # Broken. if ($line =~ m/\s*[\w<>]+\s+(\w+\s*::\s*)*[\w<>]+/i) { # print " probably found a declaration : $line\n"; my @words = m/^(\w+)\s*[\(\,\;].*$/g; my $name = $&; my $rest = $';#' to placate some syntax highlighters my $type = ''; my $pc = 0; # point count (ie location in array) foreach my $start_point (@-) { my $start = $start_point; my $end = $+[$pc]; $type .= substr($line, $start, ($end - $start)); $pc++; } # if next character is a ( then the line is a function declaration if ($rest =~ m|^\(([\w<>]+)\(.*(\;?)\s*$|) { # print "probably found a function : $line \n"; my $params = $1; my @params = split(",",$params); my $declaration = 0; if (defined $2) # if line ends with ";" then its a declaration { $declaration = 1; my @parameters = (); my $pc = 0; # parameter count my %subroutine = ( name => $name, type => $type, visibility => $self->visibility, ); # then get parameters and types foreach my $parameter (@params) { my ($type, $name) = split(" ",$parameter); $type =~ s/\s//g; $name =~ s/\s//g; $parameters[$pc] = { name => $name, type => $type, }; $pc++; } $subroutine{param} = \@parameters; $Class->add_operation(\%subroutine); } else { my @attributes = (); # else next character is , or ; # the line's a variable declaration $Class->add_attribute ({ name => $name, type => $type, visibility => $self->{visibility}, }); my %attribute = { name => $name , type => $type }; $attributes[0] = \%attribute; if ($rest =~ m/^\,.*\;/) { my @atts = split (","); foreach my $attribute (@atts) { my @attribute_parts = split(" ", $attribute); my $n = scalar @attribute_parts; my $name = $attribute_parts[$n]; my $type = join(" ",$attribute_parts[0...$n-1]); $Class->add_attribute ( { name => $name, type => $type, visibility => $self->{visibility}, }); # } # } # } # } # } # } } } $self->{Diagram} = $Diagram; close $fh; return; } sub _discard_line { my $self = shift; my $line = shift; my $discard = 0; SWITCH: { if ($line =~ m/^\s*$/) # if line is blank or white space discard { $discard = 1; last SWITCH; } if ($line =~ /^\s*\/\//) # if line is a comment discard { $discard = 1; last SWITCH; } # if line is a comment discard if ($line =~ m!^\s*/\*.*\*/!) { $discard = 1; last SWITCH; } # if line starts with multiline comment syntax discard and set flag if ($line =~ /^\s*\/\*/) { $self->{comment} = 1; $discard = 1; last SWITCH; } if ($line =~ /^.*\*\/\s*$/) { $self->{comment} = 0; } if ($self->{comment} == 1) # if currently inside a multiline comment { # if line starts with comment end syntax then unflag and discard if ($line =~ /^.*\*\/\s*$/) { $self->{comment} = 0; $discard = 1; last SWITCH; } $discard = 1; last SWITCH; } } return $discard; } ####----- sub _parse_private_things { my $self = shift; my $line = shift; my $Class = shift; return unless ($line =~ m/^\s*private\s*\w*:\s*(\w.*)$/); # print "found private/public things\n"; my @private_things = split(";",$1); foreach my $private_thing (@private_things) { print "- private/public thing : $private_thing\n"; # FIXME : Next line type definition seems erroneous. Any C++ hackers care to check it? $private_thing =~ m/^\s*(public|private)?:?\s*(static|virtual)\s*(\w+\s*\*?)\s*(\w+\(?[\w\s]*\)?)\s*\w*\s*\w*.*$/; my $name = $4; my $type = "$2 $3"; my $vis = $1 || $self->{visibility}; # print "- found declaration : name = $name, type = $type\n"; if ($name =~ /\(/) { # print "-- declaration is a method \n"; # check for simple sub if ($private_thing =~ m/^ # start of line \s* # whitespace (?:public|private)?:?\s* (\w*?\s*?(\w+\s*::\s*)*\w*?\*?) # type of the method: $1 \s* # whitespace (~?\w+) # name of the method: $2 \s* # whitespace \(\s* # start of parameter list ([:\w\,\s\*=&\"]*) # all parameters: $3 (\)?) # may be an ending bracket: $4 [\w\s=]*(;?) # possibly end of signature $5 .*$/x ) { my $name = $3; my $type = $1 || "void"; my $params = $4; my $end_bracket = $5; my $end_semicolon = $6; my $have_continuation = 0; my $have_end_semicolon= 1; $params =~ s|\s+$||; my @params = split(",",$params); my $pc = 0; # parameter count my %subroutine = ( name => $name, type => $type, visibility => $self->{visibility}, ); # then get parameters and types my @parameters = (); # print "All parameters: ",join(';',@params),"\n"; foreach my $parameter (@params) { $parameter =~ s/const\s+//; my ($type, $name) = split(" ",$parameter); $type =~ s/\s//g; $name =~ s/\s//g; $parameters[$pc] = { name => $name, type => $type, }; $pc++; } $subroutine{param} = \@parameters; $Class->add_operation(\%subroutine); } } else { # print "-- declaration is an attribute \n"; $Class->add_attribute({ name => $name, visibility => $vis, type => $type, }); } } return; } sub _is_package { my $self = shift; my $package = shift; my $Diagram = $self->{Diagram}; unless(ref $$package) { my $filename = shift; # create new class with name $$package = Autodia::Diagram::Class->new($filename); # add class to diagram $Diagram->add_class($$package); } return; } ####----- 1; ############################################################################### =head1 NAME Autodia::Handler::Cpp - AutoDia handler for C++ =head1 INTRODUCTION This module parses files into a Diagram Object, which all handlers use. The role of the handler is to parse through the file extracting information such as Class names, attributes, methods and properties. HandlerPerl parses files using simple perl rules. A possible alternative would be to write HandlerCPerl to handle C style perl or HandleHairyPerl to handle hairy perl. HandlerPerl is registered in the Autodia.pm module, which contains a hash of language names and the name of their respective language - in this case: %language_handlers = { .. , cpp => "Autodia::Handler::Cpp", .. }; =head1 CONSTRUCTION METHOD use Autodia::Handler::Cpp; my $handler = Autodia::Handler::Cpp->New(\%Config); This creates a new handler using the Configuration hash to provide rules selected at the command line. =head1 ACCESS METHODS This parses the named file and returns 1 if successful or 0 if the file could not be opened. $handler->output_xml(); # interpolates values into an xml or html template $handler->output_graphviz(); # generates a gif file via graphviz =cut Autodia-2.14/lib/Autodia/Handler/python.pm0000644000076400007640000001412211566444637017772 0ustar teejayteejay################################################################ # AutoDIA - Automatic Dia XML. (C)Copyright 2001 A Trevena # # # # AutoDIA comes with ABSOLUTELY NO WARRANTY; see COPYING file # # This is free software, and you are welcome to redistribute # # it under certain conditions; see COPYING file for details # ################################################################ package Autodia::Handler::python; require Exporter; use strict; use vars qw($VERSION @ISA @EXPORT); use Autodia::Handler; @ISA = qw(Autodia::Handler Exporter); use Autodia::Diagram; use Data::Dumper; #--------------------------------------------------------------- ##################### # Constructor Methods # new inherited from Autodia::Handler #------------------------------------------------------------------------ # Access Methods # parse_file inherited from Autodia::Handler #----------------------------------------------------------------------------- # Internal Methods # _initialise inherited from Autodia::Handler sub _parse { # parses python source code my $self = shift; my $fh = shift; my $filename = shift; warn "_parse_file called with $self, $fh, $filename\n"; my %config = %{$self->{Config}}; my $Diagram = $self->{Diagram}; # set up local variables for parsing $self->{in_comment} = 0; my $module_name = $filename; $module_name =~ s/^.*?\/?(\w+)\.py$/$1/; my $in_class = 0; my $current_class = $module_name; my $exit_depth = -1; my $Module = Autodia::Diagram::Class->new($module_name); my $exists = $Diagram->add_class($Module); my $Class = $Module = $exists if ($exists); my %aliases = (); # process file my $class_count = 0; foreach my $line (<$fh>) { next if $self->_discard_line (\$line); # count spaces / tabs to see how deep indented my $depth = 0; foreach (split(//,$line)) { last if (/\S/); $depth++; } if ($depth == $exit_depth) { $in_class = 0; $current_class = $module_name; $Class = $Module; } # catch methods and subs if ( $line =~ m/^[\s\t]*def\s+(\S+)\s*\((.*)\):/ ) { my %method = ( "name" => $1, ); $method{"visibility"} = ($method{"name"} =~ m/^\_/) ? 1 : 0; my $params = $2 || ''; if ($params) { foreach (split(/\s*,\s*/,$params)) { push (@{$method{"Params"}},{Name => $_, Val => '',}); } } $Class->add_operation(\%method); } # catch class if ( $line =~ /^class\s+(\w+).*:/ ) { my $classname = $1; $current_class = "$module_name.$classname"; last if ($self->skip($classname)); $Class = Autodia::Diagram::Class->new("$module_name.$classname"); my $exists = $Diagram->add_class($Class); $Class = $exists if ($exists); $aliases{$classname} = $Class; warn "got class name : $classname\n"; warn " line : $line \n"; if ( $line =~ /\((.*)\)/) { my @superclasses = split(/[\,\s]/,$1); foreach my $super (@superclasses) { # create superclass warn "have superclass : $super\n"; next unless ($super=~/\S/); my $Superclass; # check if superclass exists already if ($aliases{$super}) { $Superclass = $aliases{$super}; warn "found alias for superclass $super - ",$Superclass->Name , "\n"; } else { $Superclass = Autodia::Diagram::Superclass->new($super); # add superclass to diagram my $exists_already = $Diagram->add_superclass($Superclass); if (ref $exists_already) { warn "superclass exists already"; $Superclass = $exists_already; } $aliases{$super} = $Superclass; } # create new inheritance my $Inheritance = Autodia::Diagram::Inheritance->new($Class, $Superclass); # add inheritance to superclass $Superclass->add_inheritance($Inheritance); # add inheritance to class $Class->add_inheritance($Inheritance); # add inheritance to diagram $Diagram->add_inheritance($Inheritance); } } $in_class = 1; $exit_depth = $depth; } # catch object attributes via self.foo or this.foo if ( $line =~ /(self|this)\.(\w+)\.?/ ) { my $attribute = $2; my $attribute_visibility = ( $attribute =~ m/^\_/ ) ? 1 : 0; $Class->add_attribute({ name => $attribute, visibility => $attribute_visibility, value => '', }); } if ( $line =~ /import/ ) { my $dependancy; if ($line =~ /from\s+(\w+)\s+import/) { $dependancy = $1; } elsif ($line =~ /\s*import\s+(\w+)/) { $dependancy = $1; } else { # not supported } if ($dependancy) { # create component my $Component = Autodia::Diagram::Component->new($dependancy); # add component to diagram my $exists = $Diagram->add_component($Component); # replace component if redundant if (ref $exists) { $Component = $exists; } # create new dependancy my $Dependancy = Autodia::Diagram::Dependancy->new($Class, $Component); # add dependancy to diagram $Diagram->add_dependancy($Dependancy); # add dependancy to class $Class->add_dependancy($Dependancy); # add dependancy to component $Component->add_dependancy($Dependancy); } } } } ########################################## sub _discard_line { my $self = shift; my $line = shift; my $discard = 0; SWITCH: { if ($$line =~ /"""/) # if line is a comment discard { $$line =~ s/""".*"""//; if ($self->{in_comment}) { if ($$line =~ /"""(\s*\w[\w\s]*)/) { $self->{in_comment} = 0; $$line = $1; } else { $self->{in_comment} = 0; $discard = 1; } } else { if ($$line =~ /^(\s*[\w\s]*)"""/) { $self->{in_comment} = 1; $$line = $1; } else { $discard = 1; } } last SWITCH; } else { $discard = 1 if ($self->{in_comment}); } if ($$line =~ /#/) { if ($$line =~ /^(\s*\w[\w\s]*)#/) { $$line = $1; } else { $discard = 1; } last SWITCH; } } # end SWITCH $discard = 1 if ($$line =~ m/^\s*$/); # if line is blank or white space discard return $discard; } Autodia-2.14/lib/Autodia/Handler/Torque.pm0000644000076400007640000004462111146246630017722 0ustar teejayteejay################################################################ # AutoDIA - Automatic Dia XML. (C)Copyright 2001 A Trevena # # # # AutoDIA comes with ABSOLUTELY NO WARRANTY; see COPYING file # # This is free software, and you are welcome to redistribute # # it under certain conditions; see COPYING file for details # # # # ---- # # 03.05.04 - J. Gilbreath - Vanderbilt University # # - Modified to handle tables with only one column # # as well as those without any keys (primary or # # foreign). # # - Foreign keys, indexed columns, and unique columns were # # also added as operations on each table. # # - Primary key support was changed to add a operation for # # each primary key instead of grouping all of them # # under one operation. # # - Relationship code was enhanced to handle foreign key # # relationships to the same table without throwing # # an exception during diagram construction. # # - Finally, _subParse function was trimmed and sub functions # # broken out for individual portions of table # # processing. # # - TODO : Add support for onUpdate and onDelete for foreign # # keys (maybe a comment on the operation?) # # ---- # ################################################################ package Autodia::Handler::Torque; require Exporter; use strict; use XML::Simple; ## added for debugging - jg use Data::Dumper; use vars qw($VERSION @ISA @EXPORT); use Autodia::Handler; @ISA = qw(Autodia::Handler Exporter); use Autodia::Diagram; #--------------------------------------------------------------- ##################### # Constructor Methods # new inherited from Autodia::Handler #------------------------------------------------------------------------ # Access Methods # parse_file inherited from Autodia::Handler #----------------------------------------------------------------------------- # Internal Methods # _initialise inherited from Autodia::Handler sub _parse { my $self = shift; my $fh = shift; my $filename = shift; my $Diagram = $self->{Diagram}; my $xml = XMLin(join('',<$fh>)); #print Dumper($xml->{table}); my %tables = (); my @relationships = (); # process tables foreach my $tablename (sort keys %{$xml->{'table'}}) { #print "Processing table $tablename\n"; my $Class = Autodia::Diagram::Class->new($tablename); $Diagram->add_class($Class); # Orignially primary keys were placed into a HASH and all appeared as one # operation on the class (table). This was replaced to generate an operation # for each Primary Key to reduce the size of the table width for tables with # many primary keys. # In addition, foreign keys, index columns, and unique columns were added as # operations as well. -jg # primary key(s) #my $primary_key = { name=>'Primary Key', type=>'pk', Params=>[], visibility=>0, }; $tables{$tablename} = $Class; # process column(s) and primary key(s) _processColumns($Class, $xml, $tablename); # process foreign key(s) _processForeignKeys($self, $Class, $xml, $tablename); # process index(es) _processIndexes($Class, $xml, $tablename); # process unique column(s) _processUniqueColumns($Class, $xml, $tablename); } # end foreach table } # end _parse #### # Adds a Primary Key as an operation of the given class #### sub _addPKOperation { my ($localClass , $localColumn) = @_; $localClass->add_operation({name=>"Primary Key", type=>'pk', Params=>[{Name=>$localColumn, Type=>''}], visibility=>0 }); } #### # Adds a Foreign Key as an operation of the given class #### sub _addFKOperation { my ($localClass , $localFK, $localFKTable) = @_; $localClass->add_operation({name=>"Foreign Key", type=>'fk', Params=>[{Name=>$localFK, Type=>$localFKTable}], visibility=>0 }); } #### # Adds an Indexed Column as an operation of the given class #### sub _addIndexOperation { my ($localClass , $localColumn) = @_; $localClass->add_operation({name=>"Indexed Column", type=>'ic', Params=>[{Name=>$localColumn, Type=>''}], visibility=>0 }); } #### # Adds a Unique Column as an operation of the given class #### sub _addUniqueOperation { my ($localClass , $localColumn) = @_; $localClass->add_operation({name=>"Unique Column", type=>'uc', Params=>[{Name=>$localColumn, Type=>''}], visibility=>0 }); } #### # Builds a Relationship for the given Class based on the given Foreign Key # reference and adds it to the Diagram #### sub _buildFKRelationship { my ($localSelf, $localClass, $localFK) = @_; # create foreign key table or get it if already present my $Superclass = Autodia::Diagram::Superclass->new($localFK); my $exists_already = $localSelf->{Diagram}->add_superclass($Superclass); if (ref $exists_already) { $Superclass = $exists_already; } # create new relationship my $Relationship = Autodia::Diagram::Inheritance->new($localClass, $Superclass); # add Relationship to superclass $Superclass->add_inheritance($Relationship); # add Relationship to class $localClass->add_inheritance($Relationship); # add Relationship to diagram $localSelf->{Diagram}->add_inheritance($Relationship); } #### # Constructs a Foreign Key compound string from the given HASH #### sub _constructForeignKey { my %fkHash = @_; return "(l=".$fkHash{"local"}." : f=". $fkHash{"foreign"}.") "; } #### # Constructs a Type for the column based on the given HASH #### sub _constructType { my %typeHash = @_; if (exists $typeHash{"size"}) { return $typeHash{"type"}."(".$typeHash{"size"}.")"; } else { return $typeHash{"type"}; } } #### # Processes the Columns using the given XML, Class, and tablename # # The processing takes into account that depending on the quantity of columns a table # has, the reference in the XML will map differently. The HASH will key off of the # keyword "name" if the table has a single column. The key to the HASH will be the # column name if the table has more than one column. #### sub _processColumns { my ($localClass, $localXML, $localTablename) = @_; my %columnHash; foreach my $column (keys %{$localXML ->{'table'}{$localTablename}{'column'}}) { no strict 'refs'; %columnHash = %{$localXML ->{'table'}{$localTablename}{'column'}}; if (exists $columnHash{"name"}) { # this is a table with one column my $columnName = $columnHash{"name"}; #if ($column eq "name") { # print "adding column $columnName to $localTablename\n"; #} $localClass->add_attribute({ name => $columnName, visibility => 0, type => _constructType(%columnHash), }); if ($column eq "primaryKey") { # add each primary key as a different operation to avoid wide # class diagrams _addPKOperation($localClass, $columnName); } } else { # this is a table with multiple columns in which case # the key is the column name repopulate hash one deep %columnHash = %{$localXML ->{'table'}{$localTablename}{'column'}{$column}}; #print "adding column $column to $localTablename\n"; $localClass->add_attribute({ name => $column, visibility => 0, type => _constructType(%columnHash), }); if (exists $columnHash{"primaryKey"}) { # add each primary key as a different operation to avoid wide # class diagrams _addPKOperation($localClass, $column); } } } } # end processColumns #### # Processes the Foreign Keys using the given XML , Class, self, and tablename # # Again, XML will parse differently based on the quantity of foreign keys. It will be a # HASH if only one foreign key exists for the table. It will be an ARRAY if there is more # than one. In addtion, a local relationship HASH holds the names of the tables in which # relationships were made so only one relationship is constructed for tables with many # foreign keys to the same table. #### sub _processForeignKeys { my ($localSelf, $localClass, $localXML, $localTablename) = @_; if (exists $localXML->{'table'}{$localTablename}{'foreign-key'}) { no strict 'refs'; if (ref($localXML->{'table'}{$localTablename}{'foreign-key'}) eq 'HASH' ) { # this table has only one foreign-key #print "$localTablename has only one foreign key \n"; #print Dumper($localXML ->{'table'}{$localTablename}{'foreign-key'}); my %fKeyHash = (%{$localXML->{'table'}{$localTablename}{'foreign-key'}}); _buildFKRelationship($localSelf, $localClass, $fKeyHash{"foreignTable"}); if (exists $localXML ->{'table'}{$localTablename}{'foreign-key'}{'reference'}) { _addFKOperation($localClass, _constructForeignKey(%{$localXML ->{'table'}{$localTablename}{'foreign-key'}{'reference'}}), $fKeyHash{"foreignTable"}); } } else { # this table has more than one foreign-key #print "$localTablename has more than one foreign key \n"; #print Dumper($localXML->{table}{$localTablename}{'foreign-key'}); # hash that holds the foreign key table names # this is used to avoid a division by zero error if a reference is made to the # same table more than once. -jg my %relMade; # the foreign table name my $foreignTableName = ""; foreach my $fKeyArray (@{$localXML->{'table'}{$localTablename}{'foreign-key'}}) { #print Dumper($fKeyArray); $foreignTableName = $fKeyArray->{'foreignTable'}; #print "processing foreign key $foreignTableName \n"; if (!exists ($relMade{"$foreignTableName"})) { _buildFKRelationship($localSelf, $localClass, $foreignTableName); # add it to the hash of foreign table names $relMade{$foreignTableName} = $foreignTableName; } if (defined $fKeyArray->{'reference'}) { _addFKOperation($localClass, _constructForeignKey(%{$fKeyArray->{'reference'}}), $foreignTableName); } } } } } # end processForeignKeys #### # Processes the indexes using the given Class, XML, and tablename # # The processing here is complex due to the fact that the Torque schema DTD allows # a table to have multiple nodes defined each with one to many # nodes as well. #### sub _processIndexes { my ($localClass, $localXML, $localTablename) = @_; if (exists $localXML -> {'table'}{$localTablename}{'index'}) { no strict 'refs'; if (ref ($localXML->{'table'}{$localTablename}{'index'}) eq 'HASH') { # so this is a HASH; however, it could be that the HASH contains only one # index column or many just depending on the parse. #print Dumper($localXML->{'table'}{$localTablename}{'index'}); my %indexHash = %{$localXML->{'table'}{$localTablename}{'index'}{'index-column'}}; if (exists $indexHash{"name"}) { # this is indeed a single index column #print "$localTablename has only one index-column \n"; _addIndexOperation($localClass, $indexHash{"name"}); } else { foreach my $indexKey (keys %{$localXML->{'table'}{$localTablename}{'index'}{'index-column'}}) { # the key is the actual name of the column _addIndexOperation($localClass, $indexKey); } } } else { foreach my $indexArray (@{$localXML->{'table'}{$localTablename}{'index'}}) { #print "Indexed columns for $localTablename are: \n"; #print Dumper($indexArray); foreach my $indexKey (keys %{$indexArray->{'index-column'}}) { if ($indexKey eq "name") { # this is an instance of a table with multiple index nodes, one with # only one index-column and the other with many index-column nodes # so add the name of the column _addIndexOperation($localClass, $indexArray->{'index-column'}{'name'}); } else { # the key is the actual name of the column _addIndexOperation($localClass, $indexKey); } } # end foreach in keys } # end foreach in array } # end else } # end if exists } # end processIndexes #### # Process the unique columns of the table using the given Class, XML, and tablename # # Just like index columns, the processing here is complex due to the fact that # the Torque schema DTD allows a table to have multiple nodes defined each with # one to many nodes as well. #### sub _processUniqueColumns { my ($localClass, $localXML, $localTablename) = @_; if (exists $localXML -> {'table'}{$localTablename}{'unique'}) { no strict 'refs'; if (ref ($localXML->{'table'}{$localTablename}{'unique'}) eq 'HASH') { # so this is a HASH; however, it could be that the HASH contains only one # unique column or many just depending on the parse. #print Dumper($localXML->{'table'}{$localTablename}{'unique'}); my %uniqueHash = %{$localXML->{'table'}{$localTablename}{'unique'}{'unique-column'}}; if (exists $uniqueHash{"name"}) { # this is indeed a single unique column #print "$localTablename has only one unique-column \n"; _addUniqueOperation($localClass, $uniqueHash{"name"}); } else { foreach my $uniqueKey (keys %{$localXML->{'table'}{$localTablename}{'unique'}{'unique-column'}}) { # the key is the actual name of the column _addUniqueOperation($localClass, $uniqueKey); } } } else { # this is any array of unique columns foreach my $uniqueArray (@{$localXML->{'table'}{$localTablename}{'unique'}}) { #print "Unique columns for $localTablename are: \n"; #print Dumper($uniqueArray); foreach my $uniqueKey (keys %{$uniqueArray->{'unique-column'}}) { if ($uniqueKey eq "name") { # this is an instance of a table with multiple unique nodes, one with # only one unique-column and the other with many unique-column nodes # so add the name of the column _addUniqueOperation($localClass, $uniqueArray->{'unique-column'}{'name'}); } else { # the key is the actual name of the column _addUniqueOperation($localClass, $uniqueKey); } } # end foreach in keys } # end foreach in array } # end else } # end if exists } 1; ############################################################################### =head1 NAME Autodia::Handler::Torque.pm - AutoDia handler for Torque xml database schema =head1 INTRODUCTION This provides Autodia with the ability to read Torque Database Schema files, allowing you to convert them via the Diagram Export methods to images (using GraphViz and VCG) or html/xml using custom templates or to Dia. =head1 SYNOPSIS use Autodia::Handler::Torque; my $handler = Autodia::Handler::dia->New(\%Config); $handler->Parse(filename); # where filename includes full or relative path. =head1 Description The Torque handler will parse the xml file using XML::Simple and populating the diagram object with class, superclass, and relationships representing tables and relationships. The Torque handler is registered in the Autodia.pm module, which contains a hash of language names and the name of their respective language. An example Torque database schema is shown here - its actually a rather nice format apart from the Java studlyCaps..
=head1 METHODS =head2 CONSTRUCTION METHOD use Autodia::Handler::Torque; my $handler = Autodia::Handler::Torque->New(\%Config); This creates a new handler using the Configuration hash to provide rules selected at the command line. =head2 ACCESS METHODS $handler->Parse(filename); # where filename includes full or relative path. This parses the named file and returns 1 if successful or 0 if the file could not be opened. =head1 SEE ALSO Autodia Torque Autodia::Handler =cut Autodia-2.14/lib/Autodia/Handler/Mason.pm0000644000076400007640000001600011541621006017477 0ustar teejayteejaypackage Autodia::Handler::Mason; require Exporter; use strict; use vars qw($VERSION @ISA @EXPORT); use Autodia::Handler; @ISA = qw(Autodia::Handler Exporter); use Autodia::Diagram; use HTML::Mason; use Cwd; =head1 NAME Autodia::Handler::Mason - Allows Autodia to parse HTML::Mason files =head1 SYNOPSIS See L and L. Use -p to specify the comp_root and -i fetch one or more components, f.e. ./autodia.pl -l Mason -p 'examples/mason' -i 'index.html login.html' If you need to allow globals, f.e. $c and $l, add -G '$c $l' to the command line =head1 DESCRIPTION L using introspection provided by L to visualize all components used by a request. =cut =head1 API =cut =head2 _initialise creates the L instance used for introspection. =cut sub _initialise { my ($self, $config) = @_; my @Globals = split(/\s/, $config->{mason_globals}); $self->{MasonInterp} = new HTML::Mason::Interp->new(comp_root => Cwd::abs_path($config->{inputpath}), allow_globals => \@Globals); return $self->SUPER::_initialise($config, @_); } =head2 _parse_file walks through the request and initiates the recursion. =cut sub _parse_file { my $self = shift; my $componentname = shift; my $Diagram = $self->{Diagram}; my $comp_root = $self->{Config}->{inputpath}; $componentname =~ s/^$comp_root//; # strip comp_root $componentname = '/'.$componentname unless $componentname =~ /^\//; # add / if neccessary # load component for introspection my $Component = $self->{MasonInterp}->load($componentname); return 0 unless defined $Component; $self->_process_component($Component); return 1; } =head2 _process_component adds a component to the diagram. This is done recursively for the parent and each called component. =cut sub _process_component { my ($self, $Component) = @_; my $Diagram = $self->{Diagram}; # we hopefully see some components more than once return $self->{ProcessedComponents}{$Component->title()} if exists $self->{ProcessedComponents}{$Component->title()}; # create new class with name my $Class = Autodia::Diagram::Class->new($Component->title()); # add class to diagram $Class = $Diagram->add_class($Class); $self->{ProcessedComponents}{$Component->title()} = $Class; # process parent if(defined $Component->parent()) { my $Superclass = $self->_process_component($Component->parent); my $Relationship = Autodia::Diagram::Inheritance->new($Class, $Superclass); # add Relationship to superclass $Superclass->add_inheritance($Relationship); # add Relationship to class $Class->add_inheritance($Relationship); # add Relationship to diagram $self->{Diagram}->add_inheritance($Relationship); } # Args are reported as public attributes my $Args = $Component->declared_args(); foreach my $ArgName (sort keys %$Args) { $Class->add_attribute($self->_build_attribute($ArgName, $Args->{$ArgName})); } # Methods are reported as public operations my $Methods = $Component->methods(); foreach my $MethodName (sort keys %$Methods) { my $MethodComponent = $Methods->{$MethodName}; my $MethodArgs = $MethodComponent->declared_args(); $Class->add_operation({ name => $MethodName, visibility => 0, Params => [ map { $self->_build_Param($_, $MethodArgs->{$_}) } sort keys %$MethodArgs ] }); } # Subcomponents are reported as private operations my $Subcomps = $Component->subcomps(); foreach my $SubcompName (sort keys %$Subcomps) { my $SubcompComponent = $Subcomps->{$SubcompName}; my $SubcompArgs = $SubcompComponent->declared_args(); $Class->add_operation({ name => $SubcompName, visibility => 1, Params => [ map { $self->_build_Param($_, $SubcompArgs->{$_}) } sort keys %$SubcompArgs ] }); } # Attributes are reported as public operations with a type my $Attributes = $Component->attributes(); foreach my $AttributeName (sort keys %$Attributes) { $Class->add_operation({ name => $AttributeName, visibility => 0, type => 'scalar', value => $Attributes->{$AttributeName}}); } # Parse source for dependancies. If you have a better way to gather all called components -- let me know. # Calls in comments will be found as well. Calls disguised in variables won't be discovered. if($Component->is_file_based) { open(FH, "<", $Component->source_file); my $Source = join('', ); close(FH); my @ComponentCalls = $Source =~ /comp\(([^,)]+)/g; push @ComponentCalls, $Source =~ /<&\|?([^,&]+)/g; foreach (@ComponentCalls) { s/^['"\s]+|['"\s]+$//g; # trim spaces and quotationmarks next if /^(PARENT|SELF):/ or exists $Subcomps->{$_}; # dependancies to SELF, parents or subcomponents are obvious my $absCall = /^\// ? $_ : $Component->dir_path().'/'.$_ ; my $compCall = $self->{MasonInterp}->load($absCall); unless (defined $compCall) { warn "Can't find component: $absCall in file ".$Component->source_file; next; } my $callClass = $self->_process_component($compCall); my $Relationship = Autodia::Diagram::Dependancy->new($Class, $callClass); # add Relationship to callClass $callClass->add_dependancy($Relationship); # add Relationship to class $Class->add_dependancy($Relationship); # add Relationship to diagram $self->{Diagram}->add_dependancy($Relationship); } } return $Class } =head2 helper method to convert the declared_args of components to attributes =cut sub _build_attribute { my ($self, $ArgName, $ArgValue) = @_; my ($TypeSymbol, $PlainName) = unpack('A1A*', $ArgName); my %TypeMap = ( '$' => 'scalar', '%' => 'hash', '@' => 'array' ); my @DiaParams = (visibility => 0); if(exists $TypeMap{$TypeSymbol}) { push @DiaParams, (name => $PlainName, type => $TypeMap{$TypeSymbol}); } else { push @DiaParams, (name => $TypeSymbol.$PlainName); } if( defined $ArgValue and defined $ArgValue->{'default'} ) { push @DiaParams, (value => $ArgValue->{'default'}); } return { @DiaParams }; } =head2 helper method to convert the declared_args of methods and subcomponents to Params =cut sub _build_Param { my ($self, $ArgName, $ArgValue) = @_; my ($TypeSymbol, $PlainName) = unpack('A1A*', $ArgName); my %TypeMap = ( '$' => 'scalar', '%' => 'hash', '@' => 'array' ); my @DiaParams = (Kind => 1); if(exists $TypeMap{$TypeSymbol}) { push @DiaParams, (Name => $PlainName, Type => $TypeMap{$TypeSymbol}); } else { push @DiaParams, (Name => $TypeSymbol.$PlainName); } if( defined $ArgValue and defined $ArgValue->{'default'} ) { push @DiaParams, (Value => $ArgValue->{'default'}); } return { @DiaParams }; } ####----- 1; =head1 AUTHOR Peter Franke, 2011, autodia_mason@pfranke.de =head1 LICENSE This library is free software, you can redistribute it and/or modify it under the same terms as Perl itself. =cut Autodia-2.14/lib/Autodia/Handler/ASP.pm0000644000076400007640000002602111337325121017053 0ustar teejayteejay################################################################ # AutoDIA - Automatic Dia XML. (C)Copyright 2001 A Trevena # # # # AutoDIA comes with ABSOLUTELY NO WARRANTY; see COPYING file # # This is free software, and you are welcome to redistribute # # it under certain conditions; see COPYING file for details # # # # Created by Gnavicks # # Version 1.0 # # February 11, 2010 # ################################################################ package Autodia::Handler::ASP; require Exporter; use strict; # requires 'my' keyword on variables use vars qw($VERSION @ISA @EXPORT); use Autodia::Handler; use Data::Dumper; # enables the Dumper method @ISA = qw(Autodia::Handler Exporter); use Autodia::Diagram; #--------------------------------------------------------------- ##################### # Constructor Methods # new inherited from Handler #------------------------------------------------------------------------ # Access Methods # parse_file inherited from Handler #----------------------------------------------------------------------------- # Internal Methods # _initialise inherited from Handler sub _parse { my $self = shift; my $fh = shift; my $filename = shift; my $Diagram = $self->{Diagram}; my $Class; $self->{pod} = 0; # create 'this' file my @newclass = reverse split (/\//, $filename); $Class = Autodia::Diagram::Class->new($newclass[0]); # add component to diagram my $classExists = $Diagram->add_class($Class); # replace component if redundant if (ref $classExists) { $Class = $classExists; } # parse through file looking for stuff foreach my $line (<$fh>) { chomp $line; if ($self->_discard_line($line)) { next; } # removes trailing single line comment of (') type if($line !~ /\(\s*\'.*\'\s*\).*$/) { # if not a javascript call $line =~ s/\'.*$//; } $line =~ s/\\\\.*$//; # removes trailing single line comment of (//) type # finds all the ASP includes like if ($line =~ /.*\#include.+["'](.+)["']/i) { my $componentName = $1; # print "componentname: $componentName matched on:\n$line\n"; # create component my @newComponent = reverse split (/\//, $componentName); my $Component = Autodia::Diagram::Class->new($newComponent[0]); # add component to diagram my $exists = $Diagram->add_class($Component); # replace component if redundant if (ref $exists) { $Component = $exists; } # create new relation (association) my $Relation = Autodia::Diagram::Relation->new($Class, $Component); # add relation to diagram $Diagram->add_relation($Relation); # add relation to class $Class->add_relation($Relation); # add relation to component $Component->add_relation($Relation); next; } # end if # finds all the JavaScript file includes like if ($line =~ /.*JavaScript.+SRC\=\"(.+)\"\>/i) { my $componentName = $1; # print "componentname: $componentName matched on:\n$line\n"; # create component my @newComponent = reverse split (/\//, $componentName); my $Component = Autodia::Diagram::Class->new($newComponent[0]); # add component to diagram my $exists = $Diagram->add_class($Component); # replace component if redundant if (ref $exists) { $Component = $exists; } # create new relation (association) my $Relation = Autodia::Diagram::Relation->new($Class, $Component); # add relation to diagram $Diagram->add_relation($Relation); # add relation to class $Class->add_relation($Relation); # add relation to component $Component->add_relation($Relation); next; } # end if # finds all the CSS StyleSheet file includes if ($line =~ /.*stylesheet.+HREF\=\"(.+)\"\>/i) { my $componentName = $1; # print "componentname: $componentName matched on:\n$line\n"; # create component my @newComponent = reverse split (/\//, $componentName); my $Component = Autodia::Diagram::Class->new($newComponent[0]); # add component to diagram my $exists = $Diagram->add_class($Component); # replace component if redundant if (ref $exists) { $Component = $exists; } # create new relation (association) my $Relation = Autodia::Diagram::Relation->new($Class, $Component); # add relation to diagram $Diagram->add_relation($Relation); # add relation to class $Class->add_relation($Relation); # add relation to component $Component->add_relation($Relation); next; } # end if # finds all "new" dependancies if ($line =~ /^.*=\s*new\s+([^\s\(\)\{\}\;]+)/ || $line =~ /(\w+)::/) { my $componentName = $1; # print "componentname: $componentName matched on:\n$line\n"; # create component my $Component = Autodia::Diagram::Component->new($componentName); # add component to diagram my $exists = $Diagram->add_component($Component); # replace component if redundant if (ref $exists) { $Component = $exists; } # create new dependancy my $Dependancy = Autodia::Diagram::Dependancy->new($Class, $Component); # add dependancy to diagram $Diagram->add_dependancy($Dependancy); # add dependancy to class $Class->add_dependancy($Dependancy); # add dependancy to component $Component->add_dependancy($Dependancy); } # end if # if line contains an attribute then parse for it if ($line =~ /^\s*const\s+([^\s=\{\}\(\)]+)/i) { my $attribute_name = $1; # print "Attr found: $attribute_name\n$line\n"; $Class->add_attribute({ name => $attribute_name, visibility => 0, }); } # end if # if line contains a function or sub then parse for method data if ($line =~ /([^\s\<\%]*.*)(function|sub)\s+([^\s\(\)\%\>]+)/i) { my $subname = $3; # print "Function found: $subname\n$line\n"; my $method_modifier = $1; if(not defined $method_modifier) { $method_modifier = ""; } my %subroutine = ( "name" => $subname, ); $subroutine{"visibility"} = ($method_modifier =~ m/private/i) ? 1 : ($method_modifier =~ m/protected/i) ? 2 : ($subroutine{"name"} =~ m/^\_/) ? 1 : 0; # check for explicit parameters if ($line =~ /(function|sub)\s+(\S+)\s*\((.+?)\)/i) { my $parameter_string = $3; $parameter_string =~ s/\s*//g; # print "Params: $parameter_string\n"; my @parameters1 = split(",",$parameter_string); my @parameters; foreach my $par (@parameters1) { $par =~ s/^\s+|\s+$//g; push @parameters, { Name => $par, }; } # end foreach $subroutine{"Params"} = \@parameters; } # end if # print Dumper(\%subroutine); $Class->add_operation(\%subroutine); } # end if # finds all the misc objects and relates them by dependancy if ($line =~ /([^\s\\\/\'\"\(\=]+)\.(asp|mdb|gif|jpg|htm|html|zip|java|class|js)[^a-z]/i) { my $componentName = $1; my $fileExt = $2; # print "componentname: $componentName.$fileExt matched on:\n$line\n"; # create component my $Component = Autodia::Diagram::Class->new($componentName.".".$fileExt); # add component to diagram my $exists = $Diagram->add_class($Component); # replace component if redundant if (ref $exists) { $Component = $exists; } # create new dependancy my $Dependancy = Autodia::Diagram::Dependancy->new($Class, $Component); # add dependancy to diagram $Diagram->add_dependancy($Dependancy); # add dependancy to class $Class->add_dependancy($Dependancy); # add dependancy to component $Component->add_dependancy($Dependancy); } # end if } # end main foreach $self->{Diagram} = $Diagram; return; } # end _parse() ####----- sub _discard_line { my $self = shift; my $line = shift; my $discard = 0; SWITCH: { # if line is blank or white space discard if ($line =~ m/^\s*$/) { $discard = 1; last SWITCH; } # if line is a comment (') discard if ($line =~ /^\s*\'/) { $discard = 1; last SWITCH; } # if line is a comment (//) discard if ($line =~ /^\s*\/\//) { $discard = 1; last SWITCH; } # if line starts with pod start syntax discard and flag with $pod if ($line =~ /^\s*\=pod/) { $self->{pod} = 1; $discard = 1; last SWITCH; } # if line starts with pod start syntax discard and flag with $pod if ($line =~ /^\s*\=head/) { $self->{pod} = 1; $discard = 1; last SWITCH; } # if line starts with pod end syntax then unflag and discard if ($line =~ /^\s*\=cut/) { $self->{pod} = 0; $discard = 1; last SWITCH; } # if line starts with HTML start comment syntax then discard and flag with $pod (avoids ignoring ASP includes) if ($line =~ /^\s*\<\!\-\-/ && $line !~ /.*\#include/i) { # if same line ends with the HTML end comment syntax then unflag and discard if ($line =~ /\s*\-\-\>\s*$/ || $line =~ /\s*\/\/s*$/) { $self->{pod} = 0; $discard = 1; last SWITCH; } else { # otherwise we are in pod $self->{pod} = 1; $discard = 1; last SWITCH; } } # if line ends with the HTML comment syntax then unflag and discard (avoids ignoring ASP includes) if ($line =~ /\s*\-\-\>\s*$/ && $line !~ /.*\#include/i) { $self->{pod} = 0; $discard = 1; last SWITCH; } # if line is part of pod or HTML comment then discard if ($self->{pod} == 1) { $discard = 1; last SWITCH; } } # end switch return $discard; } # end _discard_line() ####----- 1; ############################################################################### =head1 NAME Autodia::Handler::ASP - AutoDia handler for ASP =head1 INTRODUCTION Autodia::Handler::ASP is registered in the Autodia.pm module, which contains a hash of language names and the name of their respective language - in this case: %language_handlers = ( .. , asp => "Autodia::Handler::ASP", .. ); %patterns = ( .. , asp => \%asp, .. ); my %asp = ( regex => '\w+.asp', wildcards => ['asp'], ); =head1 CONSTRUCTION METHOD use Autodia::Handler::ASP; my $handler = Autodia::Handler::ASP->New(\%Config); This creates a new handler using the Configuration hash to provide rules selected at the command line. =head1 ACCESS METHODS $handler->Parse(filename); # where filename includes full or relative path. This parses the named file and returns 1 if successful or 0 if the file could not be opened. $handler->output(); # any arguments are ignored. This outputs the output file according to the rules in the %Config hash passed at initialisation of the object and the template. =cutAutodia-2.14/lib/Autodia/Handler/Perl.pm0000644000076400007640000006601411445640376017354 0ustar teejayteejaypackage Autodia::Handler::Perl; require Exporter; use strict; =head1 NAME Autodia::Handler::Perl.pm - AutoDia handler for perl =head1 DESCRIPTION HandlerPerl parses files into a Diagram Object, which all handlers use. The role of the handler is to parse through the file extracting information such as Class names, attributes, methods and properties. HandlerPerl parses files using simple perl rules. A possible alternative would be to write HandlerCPerl to handle C style perl or HandleHairyPerl to handle hairy perl. HandlerPerl is registered in the Autodia.pm module, which contains a hash of language names and the name of their respective language - in this case: %language_handlers = { .. , perl => "perlHandler", .. }; =cut use Data::Dumper; use vars qw($VERSION @ISA @EXPORT); use Autodia::Handler; @ISA = qw(Autodia::Handler Exporter); use Autodia::Diagram; =head1 METHODS =head2 CONSTRUCTION METHOD use Autodia::Handler::Perl; my $handler = Autodia::Handler::Perl->New(\%Config); This creates a new handler using the Configuration hash to provide rules selected at the command line. =head2 ACCESSOR METHODS $handler->Parse(filename); # where filename includes full or relative path. This parses the named file and returns 1 if successful or 0 if the file could not be opened. $handler->output(); # any arguments are ignored. This outputs the Dia XML file according to the rules in the %Config hash passed at initialisation of the object. =cut sub find_files_by_packagename { my $config = shift; my $args = $config->{args}; my @filenames = (); die "not implemented yet, sorry\n"; my @incdirs = @INC; if ($config) { unshift (@incdirs, split(" ",$args->{'d'})); } my @regexen = map ( s|::|\/|g, split(" ",$args->{'i'})); find ( { wanted => sub { unless (-d) { foreach my $regex (@regexen) { push @filenames, $File::Find::name if ($File::Find::name =~ m/$regex/); } } }, preprocess => sub { my @return; foreach (@_) { push(@return,$_) unless (m/^.*\/?(CVS|RCS)$/ && $config->{skipcvs}); } return @return; }, }, @incdirs ); return @filenames; } #------------------------------------------------------------------------ # Access Methods # parse_file inherited from Autodia::Handler #----------------------------------------------------------------------------- # Internal Methods # _initialise inherited from Autodia::Handler sub _parse { my $self = shift; my $fh = shift; my $filename = shift; my $Diagram = $self->{Diagram}; my $pkg_regexp = '[A-Za-z][\w:]+'; my $Class; # Class::Tangram bits $self->{_superclasses} = {}; $self->{_modules} = {}; $self->{_is_tangram_class} = {}; $self->{_in_tangram_class} = 0; $self->{_insideout_class} = 0; my $pat1 = '[\'\"]?\w+[\'\"]?\s*=>\s*\{.*?\}'; my $pat2 = '[\'\"]?\w+[\'\"]?\s*=>\s*undef'; # pod $self->{pod} = 0; # parse through file looking for stuff my $continue = {}; my $last_sub; my $line_no = 0; foreach my $line (<$fh>) { $line_no++; chomp $line; if ($self->_discard_line($line)) { # warn "discarded line : $line\n"; next; } # if line contains package name then parse for class name if ($line =~ /^\s*package\s+($pkg_regexp)?;?/ || $continue->{package}) { $line =~ /^\s*($pkg_regexp);/ if($continue->{package}); if(!$1) { warn "No package name! line $line_no : $line\n"; $continue->{package} = 1; next; } $continue->{package} = 0; my $className = $1; last if ($self->skip($className)); # create new class with name $Class = Autodia::Diagram::Class->new($className); # add class to diagram my $exists = $Diagram->add_class($Class); $Class = $exists if ($exists); } my $continue_base = $continue->{base}; if ($line =~ /^\s*use\s+(?:base|parent)\s+(?:q|qw|qq)?\s*([\'\"\(\{\/\#])\s*([^\'\"\)\}\/\#]*)\s*(\1|[\)\}])?/ or ($continue_base && $line =~ /$continue_base/)) { my $superclass = $2; my $end = $3 || ''; if ($continue_base) { # warn "continuing base\n"; $continue_base =~ s/[\)\}\'\"]/\\1/; # warn "base ctd : $continue_base\n"; # warn "superclass : " . ($superclass|| '') . "\n"; if ( $line =~ /(.*)\s*$continue_base?/ ) { $continue_base = 0; $superclass = $1; # warn "end of continued base\n"; } } else { # warn "start of base\n"; # warn "superclass : $superclass\n"; $continue_base = '[\)\}\'\"]'; if ($end) { $continue_base = 0; # warn "base is only 1 line\n"; } # warn "continue base : $continue_base\n"; } # warn "superclass : $superclass\n"; $continue->{base} = $continue_base; # check package exists before doing stuff $self->_is_package(\$Class, $filename); my @superclasses = split(/[\s*,]/, $superclass); foreach my $super (@superclasses) # WHILE_SUPERCLASSES { # discard if stopword next if ($super =~ /(?:exporter|autoloader)/i); # create superclass my $Superclass = Autodia::Diagram::Superclass->new($super); # add superclass to diagram $self->{_superclasses}{$Class->Name}{$super} = 1; if ($super =~ m/Class..Accessor\:*/) { $self->{_superclasses}{$Class->Name}{'Class::Accessor'} = 1; } $self->{_is_tangram_class}{$Class->Name} = {state=>0} if ($super eq 'Class::Tangram'); my $exists_already = $Diagram->add_superclass($Superclass); # warn "already exists ? $exists_already \n"; if (ref $exists_already) { $Superclass = $exists_already; } # create new inheritance my $Inheritance = Autodia::Diagram::Inheritance->new($Class, $Superclass); # add inheritance to superclass $Superclass->add_inheritance($Inheritance); # add inheritance to class $Class->add_inheritance($Inheritance); # add inheritance to diagram $Diagram->add_inheritance($Inheritance); } if (grep (/DBIx::Class$/,@superclasses)) { $self->{_dbix_class} = 1; } next; } # if line contains dependancy name then parse for module name if ($line =~ /^\s*(use|require)\s+($pkg_regexp)/) { # warn "found a module being used/required : $2\n"; unless (ref $Class) { # create new class with name $Class = Autodia::Diagram::Class->new($filename); # add class to diagram my $exists = $Diagram->add_class($Class); $Class = $exists if ($exists); } my $componentName = $2; # discard if stopword next if ($componentName =~ /^(strict|vars|exporter|autoloader|warnings.*|constant.*|data::dumper|carp.*|overload|switch|\d|lib)$/i); if ($componentName eq 'Class::XSAccessor') { $self->{_class_xsaccessor} = 1; } if ($componentName eq 'Object::InsideOut') { $self->{_insideout_class} = 1; if ($line =~ /^\s*use\s+.*qw\((.*)\)/) { my @superclasses = split(/[\s+]/, $1); foreach my $super (@superclasses) { my $Superclass = Autodia::Diagram::Superclass->new($super); # add superclass to diagram my $exists_already = $Diagram->add_superclass($Superclass); # warn "already exists ? $exists_already \n"; if (ref $exists_already) { $Superclass = $exists_already; } # create new inheritance my $Inheritance = Autodia::Diagram::Inheritance->new($Class, $Superclass); # add inheritance to superclass $Superclass->add_inheritance($Inheritance); # add inheritance to class $Class->add_inheritance($Inheritance); # add inheritance to diagram $Diagram->add_inheritance($Inheritance); } } next; } $self->{_modules}{$componentName} = 1; # check package exists before doing stuff $self->_is_package(\$Class, $filename); my $continue_fields = $continue->{fields}; if ($line =~ /\s*use\s+(fields|private|public)\s+(?:q|qw|qq){0,1}\s*([\'\"\(\{\/\#])\s*(.*)\s*([\)\}\1]?)/ or $continue_fields) { my ($pragma,$fields) = ($1,$3); # warn "pragma : $pragma .. fields : $fields\n"; if ($continue_fields) { $continue_fields =~ s/[\)\}\'\"]/\\1/; # warn "fields ctd : $continue_fields\n"; if ( $line =~ m/(.*)\s*$continue_fields?/ ) { $continue_fields = 0; $fields = $1; } } else { $continue_fields = '[\)\}\'\"]'; if ($fields =~ /(.*)([\)\}\1])/) { $continue_fields = 0; $fields = $1; } # warn "continue fields : $continue_fields\n"; } # warn "fields : $fields\n"; my @fields = split(/\s+/,$fields); foreach my $field (@fields) { # warn "fields : $field\n"; my $attribute_visibility = ( $field =~ m/^\_/ ) ? 1 : 0; unless ($pragma eq 'fields') { $attribute_visibility = ($pragma eq 'private' ) ? 1 : 0; } $Class->add_attribute({ name => $field, visibility => $attribute_visibility, Id => $Diagram->_object_count, }) unless ($field =~ /^\$/); } } else { # create component my $Component = Autodia::Diagram::Component->new($componentName); # add component to diagram my $exists = $Diagram->add_component($Component); # replace component if redundant if (ref $exists) { $Component = $exists; } # create new dependancy my $Dependancy = Autodia::Diagram::Dependancy->new($Class, $Component); # add dependancy to diagram $Diagram->add_dependancy($Dependancy); # add dependancy to class $Class->add_dependancy($Dependancy); # add dependancy to component $Component->add_dependancy($Dependancy); next; } $continue->{fields} = $continue_fields; } # if ISA in line then extract templates/superclasses if ($line =~ /^\s*\@(?:\w+\:\:)*ISA\s*\=\s*(?:q|qw){0,1}\((.*)\)/) { my $superclass = $1; $superclass =~ s/[\'\",]//g; # warn "handling superclasses $1 with \@ISA\n"; # warn "superclass line : $line \n"; if ($superclass) { # check package exists before doing stuff $self->_is_package(\$Class, $filename); my @superclasses = split(" ", $superclass); foreach my $super (@superclasses) # WHILE_SUPERCLASSES { # discard if stopword next if ($super =~ /(?:exporter|autoloader)/i || !$super); # create superclass my $Superclass = Autodia::Diagram::Superclass->new($super); # add superclass to diagram my $exists_already = $Diagram->add_superclass($Superclass); # warn "already exists ? $exists_already \n"; if (ref $exists_already) { $Superclass = $exists_already; } $self->{_superclasses}{$Class->Name}{$super} = 1; $self->{_is_tangram_class}{$Class->Name} = {state=>0} if ($super eq 'Class::Tangram'); # create new inheritance # warn "creating inheritance from superclass : $super\n"; my $Inheritance = Autodia::Diagram::Inheritance->new($Class, $Superclass); # add inheritance to superclass $Superclass->add_inheritance($Inheritance); # add inheritance to class $Class->add_inheritance($Inheritance); # add inheritance to diagram $Diagram->add_inheritance($Inheritance); } } else { warn "ignoring empty \@ISA line $line_no \n"; } } if ($self->{_modules}{Moose} && $line =~ m/extends (?:q|qw|qq)?\s*([\'\"\(\{\/\#])\s*([^\'\"\)\}\/\#]*)\s*(\1|[\)\}])?/ ) { my $superclass = $2; my @superclasses = split(/[\s*,]/, $superclass); foreach my $super (@superclasses) # WHILE_SUPERCLASSES { my $Superclass = Autodia::Diagram::Superclass->new($super); # add superclass to diagram $self->{_superclasses}{$Class->Name}{$super} = 1; my $exists_already = $Diagram->add_superclass($Superclass); # warn "already exists ? $exists_already \n"; if (ref $exists_already) { $Superclass = $exists_already; } # create new inheritance my $Inheritance = Autodia::Diagram::Inheritance->new($Class, $Superclass); # add inheritance to superclass $Superclass->add_inheritance($Inheritance); # add inheritance to class $Class->add_inheritance($Inheritance); # add inheritance to diagram $Diagram->add_inheritance($Inheritance); } } # Handle Class::Tangram classes if (ref $self) { if ($line =~ /^\s*(?:our|my)?\s+\$fields\s(.*)$/ and defined $self->{_is_tangram_class}{$Class->Name}) { $self->{_field_string} = ''; # warn "tangram parser : found start of fields for ",$Class->Name,"\n"; $self->{_field_string} = $1; # warn "field_string : $self->{_field_string}\n"; $self->{_in_tangram_class} = 1; if ( $line =~ /^(.*\}\s*;)/) { # warn "found end of fields for ",$Class->Name,"\n"; $self->{_in_tangram_class} = 2; } } if ($self->{_in_tangram_class}) { if ( $line =~ /^(.*\}\s*;)/ && $self->{_in_tangram_class} == 1) { # warn "found end of fields for ",$Class->Name,"\n"; $self->{_field_string} .= $1; $self->{_in_tangram_class} = 2; } else { # warn "adding line to fields for ",$Class->Name,"\n"; $self->{_field_string} .= $line unless ($self->{_in_tangram_class} == 2); } if ($self->{_in_tangram_class} == 2) { # warn "processing fields for ",$Class->Name,"\n"; $_ = $self->{_field_string}; s/^\s*\=\s*\{\s//; s/\}\s*;$//; s/[\s\n]+/ /g; # warn "fields : $_\n"; my %field_types = m/(\w+)\s*=>\s*[\{\[]\s*($pat1|$pat2|qw\([\w\s]+\))[\s,]*[\}\]]\s*,?\s*/g; # warn Dumper(field_types=>%field_types); foreach my $field_type (keys %field_types) { # warn "handling $field_type..\n"; $_ = $field_types{$field_type}; my $pat1 = '\'\w+\'\s*=>\s*\{.*?\}'; my $pat2 = '\'\w+\'\s*=>\s*undef'; my %fields; if (/qw\((.*)\)/) { my $fields = $1; # warn "qw fields : $fields\n"; my @fields = split(/\s+/,$fields); @fields{@fields} = @fields; } else { %fields = m/[\'\"]?(\w+)[\'\"]?\s*=>\s*([\{\[].*?[\}\]]|undef)/g; } # warn Dumper(fields=>%fields); foreach my $field (keys %fields) { # warn "found field : '$field' of type '$field_type' in (class ",$Class->Name,") : \n"; my $attribute = { name=>$field, type=>$field_type, Id => $Diagram->_object_count, }; if ($fields{$field} =~ /class\s*=>\s*[\'\"](.*?)[\'\"]/) { $attribute->{type} = $1; } if ($fields{$field} =~ /init_default\s*=>\s*[\'\"](.*?)[\'\"]/) { $attribute->{default} = $1; # FIXME : attribute default values unsupported ? } $attribute->{visibility} = ( $attribute->{name} =~ m/^\_/ ) ? 1 : 0; $Class->add_attribute($attribute); } } $self->{_in_tangram_class} = 0; } } } # handle Class::DBI/Ima::DBI if ($line =~ /->columns\(\s*All\s*=>\s*(.*)$/) { my $columns = $1; my @cols; if ($columns =~ s/^qw(.)//) { $columns =~ s/\s*[\)\]\}\/\#\|]\s*\)\s*;\s*(#.*)?$//; @cols = split(/\s+/,$columns); } elsif ($columns =~ /'.+'/) { @cols = map( /'(.*)'/ ,split(/\s*,\s*/,$columns)); } else { warn "can't parse CDBI style columns line $line_no\n"; next; } foreach my $col ( @cols ) { # add attribute my $visibility = ( $col =~ m/^\_/ ) ? 1 : 0; $Class->add_attribute({ name => $col, visibility => $visibility, Id => $Diagram->_object_count, }); # add accessor $Class->add_operation({ name => $col, visibility => $visibility, Id => $Diagram->_object_count() } ); } $continue->{cdbi_cols} = 1 unless $line =~ s/(.*)\)\s*;(#.*)?\s*$/$1/; next; } # handle Class::Data::Inheritable # Stuff->mk_classdata( if ( $Class && $self->{_superclasses}{$Class->Name}{'Class::Data::Inheritable'} ) { if ($line =~ /->mk_classdata\((\w+)/) { my $attribute = $1; my $visibility = ( $attribute =~ m/^\_/ ) ? 1 : 0; $Class->add_attribute({ name => $attribute, visibility => $visibility, Id => $Diagram->_object_count, }); # add accessor $Class->add_operation({ name => $attribute, visibility => $visibility, Id => $Diagram->_object_count() } ); } } if ( $Class && $self->{_superclasses}{$Class->Name}{'Class::Accessor'} ) { # handle Class::Accessor if ($line =~ /->mk_accessors\s*\(\s*(.*)$/) { my $attributes = $1; my @attributes; if ($attributes =~ s/^qw(.)//) { $attributes =~ s/\s*[\)\]\}\/\#\|]\s*\)\s*;\s*(#.*)?$//; @attributes = split(/\s+/,$attributes); } elsif ($attributes =~ /'.+'/) { @attributes = map( /'(.*)'/ ,split(/\s*,\s*/,$attributes)); } else { warn "can't parse CDBI style attributes line $line_no\n"; next; } foreach my $attribute ( @attributes ) { # add attribute next unless ($attribute =~ m/\w+/); my $visibility = ( $attribute =~ m/^\_/ ) ? 1 : 0; $Class->add_attribute({ name => $attribute, visibility => $visibility, Id => $Diagram->_object_count, }); # add accessor if not already present unless ($Class->get_operation($attribute)) { $Class->add_operation({ name => $attribute, visibility => $visibility, Id => $Diagram->_object_count() } ); } } $continue->{class_accessor_attributes} = 1 unless $line =~ s/(.*)\)\s*;(#.*)?\s*$/$1/; next; } } if ($continue->{class_accessor_attributes}) { my @attributes; $continue->{class_accessor_attributes} = 0 if $line =~ s/(.*)\)\s*;(#.*)?\s*$/$1/; if ($line =~ /'.+'/) { $line =~ s/\s*[\)\]\}\/\#\|]\s*$//; @attributes = map( /'(.*)'/ ,split(/\s*,\s*/,$line)); } else { @attributes = split(/\s+/,$line); } foreach my $attribute ( @attributes ) { next unless ($attribute =~ m/\w+/); # add attribute my $visibility = ( $attribute =~ m/^\_/ ) ? 1 : 0; $Class->add_attribute({ name => $attribute, visibility => $visibility, Id => $Diagram->_object_count, }); # add accessor if not already present unless ($Class->get_operation($attribute)) { $Class->add_operation({ name => $attribute, visibility => $visibility, Id => $Diagram->_object_count() } ); } } } # handle Params::Validate if ($last_sub && $self->{_modules}{'Params::Validate'} && ( $line =~ m/validate(_pos)?\s*\(/ or $self->{_in_params_validate_arguments} )) { my $found_end = 0; # warn "found params::validate for sub $last_sub \n line : $line\n"; $self->{_in_params_validate_arguments} = 1; $self->{_in_params_validate_positional_arguments} = 1 if $line =~ m/validate_pos/ ; if ($line =~ m|\)\s*;|) { $found_end = 1; $line =~ s/\)\s*;.*//; # warn "found end \n"; } $self->{_params_validate_arguments} .= $line; if ($found_end) { my $validate_text = $self->{_params_validate_arguments}; # warn "found params::validate text : $validate_text\n"; # process with eval ala data::dumper $validate_text =~ s/.*validate\w*\s*\(\s*\@_\s*,//; # warn "evaluating params::validate text : $validate_text\n"; my $params = eval $validate_text; # warn Dumper $params; my $parameters = []; push (@$parameters, { Name => "(HASHREF)" }) unless ( $self->{_in_params_validate_positional_arguments} ); foreach my $param_name (keys %$params) { my $parameter = { Name => $param_name }; if (ref $params->{$param_name} && ( $params->{type} || $params->{isa} ) ) { $parameter->{Type} = $params->{type} || $params->{isa}; } push (@$parameters, $parameter); } if (scalar @$parameters) { my $operation = $Class->get_operation($last_sub); $operation->{Params} ||= []; push (@{$operation->{Params}}, @$parameters); $Class->update_operation($operation); } delete $self->{_params_validate_arguments}; $self->{_in_params_validate_arguments} = 0; $self->{_in_params_validate_positional_arguments} = 0; } } # handle DBIx::Class if ($self->{_dbix_class_columns}) { my $found_end = 0; $line =~ s/#.*$//; if ($line =~ m|\);|) { $found_end = 1; $line =~ s/\);.*//; } $self->{_dbix_class_columns} .= $line; if ($found_end) { my $columns_text = $self->{_dbix_class_columns} . '}'; # warn "class : , ", $Class->Name, "\n"; # warn "columns text : $columns_text \n"; # process with eval ala data::dumper my $columns = eval $columns_text; # warn Dumper $columns; foreach my $attr_name (keys %$columns) { $Class->add_attribute({ name => $attr_name, visibility => 0, Id => $Diagram->_object_count, type => $columns->{$attr_name}{data_type}, }); } delete $self->{_dbix_class_columns}; $self->{_dbix_class} = 0; } } # if line is DBIx::Class relationship then parse out if ($self->{_dbix_class_relation} or $line =~ /\-\>has_(many|one)\s*\((.*)/ or $line =~ /\-\>(belongs_to)\s*\((.*)/) { my $found_end = 0; $line =~ s/#.*$//; if ($line =~ m|\);|) { $found_end = 1; $line =~ s/\);.*//; } if ($line =~ /\-\>has_(many|one)\s*\((.*)/ or $line =~ /\-\>(belongs_to)\s*\((.*)/) { my ($rel_type, $rel_data) = ($1,$2); $rel_data =~ s/#.*$//; $self->{_dbix_class_relation}{rel_data} = "{ $rel_data "; $self->{_dbix_class_relation}{rel_type} = $rel_type; } else { $self->{_dbix_class_relation}{rel_data} .= $line; } if ($found_end) { my $reldata = $self->{_dbix_class_relation}{rel_data} . '}'; my ($rel_name,$related_classname) = split(/\s*(?:\=\>|,)\s*/,$reldata); $related_classname =~ s/['"]//g; $rel_name =~ s/^\W+//; $rel_name =~ s/['"]//g; unless ($related_classname) { warn "no related class in relation data : $reldata\n"; next; } # warn "creating relation : $rel_name to $related_classname\n"; my $Superclass = Autodia::Diagram::Superclass->new($related_classname); my $exists_already = $self->{Diagram}->add_superclass($Superclass); $Superclass = $exists_already if (ref $exists_already); # create new relationship my $Relationship = Autodia::Diagram::Relation->new($Class, $Superclass); # add Relationship to superclass $Superclass->add_relation($Relationship); # add Relationship to class $Class->add_relation($Relationship); # add Relationship to diagram $self->{Diagram}->add_relation($Relationship); $Class->add_operation({ name => $rel_name, visibility => 0, Id => $Diagram->_object_count() } ); } delete $self->{_dbix_class_relation}; } # if line is DBIx::Class column metadata then parse out if ($self->{_dbix_class} && $line =~ m/add_columns\s*\((.*)/) { my $field_data = $1; $field_data =~ s/#.*$//; $self->{_dbix_class_columns} = "{ $field_data "; } # if line is DBIx::Class component, then treat as superclass if ($line =~ m/->load_components\s*\(\s*(?:q|qw|qq)?\s*([\'\"\(\{\/\#])\s*([^\'\"\)\}\/\#]*)\s*(\1|[\)\}])?/ ) { my $component_string = $2; foreach my $component_name (grep (/^\+/ , split(/[\s,]+/, $component_string ))) { $component_name =~ s/['"+]//g; my $Superclass = Autodia::Diagram::Superclass->new($component_name); my $exists_already = $self->{Diagram}->add_superclass($Superclass); $Superclass = $exists_already if (ref $exists_already); # create new inheritance my $Inheritance = Autodia::Diagram::Inheritance->new($Class, $Superclass); $Superclass->add_inheritance($Inheritance); # add inheritance to class $Class->add_inheritance($Inheritance); # add inheritance to diagram $self->{Diagram}->add_inheritance($Inheritance); } } # add Moose attributes if ($self->{_modules}{Moose} && $line =~ /^\s*has\s+'?(\w+)'?/) { my $attr_name = $1; $Class->add_attribute({ name => $attr_name, visibility => 0, Id => $Diagram->_object_count, }); } if ( $self->{_class_xsaccessor} ) { } # if line is Object::InsideOut metadata then parse out if ($self->{_insideout_class} && $line =~ /^\s*my\s+\@\w+\s+\:FIELD\s*\((.*)\)/) { my $field_data = $1; $field_data =~ s/['"\s]//g; my %field_data = split( /\s*(?:=>|,)\s*/, $field_data); (my $col = $field_data{Get} ) =~ s/get_//; $Class->add_attribute({ name => $col, visibility => 0, Id => $Diagram->_object_count, }); foreach my $key ( keys %field_data ) { # add accessor/mutator if ($key =~ m/(Get|Set|Acc|Mut|Com)/) { $Class->add_operation({ name => $field_data{$key}, visibility => 0, Id => $Diagram->_object_count() } ); } } } # if line contains sub then parse for method data if ($line =~ /^\s*sub\s+?(\w+)/) { my $subname = $1; # check package exists before doing stuff $self->_is_package(\$Class, $filename); $subname =~ s/^(.*?)['"]\..*$/${1}_xxxx/; $last_sub = $subname; my %subroutine = ( "name" => $subname, ); $subroutine{"visibility"} = ($subroutine{"name"} =~ m/^\_/) ? 1 : 0; $subroutine{"Id"} = $Diagram->_object_count(); # NOTE : perl doesn't provide named parameters # if we wanted to be clever we could count the parameters # see Autodia::Handler::PHP for an example of parameter handling unless ($Class->get_operation($subname)) { $Class->add_operation(\%subroutine); } } # if line contains object attributes parse add to class if ($line =~ m/\$(class|self|this)\-\>\{['"]*(.*?)["']*}/) { my $attribute_name = $2; $attribute_name =~ s/^(.*?)['"]\..*$/${1}_xxxx/; $attribute_name =~ s/['"\}\{\]\[]//g; # remove nasty badness my $attribute_visibility = ( $attribute_name =~ m/^\_/ ) ? 1 : 0; $Class->add_attribute({ name => $attribute_name, visibility => $attribute_visibility, Id => $Diagram->_object_count, }) unless ($attribute_name =~ /^\$/); } } $self->{Diagram} = $Diagram; close $fh; return; } sub _discard_line { my $self = shift; my $line = shift; my $discard = 0; SWITCH: { if ($line =~ m/^\s*$/) # if line is blank or white space discard { $discard = 1; last SWITCH; } if ($line =~ /^\s*\#/) # if line is a comment discard { $discard = 1; last SWITCH; } if ($line =~ /^\s*\=head/) # if line starts with pod syntax discard and flag with $pod { $self->{pod} = 1; $discard = 1; last SWITCH; } if ($line =~ /^\s*\=cut/) # if line starts with pod end syntax then unflag and discard { $self->{pod} = 0; $discard = 1; last SWITCH; } if ($self->{pod} == 1) # if line is part of pod then discard { $discard = 1; last SWITCH; } } return $discard; } ####----- sub _is_package { my $self = shift; my $package = shift; my $Diagram = $self->{Diagram}; unless(ref $$package) { my $filename = shift; # create new class with name $$package = Autodia::Diagram::Class->new($filename); # add class to diagram $Diagram->add_class($$package); } return; } ############################################################################### =head1 SEE ALSO Autodia::Handler Autodia::Diagram =head1 AUTHOR Aaron Trevena, Eaaron.trevena@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2001-2007 by Aaron Trevena This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.1 or, at your option, any later version of Perl 5 you may have available. =cut 1; Autodia-2.14/lib/Autodia/Handler/PHP.pm0000644000076400007640000002457711337330054017076 0ustar teejayteejay################################################################ # AutoDIA - Automatic Dia XML. (C)Copyright 2001 A Trevena # # # # AutoDIA comes with ABSOLUTELY NO WARRANTY; see COPYING file # # This is free software, and you are welcome to redistribute # # it under certain conditions; see COPYING file for details # ################################################################ package Autodia::Handler::PHP; require Exporter; use strict; use vars qw($VERSION @ISA @EXPORT); use Autodia::Handler; use Data::Dumper; @ISA = qw(Autodia::Handler Exporter); use Autodia::Diagram; #--------------------------------------------------------------- ##################### # Constructor Methods # new inherited from Handler #------------------------------------------------------------------------ # Access Methods # parse_file inherited from Handler #----------------------------------------------------------------------------- # Internal Methods # _initialise inherited from Handler sub _parse { my $self = shift; my $fh = shift; my $filename = shift; my $Diagram = $self->{Diagram}; my $incode = 0; my $inclass = 0; my $infunc = 0; my $inclassparen = 0; my $infuncparen = 0; my $incommentcount = 0; my $incomment = 0; my $Class; $self->{pod} = 0; # parse through file looking for stuff foreach my $line (<$fh>) { chomp $line; if ($self->_discard_line($line)) { next; } my $commentup = $line =~ tr/\/\*/\/\*/; my $commentdown = $line =~ tr/\*\//\*\//; $incommentcount = $commentup - $commentdown; if ($incommentcount > 0) { $incomment = 1; } else { $incomment = 0; } next if $incomment; $line =~ s|\/\/.*$||; my $up = $line =~ tr/\{/\{/; my $down = $line =~ tr/\}/\}/; $inclassparen = $inclassparen + $up - $down if ($inclass > 0); $infuncparen = $infuncparen + $up - $down if ($infunc > 0); $inclass = 0 if ($inclassparen < 1); $infunc = 0 if ($infuncparen < 1); # print "$inclassparen : $inclass $infuncparen : $infunc \n"; if ($line =~ /.*class\s+([^\s\(\)\{\}]+)/) { my $className = $1; $inclass = 1; $inclassparen = $up - $down; # print "Classname: $className matched on:\n$line\n"; last if ($self->skip($className)); $Class = Autodia::Diagram::Class->new($className); # add to diagram my $exists = $Diagram->add_class($Class); $Class = $exists if ($exists); if ($line =~ /.*extends\s+(\S+)/) { my $superclass = $1; $self->_is_package(\$Class, $filename); my @superclasses = split(" ", $superclass); foreach my $super (@superclasses) # WHILE_SUPERCLASSES { # discard if stopword next if ($super =~ /(?:exporter|autoloader)/i); # create superclass my $Superclass = Autodia::Diagram::Superclass->new($super); # add superclass to diagram my $exists_already = $Diagram->add_superclass($Superclass); if (ref $exists_already) { $Superclass = $exists_already; } # create new inheritance my $Inheritance = Autodia::Diagram::Inheritance->new($Class, $Superclass); # add inheritance to superclass $Superclass->add_inheritance($Inheritance); # add inheritance to class $Class->add_inheritance($Inheritance); # add inheritance to diagram $Diagram->add_inheritance($Inheritance); } } } if ($line =~ /^\s*(include|require|include_once|require_once)\s+\(*["']?([^\"\'\)]+)["']?\)*/) { my $componentName = $2; # print "componentname: $componentName matched on:\n$line\n"; # discard if stopword next if ($componentName =~ /(strict|vars|exporter|autoloader|data::dumper)/i); # check package exists before doing stuff $self->_is_package(\$Class, $filename); # create component my $Component = Autodia::Diagram::Component->new($componentName); # add component to diagram my $exists = $Diagram->add_component($Component); # replace component if redundant if (ref $exists) { $Component = $exists; } # create new dependancy my $Dependancy = Autodia::Diagram::Dependancy->new($Class, $Component); # add dependancy to diagram $Diagram->add_dependancy($Dependancy); # add dependancy to class $Class->add_dependancy($Dependancy); # add dependancy to component $Component->add_dependancy($Dependancy); } if ($line =~ /^.*=\s*new\s+([^\s\(\)\{\}\;]+)/ || $line =~ /(\w+)::/) { my $componentName = $1; # print "componentname: $componentName matched on:\n$line\n"; # discard if stopword next if ($componentName =~ /(self|parent|strict|vars|exporter|autoloader|data::dumper)/i); # check package exists before doing stuff $self->_is_package(\$Class, $filename); # create component my $Component = Autodia::Diagram::Component->new($componentName); # add component to diagram my $exists = $Diagram->add_component($Component); # replace component if redundant if (ref $exists) { $Component = $exists; } # create new dependancy my $Dependancy = Autodia::Diagram::Dependancy->new($Class, $Component); # add dependancy to diagram $Diagram->add_dependancy($Dependancy); # add dependancy to class $Class->add_dependancy($Dependancy); # add dependancy to component $Component->add_dependancy($Dependancy); } if ($line =~ /^\s*((((static|var|public|private|protected)\s+)+)\$|const\s+)([^\s=\{\}\(\)]+)/) { last unless $inclass; my $default; my $attribute_name = $5; my $class_modifier = $1; my $comment = ($class_modifier =~ m/static/) ? "static ": ""; $comment .= ($class_modifier =~ m/const/) ? "const": ""; my $attribute_visibility = ($class_modifier =~ m/(var|public|const)/) ? 0 : ($class_modifier =~ m/(protected)/) ? 2 : 1; $attribute_name =~ s/(.*);/$1/; if($attribute_name =~ m/^\_/ && $class_modifier =~ m/var/) { $attribute_visibility = 1; } if ($line =~ /^\s*((((static|var|public|private|protected)\s+)+)\$|const\s+)(\S+)\s*=\s*(.*)/) { $default = $6; $default =~ s/(.*);/$1/; $default =~ s/(.*)\/\/.*/$1/; $default =~ s/(.*)\/\*.*/$1/; } # print "Attr found: $attribute_name = $default\n$line\n"; $Class->add_attribute({ name => $attribute_name, visibility => $attribute_visibility, value => $default, }); } # if line contains sub then parse for method data if ($line =~ /([^\s]*)\s*function\s+&?(\w+)/) { unless ($inclass) { my @newclass = reverse split (/\//, $filename); $Class = Autodia::Diagram::Class->new($newclass[0]); # add to diagram my $exists = $Diagram->add_class($Class); $Class = $exists if ($exists); $inclass = 1; $inclassparen = $up - $down; } my $subname = $2; my $method_modifier = $1; $infunc = 1; $infuncparen = $up - $down; print "Function found: $subname\n$line\n"; my %subroutine = ( "name" => $subname, ); $subroutine{"visibility"} = ($method_modifier =~ m/private/) ? 1 : ($method_modifier =~ m/protected/) ? 2 : ($subroutine{"name"} =~ m/^\_/) ? 1 : 0; $subroutine{"inheritance_type"} = ($method_modifier =~ m/abstract/) ? 0 : ($method_modifier =~ m/final/) ? 2 : 1; # check for explicit parameters if ($line =~ /function\s+(\S+)\s*\((.+?)\)/) { my $parameter_string = $2; $parameter_string =~ s/\s*//g; $parameter_string =~ s/\$//g; # print "Params: $parameter_string\n"; my @parameters1 = split(",",$parameter_string); my @parameters; foreach my $par (@parameters1) { my ($name, $val) = split (/=/, $par); $val =~ s/["']//g if (defined $val); $name =~ s/^\s+|\s+$//g; my $kind; if($name =~ m/&/) { $name =~ s/&//g; $kind = 3; } else { $kind = 1; } my %temphash = ( Name => $name, Val => $val, Kind => $kind, ); push @parameters, \%temphash; } $subroutine{"Params"} = \@parameters; } # print Dumper(\%subroutine); $Class->add_operation(\%subroutine); } } $self->{Diagram} = $Diagram; return; } sub _discard_line { my $self = shift; my $line = shift; my $discard = 0; SWITCH: { if ($line =~ m/^\s*$/) # if line is blank or white space discard { $discard = 1; last SWITCH; } if ($line =~ /^\s*\/\//) # if line is a comment discard { $discard = 1; last SWITCH; } if ($line =~ /^\s*\=head/) # if line starts with pod syntax discard and flag with $pod { $self->{pod} = 1; $discard = 1; last SWITCH; } if ($line =~ /^\s*\=cut/) # if line starts with pod end syntax then unflag and discard { $self->{pod} = 0; $discard = 1; last SWITCH; } if ($self->{pod} == 1) # if line is part of pod then discard { $discard = 1; last SWITCH; } } return $discard; } ####----- sub _is_package { my $self = shift; my $package = shift; my $Diagram = $self->{Diagram}; unless(ref $$package) { my $filename = shift; # create new class with name $$package = Autodia::Diagram::Class->new($filename); # add class to diagram $Diagram->add_class($$package); } return; } ####----- 1; ############################################################################### =head1 NAME Autodia::Handler::PHP - AutoDia handler for PHP =head1 INTRODUCTION Autodia::Handler::PHP is registered in the Autodia.pm module, which contains a hash of language names and the name of their respective language - in this case: %language_handlers = ( .. , php => "Autodia::Handler::PHP", .. ); %patterns = ( .. , php => \%php, .. ); my %php = ( regex => '\w+\.php$', wildcards => [ "php","php3","php4" ], ); =head1 CONSTRUCTION METHOD use Autodia::Handler::PHP; my $handler = Autodia::Handler::PHP->New(\%Config); This creates a new handler using the Configuration hash to provide rules selected at the command line. =head1 ACCESS METHODS $handler->Parse(filename); # where filename includes full or relative path. This parses the named file and returns 1 if successful or 0 if the file could not be opened. $handler->output(); # any arguments are ignored. This outputs the output file according to the rules in the %Config hash passed at initialisation of the object and the template. =cut Autodia-2.14/lib/Autodia/Handler/umbrello.pm0000644000076400007640000001151211146246610020253 0ustar teejayteejaypackage Autodia::Handler::umbrello; require Exporter; use strict; =head1 NAME Autodia::Handler::umbrello - AutoDia handler for umbrello =head1 DESCRIPTION This provides Autodia with the ability to read umbrello files, allowing you to convert them via the Diagram Export methods to images (using GraphViz and VCG) or html/xml using custom templates. The umbrello handler will parse umbrello xml/xmi files using XML::Simple and populating the diagram object with class, superclass and package objects. the umbrello handler is registered in the Autodia.pm module, which contains a hash of language names and the name of their respective language - in this case: =head1 SYNOPSIS use Autodia::Handler::umbrello; my $handler = Autodia::Handler::umbrello->New(\%Config); $handler->Parse(filename); # where filename includes full or relative path. =cut use vars qw($VERSION @ISA @EXPORT); use Autodia::Handler; @ISA = ('Autodia::Handler' ,'Exporter'); use Autodia::Diagram; use Data::Dumper; use XML::Simple; =head1 METHODS =head2 CONSTRUCTION METHOD use Autodia::Handler::umbrello; my $handler = Autodia::Handler::umbrello->New(\%Config); This creates a new handler using the Configuration hash to provide rules selected at the command line. =head2 ACCESS METHODS $handler->Parse(filename); # where filename includes full or relative path. This parses the named file and returns 1 if successful or 0 if the file could not be opened. =cut ##################### # Constructor Methods # new inherited from Autodia::Handler #------------------------------------------------------------------------ # Access Methods # parse_file inherited from Autodia::Handler #----------------------------------------------------------------------------- # Internal Methods # _initialise inherited from Autodia::Handler sub _parse { my $self = shift; my $fh = shift; my $filename = shift; my $Diagram = $self->{Diagram}; my $xmldoc = XMLin($filename, ForceArray => 1, ForceContent => 1); # get version my $version = $xmldoc->{'XMI.header'}[0]{'XMI.documentation'}[0]{'XMI.exporterVersion'}[0]{content}; my $is_newstyle = 0; if ($version =~ /(\d\.\d).\d/) { $is_newstyle = 1 if ($1 > 1.1); } my $umlclasses_are_here = ( $is_newstyle ) ? 'UML:Model' : 'umlobjects' ; my @relationships; foreach my $classname (keys %{$xmldoc->{'XMI.content'}[0]{$umlclasses_are_here}[0]{'UML:Class'}}) { print "handling Class $classname : \n"; my $class = $xmldoc->{'XMI.content'}[0]{$umlclasses_are_here}[0]{'UML:Class'}{$classname}; my $Class = Autodia::Diagram::Class->new($classname); $Diagram->add_class($Class); foreach my $method ( @{get_methods($class)} ) { $Class->add_operation($method); } foreach my $attribute (@{get_attributes($class)}) { $Class->add_attribute( $attribute ); } # get superclass / stereotype if ($class->{stereotype}) { my $Superclass = Autodia::Diagram::Superclass->new($class->{stereotype}); # add superclass to diagram my $exists_already = $Diagram->add_superclass($Superclass); if (ref $exists_already) { $Superclass = $exists_already; } # create new inheritance my $Inheritance = Autodia::Diagram::Inheritance->new($Class, $Superclass); # add inheritance to superclass $Superclass->add_inheritance($Inheritance); # add inheritance to class $Class->add_inheritance($Inheritance); # add inheritance to diagram $Diagram->add_inheritance($Inheritance); } } return; } ############################ sub get_methods { my $class = shift; my $return = []; foreach my $methodname (keys %{$class->{'UML:Operation'}}) { my $type = $class->{'UML:Operation'}{$methodname}{type}; my $arguments = get_parameters($class->{'UML:Operation'}{$methodname}{'UML:Parameter'}); push(@$return,{name=>$methodname,type=>$type,Params=>$arguments, visibility=>0}); } return $return; } sub get_attributes { my $class = shift; my $return = []; foreach my $attrname (keys %{$class->{'UML:Attribute'}}) { my $type = $class->{'UML:Attribute'}{$attrname}{type}; push(@$return,{name=>$attrname,type=>$type, visibility=>0}); } return $return; } sub get_parameters { my $arguments = shift; my $return = []; if (ref $arguments) { @$return = map ( {Type=>$arguments->{$_}{type},Name=>$_}, keys %$arguments); } return $return; } ############################################################################### =head1 SEE ALSO Autodia::Handler Autodia::Diagram =head1 AUTHOR Aaron Trevena, Eaaron.trevena@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2001-2007 by Aaron Trevena This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.1 or, at your option, any later version of Perl 5 you may have available. =cut 1; Autodia-2.14/lib/Autodia/Handler/DBI.pm0000644000076400007640000001722011220650135017024 0ustar teejayteejay################################################################ # AutoDIA - Automatic Dia XML. (C)Copyright 2001 A Trevena # # # # AutoDIA comes with ABSOLUTELY NO WARRANTY; see COPYING file # # This is free software, and you are welcome to redistribute # # it under certain conditions; see COPYING file for details # ################################################################ package Autodia::Handler::DBI; require Exporter; use strict; use warnings; use warnings::register; use vars qw($VERSION @ISA @EXPORT); use Autodia::Handler; @ISA = qw(Autodia::Handler Exporter); use Autodia::Diagram; use Data::Dumper; use DBI; #--------------------------------------------------------------- ##################### # Constructor Methods # new inherited from Autodia::Handler #------------------------------------------------------------------------ # Access Methods # parse_file inherited from Autodia::Handler #----------------------------------------------------------------------------- # Internal Methods # _initialise inherited from Autodia::Handler sub _parse_file { # parses dbi-connection string my $self = shift(); my $filename = shift(); my %config = %{$self->{Config}}; $self->{Diagram}->directed(0); # new dbi connection my $dbh = DBI->connect("DBI:$filename", $config{username}, $config{password}); my $escape_tablenames = 0; my $unescape_tablenames=0; my $database_type = $dbh->get_info( 17 ); warn "database_type : $database_type\n"; my ($scheme, $driver, $attr_string, $attr_hash, $driver_dsn) = DBI->parse_dsn("DBI:$filename") or die "Can't parse DBI DSN '$filename'"; my $dbname; if ($driver_dsn =~ m/(?:db|dbname)=([^\:]+)/) { $dbname = $1; } else { ( $dbname = $driver_dsn) =~ s/([^\:]+)/$1/; } my $schema = '' ; # only keep tables in schema public for PostgreSQL # could be given as a parameter... (+ a list of tables...) $schema = 'public' if (lc($database_type) =~ m/(oracle|postgres)/); # Manage database tablenames that need to be escaped before calling DBI # and those that need to be unescaped before calling DBI $escape_tablenames = 1 if (lc($database_type) =~ m/(oracle|postgres)/); $unescape_tablenames = 1 if (lc($database_type) =~ m/(mysql)/); # pre-process tables foreach my $table ($dbh->tables(undef, $schema, '%', '')) { $table =~ s/['`"]//g; $table =~ s/.*\.(.*)$/$1/; my $esc_table = $table; $esc_table = qq{"$esc_table"} if ($escape_tablenames); my $sth = $dbh->prepare("select * from $esc_table where 1 = 0"); $sth->execute; $self->{tables}{$table}{fields} = $sth->{NAME}; $sth->finish; } # got to about here applying dbi datatypes patch foreach my $table (keys %{$self->{tables}}) { # create new 'class' representing table my $Class = Autodia::Diagram::Class->new($table); # add 'class' to diagram $self->{Diagram}->add_class($Class); # get fields my $esc_table = $table; $esc_table = qq{"${dbname}.$esc_table"} if ($escape_tablenames); warn "using dbname $dbname / table $esc_table\n"; my @key_columns; my $primary_key = { name=>'Key', type=>'Primary', Params=>[], visibility=>0, }; my $sth = $dbh->primary_key_info( $schema || undef, $dbname, $esc_table ); if (defined $sth) { @key_columns = keys %{$sth->fetchall_hashref('COLUMN_NAME')}; } else { warn "trying dbh -> primary key method using schema $schema, dbname : $dbname, table $esc_table\n"; # from DBIx::Class::Schema::Loader::DBI / Rose::DBI @key_columns = map { lc } $dbh->primary_key($schema || undef, $dbname, $esc_table); } warn "got key columns for table $esc_table : @key_columns\n"; if (@key_columns) { push (@{$primary_key->{Params}}, map ({ Name=>$_, Type=>''}, @key_columns)); $Class->add_operation($primary_key); } # FIXME : need to subclass db's that don't work # try using DBD, then use subclass to do horrid hacks my $guess_foreign_keys = 1; # get foreign keys $sth = $dbh->foreign_key_info( $schema || undef, $dbname, '', $schema || undef, $dbname, $esc_table ); if ($sth) { my %rels; my $i = 1; # for unnamed rels, which hopefully have only 1 column ... while(my $raw_rel = $sth->fetchrow_arrayref) { $guess_foreign_keys = 0 if ($guess_foreign_keys); warn "got relation $raw_rel\n"; my $pk_tbl = $raw_rel->[2]; my $pk_col = lc $raw_rel->[3]; my $fk_col = lc $raw_rel->[7]; my $relid = ($raw_rel->[11] || ( "__dcsld__" . $i++ )); $rels{$relid}->{tbl} = $pk_tbl; $rels{$relid}->{cols}->{$pk_col} = $fk_col; push(@{$self->{foreign_tables}{$pk_tbl}}, {field => $pk_col, table => $esc_table, class => $Class }); $Class->add_operation( { name=>'Key', type=>'Foreign', Params=>[ { Name => $pk_col }], visibility=>0, } ); } $sth->finish; } for my $field (@{$self->{tables}{$table}{fields}}) { my $sth = $dbh->column_info( $schema || undef, $dbname, $esc_table, $field ); my $field_info = $sth->fetchrow_hashref; $Class->add_attribute({ name => $field, visibility => 0, type => $field_info->{TYPE_NAME}, }); if ($guess_foreign_keys) { if (my $dep = $self->_guess_foreign_key($table, $field)) { # fix - need to handle multiple relations per table push(@{$self->{foreign_tables}{$dep}}, {field => $field, table => $esc_table, class => $Class }); $Class->add_operation( { name=>'Key', type=>'Foreign', Params=>[ { Name => $field, Type => $field_info->{TYPE_NAME}, }], visibility=>0, } ); } } } } # fix - need to handle multiple relations per table foreach my $fk_table (keys %{$self->{foreign_tables}} ) { foreach my $relation ( @{$self->{foreign_tables}{$fk_table}}) { $self->_add_foreign_keytable($relation->{table}, $relation->{field}, $relation->{class}, $fk_table); } } $dbh->disconnect; } sub _add_foreign_keytable { my ($self,$table,$field,$Class,$dep) = @_; my $Superclass = Autodia::Diagram::Superclass->new($dep); my $exists_already = $self->{Diagram}->add_superclass($Superclass); $Superclass = $exists_already if (ref $exists_already); # create new relationship my $Relationship = Autodia::Diagram::Relation->new($Class, $Superclass); # add Relationship to superclass $Superclass->add_relation($Relationship); # add Relationship to class $Class->add_relation($Relationship); # add Relationship to diagram $self->{Diagram}->add_relation($Relationship); return; } sub _guess_foreign_key { my ($self, $table, $field) = @_; my $is_fk = undef; $field =~ s/'"`//g; if ($field =~ m/^(.*)_u?id$/i) { my $foreign_table = $1; unless ($foreign_table eq $table) { $is_fk = $foreign_table if ($self->{tables}{$foreign_table}); } } elsif (($field ne $table ) && ($self->{tables}{$field})) { $is_fk = $field; } return $is_fk; } sub _discard_line { warn "not implemented\n"; return 0; } 1; ############################################################################### =head1 NAME Autodia::Handler::DBI.pm - AutoDia handler for DBI connections =head1 INTRODUCTION This module parses the contents of a database through a dbi connection and builds a diagram %language_handlers = { .. , dbi => "Autodia::Handler::DBI", .. }; =head1 CONSTRUCTION METHOD use Autodia::Handler::DBI; my $handler = Autodia::Handler::DBI->New(\%Config); This creates a new handler using the Configuration hash to provide rules selected at the command line. =head1 ACCESS METHODS $handler->Parse($connection); # where connection includes full or dbi connection string $handler->output(); # any arguments are ignored. =cut Autodia-2.14/lib/Autodia/Handler/dia.pm0000644000076400007640000001613111146246576017204 0ustar teejayteejaypackage Autodia::Handler::dia; require Exporter; use strict; =head1 NAME Autodia::Handler::dia - AutoDia handler for dia =head1 DESCRIPTION This provides Autodia with the ability to read dia files, allowing you to convert them via the Diagram Export methods to images (using GraphViz and VCG) or html/xml using custom templates. The dia handler will parse dia xml files using XML::Simple and populating the diagram object with class, superclass and package objects. the dia handler is registered in the Autodia.pm module, which contains a hash of language names and the name of their respective language - in this case: =head1 SYNOPSIS use Autodia::Handler::dia; my $handler = Autodia::Handler::dia->New(\%Config); $handler->Parse(filename); # where filename includes full or relative path. =head2 CONSTRUCTION METHOD my $handler = Autodia::Handler::dia->New(\%Config); This creates a new handler using the Configuration hash to provide rules selected at the command line. =head2 ACCESS METHODS $handler->Parse(filename); # where filename includes full or relative path. This parses the named file and returns 1 if successful or 0 if the file could not be opened. =cut use vars qw($VERSION @ISA @EXPORT); use Autodia::Handler; @ISA = qw(Autodia::Handler Exporter); use Autodia::Diagram; use Data::Dumper; use XML::Simple; #--------------------------------------------------------------- ##################### # Constructor Methods # new inherited from Autodia::Handler #------------------------------------------------------------------------ # Access Methods # parse_file inherited from Autodia::Handler #----------------------------------------------------------------------------- # Internal Methods # _initialise inherited from Autodia::Handler sub _parse { my $self = shift; my $fh = shift; my $filename = shift; my $Diagram = $self->{Diagram}; my $xml = XMLin(join('',<$fh>)); my %entity; my @relationships; # Walk the data structure based on the XML created by XML Simple foreach my $dia_object_id ( keys %{$xml->{'dia:layer'}->{'dia:object'}} ) { my $object = $xml->{'dia:layer'}{'dia:object'}{$dia_object_id}; my $type = $object->{type}; if (is_entity($type)) { warn "handling entity type : $type\n"; my $name = $object->{'dia:attribute'}{name}{'dia:string'}; $name =~ s/#(.*)#/$1/; if ($type eq 'UML - Class') { my $Class = Autodia::Diagram::Class->new($name); $Diagram->add_class($Class); $entity{$dia_object_id} = $Class; foreach my $method ( @{get_methods($object->{'dia:attribute'}{operations}{'dia:composite'})} ) { $Class->add_operation($method); } foreach my $attribute (@{get_attributes($object->{'dia:attribute'}{attributes}{'dia:composite'})}){ $Class->add_attribute( $attribute ); } } else { my $Component = Autodia::Diagram::Component->new($name); $Diagram->add_component($Component); $entity{$dia_object_id} = $Component; } } else { my $connection = $object->{'dia:connections'}{'dia:connection'}; warn "handling connection type : $type\n"; push (@relationships , { from=>$connection->[0]{to}, to=> $connection->[1]{to}, type=> $type, }); } } foreach my $connection ( @relationships ) { if ($connection->{type} eq 'UML - Generalization') { my $Inheritance = Autodia::Diagram::Inheritance->new( $entity{$connection->{from}}, $entity{$connection->{to}}, ); $entity{$connection->{from}}->add_inheritance($Inheritance); $entity{$connection->{to}}->add_inheritance($Inheritance); $Diagram->add_inheritance($Inheritance); } else { # create new dependancy my $Dependancy = Autodia::Diagram::Dependancy->new( $entity{$connection->{from}}, $entity{$connection->{to}}, ); # add dependancy to diagram $Diagram->add_dependancy($Dependancy); # add dependancy to class $entity{$connection->{from}}->add_dependancy($Dependancy); # add dependancy to component $entity{$connection->{to}}->add_dependancy($Dependancy); } } } ####----- sub is_entity { my $object_type = shift; my $IsEntity = 0; $IsEntity = 1 if ($object_type =~ /(class|package)/i); return $IsEntity; } sub get_methods { my $methods = shift; my $return = []; my $ref = ref $methods; if ($ref eq 'ARRAY' ) { foreach my $method (@$methods) { my $name = $method->{'dia:attribute'}{name}{'dia:string'}; my $type = $method->{'dia:attribute'}{type}{'dia:string'}; $name =~ s/#(.*)#/$1/g; $type = 'void' if (ref $type); $type =~ s/#//g; my $arguments = get_parameters($method->{'dia:attribute'}{parameters}{'dia:composite'}); push(@$return,{name=>$name,type=>$type,Params=>$arguments, visibility=>0}); } } elsif ($ref eq "HASH") { my $name = $methods->{'dia:attribute'}{name}{'dia:string'}; my $type = $methods->{'dia:attribute'}{type}{'dia:string'}; $name =~ s/#(.*)#/$1/g; $type = 'void' if (ref $type); $type =~ s/#//g; my $arguments = get_parameters($methods->{'dia:attribute'}{parameters}{'dia:composite'}); push(@$return,{name=>$name,type=>$type,Params=>$arguments, visibility=>0}); } return $return; } sub get_parameters { my $arguments = shift; my $return = []; if (ref $arguments) { if (ref $arguments eq 'ARRAY') { my @arguments = map ( { Type=> $_->{'dia:attribute'}{type}{'dia:string'}, Name=> $_->{'dia:attribute'}{name}{'dia:string'}, }, @$arguments ); foreach my $argument (@arguments) { $argument->{Type} =~ s/#//g; $argument->{Name} =~ s/#//g; } $return = \@arguments; } else { my $argument = { Type=>$arguments->{'dia:attribute'}{type}{'dia:string'}, Name=>$arguments->{'dia:attribute'}{name}{'dia:string'}, }; $argument->{Type} =~ s/#//g; $argument->{Name} =~ s/#//g; push(@$return,$argument); } } return $return; } sub get_attributes { my $attributes = shift; my $ref = ref $attributes; my $return = []; if ($ref eq 'ARRAY') { foreach my $attribute (@$attributes) { my $name = $attribute->{'dia:attribute'}{name}{'dia:string'}; my $type = $attribute->{'dia:attribute'}{type}{'dia:string'}; $name =~ s/#//g; $type =~ s/#//g; push (@$return, {name => $name, type=> $type, visibility=>0}); } } elsif ($ref eq 'HASH') { my $name = $attributes->{'dia:attribute'}{name}{'dia:string'}; my $type = $attributes->{'dia:attribute'}{type}{'dia:string'}; $name =~ s/#//g; $type =~ s/#//g; push (@$return, {name => $name, type=> $type, visibility=>0}); } return $return; } ############################################################################### =head1 SEE ALSO Autodia::Handler Autodia::Diagram =head1 AUTHOR Aaron Trevena, Eaaron.trevena@gmail.comE =head1 COPYRIGHT AND LICENSE Copyright (C) 2001-2007 by Aaron Trevena This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.1 or, at your option, any later version of Perl 5 you may have available. =cut 1; Autodia-2.14/lib/Autodia/Handler/DBI_SQLT.pm0000644000076400007640000001305611246765246017714 0ustar teejayteejay################################################################ # AutoDIA - Automatic Dia XML. (C)Copyright 2001 A Trevena # # # # AutoDIA comes with ABSOLUTELY NO WARRANTY; see COPYING file # # This is free software, and you are welcome to redistribute # # it under certain conditions; see COPYING file for details # ################################################################ package Autodia::Handler::DBI_SQLT; require Exporter; use strict; use warnings; use warnings::register; use vars qw($VERSION @ISA @EXPORT); use Autodia::Handler; @ISA = qw(Autodia::Handler Exporter); use Autodia::Diagram; use Data::Dumper; use DBI; use SQL::Translator; use SQL::Translator::Schema::Constants; #--------------------------------------------------------------- ##################### # Constructor Methods # new inherited from Autodia::Handler #------------------------------------------------------------------------ # Access Methods # parse_file inherited from Autodia::Handler #----------------------------------------------------------------------------- # Internal Methods # _initialise inherited from Autodia::Handler sub _parse_file { # parses dbi-connection string my $self = shift(); my $filename = shift(); my %config = %{$self->{Config}}; $self->{Diagram}->directed(0); # new dbi connection my $dbh = DBI->connect("DBI:$filename", $config{username}, $config{password}, { RaiseError => 1, FetchHashKeyName => 'NAME_lc', } ); warn "got dbh : $dbh\n"; my $translator = SQL::Translator->new( parser => 'DBI', dbh => $dbh, parser_args => { dsn => "dbi:$filename", db_user => $config{username}, db_password => $config{password}, } ); my $parser = $translator->parser; my $parser_type = $translator->parser_type; my $data; my $parser_output; eval { $parser_output = $parser->($translator, $$data) }; if ($@ || ! $parser_output) { my $msg = sprintf "translate: Error with parser '%s': %s", $parser_type, ($@) ? $@ : " no results"; die $translator->error($msg); } warn "parser : $parser, parser_type : $parser_type, parser_output : $parser_output\n"; my $schema = $translator->schema; warn "got schema : $schema\n"; # got to about here applying dbi datatypes patch foreach my $table ($schema->get_tables) { warn "got table : $table name\n"; my $table_name = $table->name; # create new 'class' representing table my $Class = Autodia::Diagram::Class->new($table); # add 'class' to diagram $self->{Diagram}->add_class($Class); # get primary key fields. my %pkey_fields = map { $_ => 1 } $schema->pkey_fields; # get foreign key fields. my %fkey_fields = map { $_ => 1 } $schema->fkey_fields; for my $field ($table->get_fields) { my $field_name = $field->name; $Class->add_attribute({ name => $field_name, visibility => 0, type => $field->data_type, }); if ($fkey_fields{$field_name}) { $Class->add_operation( { name=>'Key', type=>'Foreign', Params=>[ { Name => $field_name, Type => $field->data_type, }], visibility=>0, } ); } if ($pkey_fields{$field_name}) { $Class->add_operation( { name=>'Key', type=>'Primary', Params=>[ { Name => $field_name, Type => $field->data_type, }], visibility=>0, } ); } } for my $c ( $table->get_constraints ) { next unless $c->type eq FOREIGN_KEY; my $fk_table = $c->reference_table or next; next unless defined $schema->get_table( $fk_table ); for my $fk_field ( $c->reference_fields ) { $self->{foreign_tables}{$fk_table} = { table => $table, field => $fk_field, class => $Class, }; } } } # fix - need to handle multiple relations per table foreach my $fk_table (keys %{$self->{foreign_tables}} ) { foreach my $relation ( @{$self->{foreign_tables}{$fk_table}}) { $self->_add_foreign_keytable($relation->{table}, $relation->{field}, $relation->{class}, $fk_table); } } $dbh->disconnect; return 1; } sub _add_foreign_keytable { my ($self,$table,$field,$Class,$dep) = @_; my $Superclass = Autodia::Diagram::Superclass->new($dep); my $exists_already = $self->{Diagram}->add_superclass($Superclass); $Superclass = $exists_already if (ref $exists_already); # create new relationship my $Relationship = Autodia::Diagram::Relation->new($Class, $Superclass); # add Relationship to superclass $Superclass->add_relation($Relationship); # add Relationship to class $Class->add_relation($Relationship); # add Relationship to diagram $self->{Diagram}->add_relation($Relationship); return; } sub _discard_line { warn "not implemented\n"; return 0; } 1; ############################################################################### =head1 NAME Autodia::Handler::DBI.pm - AutoDia handler for DBI connections =head1 INTRODUCTION This module parses the contents of a database through a dbi connection and builds a diagram %language_handlers = { .. , dbi => "Autodia::Handler::DBI", .. }; =head1 CONSTRUCTION METHOD use Autodia::Handler::DBI; my $handler = Autodia::Handler::DBI->New(\%Config); This creates a new handler using the Configuration hash to provide rules selected at the command line. =head1 ACCESS METHODS $handler->Parse($connection); # where connection includes full or dbi connection string $handler->output(); # any arguments are ignored. =cut Autodia-2.14/lib/Autodia/Handler/CSharp.pm0000644000076400007640000005520211337331235017616 0ustar teejayteejaypackage Autodia::Handler::CSharp; require Exporter; use strict; use vars qw($VERSION @ISA @EXPORT $DEBUG $FILENAME $LINENO); use Autodia::Handler; @ISA = qw(Autodia::Handler Exporter); use Autodia::Diagram; our $PARAM_REGEX = qr/[\[\]<>\w\,\.\s\*=\"\']*/; our $METHOD_TYPES = qr/static|virtual|override|const|event/; our $PRIVACY = qr/public|private|protected/; our $CLASS = qr/class|interface/; our $TYPE = qr/[\w,<>]+/; #--------------------------------------------------------------- ##################### # Constructor Methods # new inherited from Autodia::Handler #------------------------------------------------------------------------ # Access Methods # parse_file inherited from Autodia::Handler #----------------------------------------------------------------------------- # Internal Methods # _initialise inherited from Autodia::Handler sub debug { print "$FILENAME:$LINENO - @_\n"; } sub _parse { my $self = shift; my $fh = shift; my $filename = shift; $FILENAME = $filename; $FILENAME =~ s{.*/}{}; $LINENO = 0; my $Diagram = $self->{Diagram}; my $Class; $self->{current_package} = $filename; $self->{namespace} = ""; $self->{privacy} = 0; $self->{comment} = 0; $self->{in_class} = 0; $self->{in_declaration} = 0; $self->{in_method} = 0; $self->{brace_depth} = 0; debug("processing file"); # parse through file looking for stuff while (<$fh>) { LINE: { $LINENO++; chomp( my $line = $_ ); last LINE if ( $self->_discard_line($line) ); # This strips out all the template spaces, which makes it easier to parse while($line =~ s/(<[^>]*)\s+([^>]*>)/$1$2/g) { debug("Stripping templates: $line"); next; } # we've entered a top level namespace if ( $line =~ m/^\s*namespace\s+([\w\.]+)/ ) { $self->{namespace} = $1; debug("Namespace: $1"); last LINE; } # check for class declaration if ( $line =~ m/^\s*($PRIVACY)?\s*($CLASS)\s+(\w+)/ ) { my $classname = ($3) ? $3 : $2; $self->{in_class} = 1; $self->{privacy} = "private"; $self->{visibility} = 1; $classname =~ s/[\{\}]//g; last if ($self->skip($classname)); # we want to add on namespace #if ($self->{namespace}) { # $classname = "$self->{namespace}.$classname"; #} debug("Class: $classname"); $Class = Autodia::Diagram::Class->new($classname); my $exists = $Diagram->add_class($Class); $Class = $exists if ($exists); # handle superclass(es) if ( $line =~ m/^\s*($PRIVACY)?\s*($CLASS)\s+\w+\s*\:\s*(.+)\s*/ ) { my @superclasses = split( /\s*,\s*/, $3 ); foreach my $super (@superclasses) { $super =~ s/^\s*(\w+\s+)?([A-Za-z0-9\_]+)\s*$/$2/; debug("Super Class: $super"); my $Superclass = Autodia::Diagram::Superclass->new($super); my $exists_already = $Diagram->add_superclass($Superclass); if ( ref $exists_already ) { $Superclass = $exists_already; } my $Inheritance = Autodia::Diagram::Inheritance->new( $Class, $Superclass ); $Superclass->add_inheritance($Inheritance); $Class->add_inheritance($Inheritance); $Diagram->add_inheritance($Inheritance); } } last LINE; } # check for end of class declaration # TODO: this won't ever trigger with C#, not sure the best way to close things here. if ( $self->{in_class} && ( $line =~ m|^\s*\}\;| ) ) { # print "found end of class\n"; $self->{in_class} = 0; $self->{privacy} = 0; last LINE; } # because the rest of this requires that we are in a class last LINE if ( not $self->{in_class} ); if ( $line =~ m/^\s*protected\s*/ ) { debug("protected variables/classes"); $self->{privacy} = "protected"; $self->{visibility} = 2; $self->_parse_private_things( $line, $Class ); last LINE; } elsif ( $line =~ m/^\s*private\s*\w*/ ) { debug("private variables/classes"); $self->{privacy} = "private"; $self->{visibility} = 1; # check for attributes and methods $self->_parse_private_things( $line, $Class ); last LINE; } elsif ( $line =~ m/^\s*public\s*\w*/ ) { debug("public variables/classes"); # print "found public variables/classes\n"; $self->{privacy} = "public"; $self->{visibility} = 0; $self->_parse_private_things( $line, $Class ); last LINE; } # if inside a class method then discard line if ( $self->{in_method} ) { # count number of braces and increment decrement depth accordingly # if depth = 0 then reset in_method and next; # else next; my $start_brace_cnt = $line =~ tr/{/{/; my $end_brace_cnt = $line =~ tr/}/}/; $self->{brace_depth} = $self->{brace_depth} + $start_brace_cnt - $end_brace_cnt; $self->{in_method} = $self->{brace_depth} == 0 ? 0 : 1; # print "In method: ",$start_brace_cnt, $end_brace_cnt, $self->{brace_depth}, $self->{in_method} ,"\n"; last LINE; } # check for simple declarations # space* const? space+ (namespace::)* type space* modifier? space+ name; # if ($line =~ m/^\s*\w*?\s*((\w+\s*::\s*)*\w+\s*[\*&]?)\s*(\w+)\s*\;.*$/) # Added support for pointers/refs/namespaces # { # my $name = $3; # my $type = $1; # # print "found simple variable declaration : name = $name, type = $type\n"; # #my $visibility = ( $name =~ m/^\_/ ) ? 1 : 0; # $Class->add_attribute({ # name => $name, # visibility => $self->{visibility}, #was: $visibility, # type => $type, # }); # last LINE; # } # # check for simple sub # if ($line =~ m/^ # start of line # \s* # whitespace # (\w*?\s*?(\w+\s*::\s*)*\w*?\s*[\*&]?) # type of the method: $1. Added support for namespaces # \s* # whitespace # (\w+) # name of the method: $2 # \s* # whitespace # \(\s* # start of parameter list # ([:\w\,\s\*=&,<>\"]*) # all parameters: $3 # (\)?) # may be an ending bracket: $4 # [\w\s=]*(;?) # possibly end of signature $5 # .*$/x # ) { # my $name = $3; # my $type = $1 || "void"; # my $params = $4; # my $end_bracket = $5; # my $end_semicolon = $6; # debug("simple sub: $name"); # my $have_continuation = 0; # my $have_end_semicolon= 0; # if ($name eq $Class->{"name"}) { # # print "found constructor declaration : name = $name\n"; # $type = ""; # } else { # # print "found simple function declaration : name = $name, type = $type\n"; # } # $have_continuation = 1 unless $end_bracket eq ")"; # $have_end_semicolon = 1 if $end_semicolon eq ";"; # # print $have_continuation ? "no ":"with " ,"end bracket : $end_bracket\n"; # # print $have_end_semicolon ? "with ":"no " ,"end semicolon : $end_semicolon\n"; # $params =~ s|\s+$||; # my @params = split(",",$params); # my $pc = 0; # parameter count # my %subroutine = ( # name => $name, # type => $type, # visibility => $self->{visibility}, # ); # # If we have continuation lines for the parameters get them all # while ($have_continuation) { # my $line = <$fh>; # last unless ($line); # chomp $line; # if ($line =~ m/^ # start of line # \s* # whitespace # ([:\w\,\|\s\*=&\"]*) # all parameters: $1 # (\)?) # may be an ending bracket: $2 # [\w\s=]*(;?) # possibly end of signature $3 # .*$/x) { # my $cparams = $1; # $end_bracket = $2; # $end_semicolon = $3; # $cparams =~ s|\s+$||; # my @cparams = split(",",$cparams); # push @params, @cparams; # # print "More parameters: >$cparams<\n"; # $have_continuation = 0 if ($end_bracket eq ")"); # $have_end_semicolon = 1 if ($end_semicolon eq ";"); # # print $have_continuation ? "no ":"with " ,"end bracket : $end_bracket\n"; # # print $have_end_semicolon ? "with ":"no " ,"end semicolon : $end_semicolon\n"; # } # } # # then get parameters and types # my @parameters = (); # # print "All parameters: ",join(';',@params),"\n"; # foreach my $parameter (@params) { # $parameter =~ s/const\s+//; # $parameter =~ m/\s*((\w+::)*\w+\s*[\*|\&]?)\s*(\w+)/ ; # my ($type, $name) = ($1,$3); # $type =~ s/\s//g; # $name =~ s/\s//g; # $parameters[$pc] = { # Name => $name, # Type => $type, # }; # $pc++; # } # $subroutine{"Params"} = \@parameters; # $Class->add_operation(\%subroutine); # # Now finished with parameters. If there was no end # # semicolon we have an inline method: we read on until we # # see the start of the method. This deals with (multi-line) # # constructor initialization lists as well. # last LINE if $have_end_semicolon; # while (defined $line and $line !~ /{/) { # $line = <$fh>; # print "$filename: waiting for start of method def: $line\n"; # } # my $start_brace_cnt = $line =~ tr/{/{/ ; # my $end_brace_cnt = $line =~ tr/}/}/ ; # $self->{brace_depth} = $start_brace_cnt - $end_brace_cnt; # $self->{in_method} = 1 unless $self->{brace_depth} == 0; # # print "Start: ",$start_brace_cnt, $end_brace_cnt, $self->{brace_depth}, $self->{in_method} ,"\n"; # last LINE; # } # if line starts with word,space,word then its a declaration (probably) # Broken. # if ($line =~ m/\s*\w+\s+(\w+\s*::\s*)*\w+/i) { # # print " probably found a declaration : $line\n"; # my @words = m/^(\w+)\s*[\(\,\;].*$/g; # my $name = $&; # my $rest = $'; #' to placate some syntax highlighters # my $type = ''; # my $pc = 0; # point count (ie location in array) # foreach my $start_point (@-) { # my $start = $start_point; # my $end = $+[$pc]; # $type .= substr($line, $start, ($end - $start)); # $pc++; # } # # if next character is a ( then the line is a function declaration # if ($rest =~ m|^\((\w+)\(.*(\;?)\s*$|) { # # print "probably found a function : $line \n"; # my $params = $1; # my @params = split(",",$params); # my $declaration = 0; # if (defined $2) # if line ends with ";" then its a declaration # { # $declaration = 1; # my @parameters = (); # my $pc = 0; # parameter count # my %subroutine = ( # name => $name, # type => $type, # visibility => $self->visibility, # ); # # then get parameters and types # foreach my $parameter (@params) { # my ($type, $name) = split(" ",$parameter); # $type =~ s/\s//g; # $name =~ s/\s//g; # $parameters[$pc] = { # name => $name, # type => $type, # }; # $pc++; # } # $subroutine{param} = \@parameters; # $Class->add_operation(\%subroutine); # } else { # my @attributes = (); # # else next character is , or ; # # the line's a variable declaration # $Class->add_attribute ({ # name => $name, # type => $type, # visibility => $self->{visibility}, # }); # my %attribute = { name => $name , type => $type }; # $attributes[0] = \%attribute; # if ($rest =~ m/^\,.*\;/) { # my @atts = split (","); # foreach my $attribute (@atts) { # my @attribute_parts = split(" ", $attribute); # my $n = scalar @attribute_parts; # my $name = $attribute_parts[$n]; # my $type = join(" ",$attribute_parts[0...$n-1]); # $Class->add_attribute ( { # name => $name, # type => $type, # visibility => $self->{visibility}, # }); # # # } # # # } # # # } # # # } # # # } # } } $self->{Diagram} = $Diagram; close $fh; return; } sub _discard_line { my $self = shift; my $line = shift; my $discard = 0; SWITCH: { if ( $line =~ m/^\s*$/ ) { # if line is blank or white space discard $discard = 1; last SWITCH; } if ( $line =~ /^\s*\/\// ) { # if line is a comment discard $discard = 1; last SWITCH; } # if line is a comment discard if ( $line =~ m!^\s*/\*.*\*/! ) { $discard = 1; last SWITCH; } # if line starts with multiline comment syntax discard and set flag if ( $line =~ /^\s*\/\*/ ) { $self->{comment} = 1; $discard = 1; last SWITCH; } if ( $line =~ /^.*\*\/\s*$/ ) { $self->{comment} = 0; } if ( $self->{comment} == 1 ) { # if currently inside a multiline comment # if line starts with comment end syntax then unflag and discard if ( $line =~ /^.*\*\/\s*$/ ) { $self->{comment} = 0; $discard = 1; last SWITCH; } $discard = 1; last SWITCH; } } return $discard; } ####----- sub _parse_private_things { my $self = shift; my $line = shift; my $Class = shift; return unless ( $line =~ m/^\s*($PRIVACY)\s*(\w.*)$/ ); my @private_things = split( ";", $2 ); foreach my $thing (@private_things) { # print "- private/public thing : $private_thing\n"; # FIXME : Next line type definition seems erroneous. Any C++ hackers care to check it? # strip off comments $thing =~ s{//.*}{}; debug("private thing = $thing"); if ( $thing =~ m/^\s*($METHOD_TYPES)?\s*($TYPE)\s+(\w+\(?$PARAM_REGEX*\)?)\s*\w*\s*\w*.*$/ ) { my $name = $3; my $type = ($1) ? "$1 $2" : "$2"; my $vis = $self->{visibility}; # print "- found declaration : name = $name, type = $type\n"; debug("private - name = $name, type = $type"); if ( $name =~ /\(/ ) { debug("declaration is a method"); # print "-- declaration is a method \n"; # check for simple sub if ( $name =~ /^\s*(\w+)\s*\(\s*($PARAM_REGEX*)(\)?)/ ) { $name = $1; my $params = $2; my $end_bracket = $3; my $have_continuation = 0; my $have_end_semicolon = 1; $params =~ s|\s+$||; my @params = split( ",", $params ); my $pc = 0; # parameter count my %subroutine = ( name => $name, type => $type, visibility => $self->{visibility}, ); # then get parameters and types my @parameters = (); debug( "All parameters: ", join( ';', @params ) ); foreach my $parameter (@params) { $parameter =~ s/const\s+//; my ( $type, $name ) = split( " ", $parameter ); $type =~ s/\s//g; $name =~ s/\s//g; $parameters[$pc] = { name => $name, type => $type, }; $pc++; } $subroutine{param} = \@parameters; $Class->add_operation( \%subroutine ); } } else { debug("attribute: $name - $type"); # print "-- declaration is an attribute \n"; $Class->add_attribute( { name => $name, visibility => $vis, type => $type, } ); } } } } sub _is_package { my $self = shift; my $package = shift; my $Diagram = $self->{Diagram}; unless ( ref $$package ) { my $filename = shift; # create new class with name $$package = Autodia::Diagram::Class->new($filename); # add class to diagram $Diagram->add_class($$package); } return; } ############################################################################### =head1 NAME Autodia::Handler::CSharp - AutoDia handler for C# =head1 INTRODUCTION This module parses files into a Diagram Object, which all handlers use. The role of the handler is to parse through the file extracting information such as Class names, attributes, methods and properties. =head1 CONSTRUCTION METHOD use Autodia::Handler::CSharp; my $handler = Autodia::Handler::CSharp->New(\%Config); This creates a new handler using the Configuration hash to provide rules selected at the command line. =head1 ACCESS METHODS This parses the named file and returns 1 if successful or 0 if the file could not be opened. $handler->output_xml(); # interpolates values into an xml or html template $handler->output_graphviz(); # generates a gif file via graphviz =head1 AUTHOR Sean Dague =head1 MAINTAINER Aaron Trevena =head1 COPYRIGHT Copyright 2007 Sean Dague Copyright 2001 - 2006 Aaron Trevena =cut 1; Autodia-2.14/t/0000755000076400007640000000000011567257122012635 5ustar teejayteejayAutodia-2.14/t/autodia.t0000644000076400007640000000175011567251327014454 0ustar teejayteejay# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### use Test::More; warn "checking Autodia.pm\n"; use_ok('Autodia'); warn "checking classes\n"; use Autodia::Diagram; use Autodia::Diagram::Class; use Autodia::Diagram::Object; use Autodia::Diagram::Dependancy; use Autodia::Diagram::Inheritance; use Autodia::Diagram::Superclass; use Autodia::Diagram::Component; use Autodia::Handler; warn "checking handlers..\n"; foreach ( qw/SQL Cpp Perl PHP DBI dia Torque python umbrello/ ) { eval " require_ok('Autodia::Handler::$_') ; "; warn "couldn't compile Autodia::Handler::$_ : $@ : ignoring..\n" if $@; } if (eval "require HTML::Mason;" ) { eval " require_ok('Autodia::Handler::Mason') ; "; warn "couldn't compile Autodia::Handler::Mason : $@ : ignoring..\n" if $@; } else { note('skipping Autodia::Handler::Mason - HTML::Mason not installed') } done_testing(); Autodia-2.14/t/pod.t0000444000076400007640000000020111001402615013551 0ustar teejayteejayuse Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); Autodia-2.14/TODO0000644000076400007640000000154611001402615013046 0ustar teejayteejayTo Do ----- This file contains the things that I plan to do in the near future Redesign Diagram class to be a template class and move much of its logic into UMLDiagram class, this would allow AutoDia to handle different types of diagram. Write some new handlers for perl, PHP and Python using semantic parsing and grammars rather than hacked home rolled parsers. Add more error checking to ensure the application copes better with less sane code. Correctly layout components and relationships using a more complex layout system. Add an XML based configuration or policy system allowing you to predefine settings and even specify handlers and pattern matching without having to get your hands dirty in the code. Add ability to split projects into multiple diagrams and group contents of a diagram/subdir into system boxes - much improving clarity in big projects. Autodia-2.14/autodia.pl0000755000076400007640000003271311566443250014364 0ustar teejayteejay#!/usr/bin/perl -w ############################################################### # AutoDIA - Automatic Dia XML. (C)Copyright 2001 A Trevena # # # # AutoDIA comes with ABSOLUTELY NO WARRANTY; see COPYING file # # This is free software, and you are welcome to redistribute # # it under certain conditions; see COPYING file for details # ############################################################### use strict; use Getopt::Std; use Data::Dumper; use File::Find; use Autodia; my $handler; my $language_handlers = Autodia->getHandlers(); my %language_handlers = %$language_handlers; # get configuration from command line my %args=(); getopts("KkFCs:SDOmMaArhHi:o:p:d:t:l:zZvVU:P:G:",\%args); my %config = %{get_config(\@ARGV,\%args)}; print "\n\nAutoDia - version ".$Autodia::VERSION."(c) Copyright 2003 A Trevena\n\n" unless ( $config{silent} ); # create new diagram print "using language : ", $config{language}, "\n" unless ( $config{silent} ); if (defined $language_handlers{lc($config{language})}) { my $handler_module = $language_handlers{lc($config{language})}; eval "require $handler_module" or die "can't run $handler_module : $! : $@\n"; print "\n..using $handler_module\n" unless ( $config{silent} ); $handler = "$handler_module"->new(\%config); } else { print "language " , $config{language} , "not supported!"; print " supported languages are : \n"; foreach my $language (keys %language_handlers) { print "\t$language\n"; } die "..quiting\n"; } $handler->process(); $handler->output() unless ($config{singlefile}); print "complete. (processed ", scalar(@{$config{filenames}}), " files)\n\n" unless ( $config{silent} ); #################################################################### sub get_config { my @ARGV = @{shift()}; my %args = %{shift()}; if (defined $args{'V'}) { print "\n\nAutoDia - version ".$Autodia::VERSION."(c) copyright 2003 A Trevena\n\n"; exit; } $args{'i'} =~ s/\"// if defined $args{'i'}; $args{'d'} =~ s/\"// if defined $args{'d'}; $args{'l'} ||= 'perl'; if ($args{'h'}) { print_instructions(); exit; } my %config = ( args => \%args); my @filenames = (); $config{skip_superclasses} = (defined $args{'k'}) ? 1 : 0; $config{skip_packages} = (defined $args{'K'}) ? 1 : 0; $config{graphviz} = (defined $args{'z'}) ? 1 : 0; $config{language} = $args{'l'}; $config{silent} = (defined $args{'S'}) ? 1 : 0; $config{springgraph} = (defined $args{'Z'}) ? 1 : 0; $config{vcg} = (defined $args{'v'}) ? 1 : 0; $config{singlefile} = (defined $args{'F'}) ? 1 : 0; $config{skipcvs} = (defined $args{'C'}) ? 1 : 0; $config{username} = (defined $args{'U'}) ? $args{'U'} : "root"; $config{password} = (defined $args{'P'}) ? $args{'P'} : ""; $config{mason_globals} = (defined $args{'G'}) ? $args{'G'} : ""; $config{name} = (defined $args{n}) ? 1 : 0; $config{methods} = 1; $config{attributes} = 1; $config{public} = (defined $args{'H'}) ? 1 : 0; if ( $args{'m'} || $args{'A'}) { $config{attributes} = 0; } if ( $args{'M'} || $args{'a'}) { $config{methods} = 0; } Autodia->setConfig(\%config); my %file_extensions = %{Autodia->getPattern()}; if ($args{'s'}) { $config{skipfile} = $args{'s'}; warn "using skipfile : $config{skipfile}\n"; unless (-f $config{skipfile}) { die "couldn't use $config{skipfile} : $!\n"; } open(SKIPFILE, "<$config{skipfile}") or die "couldn't use $config{skipfile} : $!\n"; $config{skip_patterns} = [ map (eval { s/[\s\n]+//g; $_ }, ) ]; close SKIPFILE; warn Dumper $config{skip_patterns}; } my $inputpath = ""; if (defined $args{'p'}) { $inputpath = $args{'p'}; unless ($inputpath =~ m/\/$/) { $inputpath .= "/"; } } if ($config{name}) { die "$config{language} does not support finding files by packagename" unless ($language_handlers{lc($config{language})}->can('find_files_by_packagename')); @filenames = find_files_by_packagename (\%config,\%args); } else { if (defined $args{'i'}) { my $last; if ($args{l} =~ /^dbi/i) { $filenames[0] = $args{'i'}; warn "have file : $filenames[0]\n"; } else { foreach my $filename ( split(" ",$args{'i'}) ) { unless ( -f $inputpath.$filename ) { if ($last) { $filename = "$last $filename"; unless (-f $inputpath.$filename) { warn "cannot find $filename .. ignoring\n"; $last = $filename; next; } } else { $last = $filename; warn "cannot find $filename .. ignoring\n"; next; } } undef $last; push(@filenames,$filename); } } } if (defined $args{'d'}) { print "using directory : " , $args{'d'}, "\n" unless ( $config{silent} ); my @dirs = split(" ",$args{'d'}); $config{'directory'} = \@dirs; if (defined $args{'r'}) { print "recursively searching files..\n" unless ( $config{silent} ); find ( { wanted => sub { unless (-d) { my $regex = $file_extensions{regex}; push @filenames, $File::Find::name if ($File::Find::name =~ m/$regex/); } }, preprocess => sub { my @return; foreach (@_) { my $skip = 0; $skip = 1 if (m/^.*\/?(CVS|RCS)$/ && $config{skipcvs}); $skip = 1 if (m/^.*\/?(blib)$/); push(@return,$_) unless ($skip); } return @return; }, }, @dirs ); } else { my @wildcards = @{$file_extensions{wildcards}}; print "searching files using wildcards : @wildcards \n" unless ( $config{silent} ); foreach my $directory (@dirs) { if ($directory =~ m/^(CVS|RCS)/ and $config{skipcvs}) { warn "skipping $directory\n" unless ( $config{silent} ); next; } print "searching $directory\n" unless ( $config{silent} ); $directory =~ s|(.*)\/$|$1|; foreach my $wildcard (@wildcards) { print "$wildcard" unless ( $config{silent} ); print " .. " , <$directory/*.$wildcard>, " \n"; push @filenames, <$directory/*.$wildcard>; } } } } } $config{inputpath} = $inputpath; unless (defined $args{'d'} || $args{'i'} || $args{'p'}) { if (@ARGV) { @filenames = @ARGV; } else { print_instructions(); exit; } } $config{filenames} = \@filenames; $config{use_stdout} = (defined $args{'O'}) ? 1 : 0; $config{templatefile} = (defined $args{'t'}) ? $args{'t'} : undef; $config{outputfile} = (defined $args{'o'}) ? $args{'o'} : "autodia.out.dia"; $config{no_deps} = (defined $args{'D'}) ? 1 : 0; $config{sort} = (defined $args{'s'}) ? 1 : 0; return \%config; } sub print_instructions { print "AutoDia - Automatic Dia XML. Copyright 2001 A Trevena\n\n"; print < =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =item c =item C =item C =item C =item C =item C =item C =item C =item C =item C =item C =back =cut ############################################################################## ############################################################################## Autodia-2.14/COPYING0000644000076400007640000004307611001402615013415 0ustar teejayteejay GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave, Cambridge, MA 02139, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19yy name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. Autodia-2.14/examples/0000755000076400007640000000000011567257122014210 5ustar teejayteejayAutodia-2.14/examples/skiplist0000644000076400007640000000002611001402615015751 0ustar teejayteejayDateTime.* File::stat Autodia-2.14/CREDITS0000644000076400007640000000260211541627472013413 0ustar teejayteejayCREDITS ------- Developers: Aaron Trevena ( Author and maintainer ) Contributors: Peter Franke Rolf Martin-Hoster Sean Dague Nicholas Clark Simon Wistow Lars Clausen Tony Payne Ekkehard Goerlard Felix Hallmann, Olivier Dugas Sylvain Chevillard Sven Passig, James Michael DuPont Rob McMullen Patrick Steininger, Patrick Goldbronn Pierre Maziere Leon Brocard, Rich Davis Johan Van den Brande Rhys Lewis Paul Sharpe Scott Lanning Chris Andrews Daping Wang Brian Koehmstedt Vagn Johansen Dmitry Perfilyev Jesus M. Castagnetto Rolandas Juodzbalis Jason Gilbreath Richard Clamp Christophe Klopp Tom Hoffman Chris Morrow Jonathan Riddell Paul Casto Perceval Anichini 'Darxus' Chris Karakas Denny De La Haye Duane Hinkley Benout Audouard Christophe Colombier Jess 'castaway' Robinson Patrick Michaud Patrick Wiggins David Bike Jurriën / Norm 2782 Renato Golin (www.systemcall.org) Dalton Mackie (Gnavicks) Elijah Insua (tmpvar) Testers and Bug Reporters: Mark Clements Szilard Novaki Michael Wojciechowski Alessandro Molina Richard Newman Petr Kubanek Sam Tregar John Millaway Timothy Aldrich cpan-testers Gregoire Thomas Hosting and Support: Alaric Snell Leo Lapworth Google Code Also thanks to: The authors of Perl, the core modules and the Template Toolkit The Dia, VCG and GraphViz teams for producing useful software. The nice people that make up London and Bath perl mongers Autodia-2.14/INSTALL0000644000076400007640000000223611001402615013404 0ustar teejayteejayINSTALL ------- Autodia is a perl application and requires that perl is installed on your system. It should work with native unix perl or activestate's perl on windows. Vanilla Install If you are running autodia against perl, c++ or PHP source code then you can install using the usual perl technique : % perl Makefile.PL % make % make test % su # make install when you run perl Makefile.PL you may see a warning that requisites Inline and Inline::Java are not installed. This is fine if you do not need use Autodia with java. the autodia program is called using 'autodia.pl' with arguments as required, if no arguments are passed then it will display instructions. for more detailed usage of autodia and developer documentation read the DEVELOP file and perldoc Autodia Java Install if You want to use autodia against java then you require some extra perl modules - Inline - Inline::Java You will also need to copy the file named autodia_java over the file name autodia so your installation would go : % perl -MCPAN -e 'install Inline' % perl -MCPAN -e 'install Inline::Java' % cp autodia_java.pl autodia.pl % perl Makefile.PL % make % make test % su # make install Autodia-2.14/META.yml0000664000076400007640000000106611567257122013650 0ustar teejayteejay--- #YAML:1.0 name: Autodia version: 2.14 abstract: ~ author: [] license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: Data::Dumper: 0 File::Find: 0 Getopt::Std: 0 Template: 1 XML::Simple: 0 no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.54 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Autodia-2.14/Makefile.PL0000644000076400007640000000103111032401773014325 0ustar teejayteejayuse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Autodia', 'VERSION_FROM' => 'lib/Autodia.pm', # finds $VERSION 'PREREQ_PM' => { Getopt::Std => 0, Data::Dumper => 0, File::Find => 0, Template => 1, # GraphViz => 0, # optional # SpringGraph => 0.02, # optional # VCG => 0.4, # optional XML::Simple => 0, }, 'EXE_FILES' => [ 'autodia.pl' ], ); Autodia-2.14/CHANGES0000644000076400007640000002633511567257062013401 0ustar teejayteejayChanges to AutoDia ------------------ version 2.14 25/05/2011 - fix test dependancy on HTML::Mason (again, properly this time) version 2.13 23/05/2011 - fix test dependancy on HTML::Mason version 2.12 23/05/2011 - improvements to pod template - filenames now replace non-word char with underscore, added params to subs - process method in Handler superclass now returns no of files processed - experimental (non working) SQL-Translator handler - fix to Python Handler - bug fix for PHP handler (reported by Elijah Insua) - new ASP Handler Dalton Mackie (Gnavicks) - fix to duplicate class definitions/mentions in many handlers - fix for lowerclass package names in perl - added Mason handler provided by Peter Franke version 2.10 25/08/2009 - fixed handling of DBIC components - fix to C++ handler from Renato Golin (www.systemcall.org) version 2.09 24/06/2009 - added template and backslash support to C++ handler (patch provided by Patrick Wiggins) - added support for Params::Validate in Perl Handler - added methods to allow get/set operations in class objects after adding them - added better support for PHP5 classes (patch provided by Jurrien / Norm ) - added Realization relation (patches provided by David Bike) - added support for Class::Accessor and Class::Data::Inheritable in Perl handler - added Moose support, fixed handling of subrefs in Perl Handler version 2.08 01/07/2008 - fixed skiplist - moved to handlers from diagram - added concentration option to graphviz digraphs - removed Java support version 2.07 20/05/2008 - default output now autodia.out.dia (workaround for bug in Dia 0.96) - added new Relation relationship - several fixes to DBI handler - added undirected option for GraphViz version 2.06 16/04/2008 - added support for DBIx::Class to perl handler - added basic perl test template - applied fix for undefined array when graphing layout version 2.05 1/11/2007 - set default output path for TT to . - added templates for mysql ddl and perl pod - added new object_from_id method to Diagram class - added support for simple Object::InsideOut syntax - fixed file naming for -F argument version 2.04 29/8/2007 - escapes nasty badness in perl attribute names found in code - replaces dynamic parts of method or attribute names in perl code with _xxxx - added pod.t and pod_coverage.t - fixed pod errors - fixed old email and website addresses - added csharp mode written by Sean Dague - added -s skiplist argument to ignore packages matching patterns version 2.03 27/04/2006 - basic Class::DBI support in perl handler - updated Umbrello - updated PHP to handle PHP 5 - perl parsing improvments - improvements to Diagram.pm in Dia / Umbrello to filter non-xml-safe stuff, and use Kind field in Dia version 2.02 09/05/2005 - no_deps is now deprecated : use -K instead - improvements to DBI handler - now guesses foreign keys a bit better - added support for datatypes - new option -k to skip superclasses - new option -K to skip dependancies - improvements and fixes to SQL Handler - now supports current (4.1.x) MySQL dumps - now supports SQL Server SQL Dumps (when stripped of non-ascii crap) - foreign key support improved - datatypes improved - umbrello output fixed - minor fix to C++ Handling in Dia and Umbrello - additional templates directory with MySQL DDL template version 2.01 13/10/2004 - improved perl handler support for 'fields' and 'base' pragma - applied Chris Karakas' fixes to Diagram module, PHP and Perl handlers version 2.00 14/07/2004 - added umbrello output (experimental - doesn't seem to work) - fixed Perl Handler to cope with perl scripts as well as modules [bug reported via debian] - small tweak to Perl Handler to stop it complaining about uninitiated values at line 375 - fixed python handler so inheritance works properly - fixed C++ handler to handle namespaces in types - fixed C++ handler to cope with inheriting from public foo or foo - fixed SQL handler to handle linebreaks in table declarations - fixed Umbrello Handler to cope with <= 1.1 and now >= 1.2.0 or style files - fix to Diagram module to ensure binary files are output in BINMODE for when on win32 - added SpringGraph output (very experimental, only works for basic diagrams, sometimes) - slight improvement to dia layout algorithm version 1.99 19/03/2004 - rebadged 1.12 to meet version number requirements on cpan version 1.12 17/03/2004 - fixes to SQL handler to support more types and match better - fixed autodia.pl to allow -i and -d at the same time - skipcvs option now also skips RCS dirs - fix to C++ handler to cope with comments like /* .. */ on single line - fixes to Torque handler - added umbrello input handler (experimental) - synchronised autodia_java.pl with autodia.pl version 1.11 23/12/2003 - added experimental support for Class::Tangram version 1.10 22/12/2003 - fixed object attributes bug in Perl Handler - fixed bug in Diagram class that caused crash version 1.9 10/12/2003 - added support for 'use public' and 'use private' in Perl Handler (experimental) - fixed bug in DBI handler (thanks to the two people who pointed out the schoolboy error) - added check for empty diagrams ( handy, should also fix some errors) - fixed bug in Perl Handler where use base splits package names too enthusiasticly - fixed bug in Perl Handler, can now parse modules like XML:Xerces (go on try it!) - fixed several small bugs in Diagram class version 1.8 29/08/2003 - added -C 'skip CVS directory(s)' option - added -F 'single file per diagram' option - added support for filenames containing spaces in -i option - fix in Autodia.pm wildcard/regex's provided by Daping Wang - fix in SQL handler provided by Brian Koehmstedt - fix in C++ handler that stops "public foo" class being created in place of "foo" - another 'use base' fix in Perl handler - fix to new layout that stops infinite loops (hopefully) version 1.7 13/07/2003 - added Torque handler - added Python handler (experimental) - applied small perl handler patch from Scott Lanning - small improvement to perl handler to improve support for 'use base' - applied php handler patch from - fixed documentation for php handler - new Dia layout algorithm based on directed graphs (huge improvement) - fix to DBI handler to improve support for oracle and postgres version 1.6 30/03/2003 - fixed SQL handler - improved test suite version 1.5 28/03/2003 - fixes to DBI handler - added SQL handler - fixes to c++ handler - fixes to Perl handler - added dia handler - added new options for hiding/showing attributes/methods - added new option to hide private/hidden attributes/methods - tidied up code and distribution version 1.4 12/02/2003 - Added better support for GraphViz and output in png, jpg and dot - added experimental support for VCG - some small improvements to C++ and perl handlers - added experimental dbi handler - escaped amphersans that broke dia xml - added support for ' use fields qw( fielda fieldb ) ' in perl handler version 1.3 24/12/2002 - Patch from Johan Van den Brande to handle use base in perl handler - Patch from Pascal to make php handler compile - Many fixes to C++ and PHP handlers - Added support for argument handling to C++ and PHP - Added support for gif output via GraphViz - renamed executable scripts to solve problems on Mac and Windows - updated POD, much still needs to be done - changed executable behaviour so that when run without arguments now returns help information - much code housekeeping version 1.2 26/06/2002 - AJT updated some of the documentation, but much still needs to be updated. - Simon Wistow made Autodia into a proper, CPAN installable Perl module - Made the Java parser work and fail gracefully from recoverable problems. - Cleared up vaious warnings. - Embedded the default template in Diagram.pm version 1.1 - unreleased - Lars Clausen fixed problems with the Java Parser version 1.0 6/07/2001 - Ekkehard Goerlach has fixed a great deal of the C++ parser - Some small fixes to the Handler and Diagram objects - New HTML templates - New Feature - Classes can be alphabetically sorted for text/html output - More robust error checking version 0.09 : 31/05/2001 - Added command line option to output to STDOUT - Added command line option to make silent/quiet (no output to STOUT except with above) - Small amount of code tidying version 0.08 : 26/05/2001 - fixed bug reported by P Sharpe, causing autodia to crash when no superclasses were found - somehow managed to avoid being spotted in 0.07 Version 0.07 : 21/05/2001 - Added T Payne's patch to fix bug in Diagram.pm when -t argument used - Improved Perl parser based on suggestion from E Goerlard. - Added -D command line option (ignore/skip dependanies) - Added more error checking in layout/export part of Diagram.pm - Improved auto-layout. Version 0.06 : 17/05/2001 - fixed unchecked return values in Diagram.pm when Inheritances() or Dependancies is called that caused a crash when no inheritances or dependancies were found at the layout stage. - did some tidying of code to make more consistent and clear. - fixed HandlerCpp to handle simple C++. Extracts most simple class info succesfully. = autodia is now well into beta with support for perl and simple c++ through the included handlers. Version 0.05 : 08/05/2001 - rewrite of parsing logic to use handlers **important** * all parsing is done by a parser class based on the Parser superclass * language options and handlers are matched using autodia.pm - increased error checking. - some small bug fixes. - first beta release of autodia - **new name** = autodia is now functionally complete it supports multiple languages and behaviours through the multiple handlers - currently an intermediate perl handler and a simple c++ handler. Handlers are easily written, inheriting and overloading the generic handler class provided. Version 0.04 : 24/4/2001 - further rewrite of the command line interface **important** - added functionality to find simple object attributes - rewrite of how relationships work - added functionality to place relations near their child - rewrite of layout code = now accepts directories and can recurse through them and layout is now improved for clarity. Version 0.03 : 18/4/2001 - fixed some parsing problems, now parses files better - fixed a dereferencing problem - rewrote the command line interface **important** = now handles complex and simple perl modules and scripts better Version 0.02 : 17/4/2001 - fixed problem occuring where no superclasses existed, now checks for existance of superclasses, classes, etc before trying to print - Checks for duplicate classes and ignores them instead of overwriting existsing ones. - removed a load of un-necessary code - made the layout a little more space efficient (still needs some serious work though). - fixed text inside components = now handles CGI.pm fairly well, and lays out itself rather well. Version 0.01b : 12/4/2001 - fixed problems in template.xml, no longer crashes dia - rewrote duplication and supercession code almost from scratch - fixed numerous silly mistakes involving referencing and arrays of references = now loads in dia and correctly handles inheritance Version 0.01a : 10/4/2001 - fixed mistake in template.xml (should now parse cleanly in dia) - fixed command line options (now accepts -h for help and -o for output file) - added POD to autodial script - created FAQ Autodia-2.14/FAQ0000644000076400007640000000461711001402615012712 0ustar teejayteejayThe AutoDIAL FAQ An uptodate copy of this document can be found at http://www.aarontrevena.co.uk/opensource/autodia/faq.txt Q: Why is autodia. not processing my file A: Have you used the -i option, if not try autodia -i filename or autodia -i "filea fileb filec" Q: I get a "can't locate Template.pm in @INC" error mesage or similar A: It is likely that you don't have template toolkit installed, it is not part of the perl core libraries, but is available through CPAN as Template. Q: Why does only the first file get processed? A: If you are entering the filenames as -i filename filename rather than -i "filename filename" only the first will be processed. If you aren't using any other options than -i it would probably be easier to just use 'autodia filename filename'. Q: When I use the -O option I get stuff mixed in with my xml, how do I stop that happening? A: When using -O, the usual messages are output to STDOUT, as well as the xml - but the xml will not contain any messages it can be used as is. To stop any output to STDOUT other than the dia xml use the -S option which suppresses messages. Q: Why does my option get ignored? A: If you don't use the -i option to specify which file to use autodial just takes the argument as a list of files to use and ignores any options. Q: How do I make autodia handle my preferred language? A: Read the guide to creating your own handler in the DEVELOP file. Q: Why does it take so long? A: AutoDia does all kinds of strange things and has been designed for clarity and reliability rather than speed - for an idea of how long things should take see the benchmarks in README and DEVELOP. Q: Why didn't you do this in C (or java or python)? A: Because it is so much easier in perl. Perl is good for parsing text and also interfaces very well with databases and other sources of data making it the prime choice of language for this task. Q: Why don't you do this for Visio A: i) Because Visio *STILL* uses proprietary formats and requires lots of NDAs and license fees to be able to integrate with. ii) Because Dia is used by perl developers more than Visio. iii) Because Visio is Proprietary and Dia is free software, I want to Dia to be better and more popular than Visio and I hope this helps. Q: Why is AutoDia so rubbish. A: Because Trelane told me to 'just release it'. Any corrections or contributions to the faq should be mailed to me at aaron.trevena@gmail.com Autodia-2.14/DEVELOP0000644000076400007640000001350111001402615013371 0ustar teejayteejayDEVELOPMENT NOTES ----------------- This file contains random development notes. You should have read or at least skimmed it when you intend to customize, port, extend or translate this Application. NB: This document is now out of date, but it is a starting point and should be updated soon. CONTENTS -------- - ALWAYS RTFM - ADDING FUNCTIONALITY - WHY I DID IT THIS WAY - HOW IT WORKS (probably the interesting bit) - HOW TO ADD A HANDLER (even more interesting) - BENCHMARKS - BUGS ALWAYS RTFM BEFORE YOU DO ANYTHING. ----------------------------------- The POD is there for all perl modules - use it. If its not in the POD or if the POD is unclear, email me - I plan to set up a mailing list soon. ADDING FUNCTIONALITY -------------------- Did I say RTFM, well again, read the documentation before you do anything. Functionality should be added through extending the current model and/or adding abstraction, maintaining or increasing the componentisation. I have spent a long time ironing out the hacks and bugs and won't put any back in in a hurry. If you wish to add functionality then email me a patch, the source and an explaination, if you wish to request a feature also email me. I can be reached at aaron.trevena@gmail.com WHY I DID IT THIS WAY --------------------- I did it this way as a cruel joke on other programmers. No not really, even if it does seem that way. I started doing this project as an afternoons hack but I got interested in it, and I wanted to make it more elegant, in the end it became a full on project and I had to rewrite from scratch using OO, modules and plenty of abstraction. There is still a long way to go in this regard to make it totally componentised so that it can be integrated into a perl script and handle different types of input and output. HOW IT WORKS ------------ - The autodia.pl script gets a list of files to analyse from the user, uses File::Find or globbing to generate a list based on the langauge. - The autodial.pl script creates an empty Diagram object (using Diagram.pm) - The autodia.pl script loads the appropriate handler and passes it the filehandle of each file ( or in the case of DBI a DSN ) - The handler parses each file in the list and creates a new Class object for each class or in perl package/script, or in c program/library. (using Autodia::Diagram::Class), this Class is added to the Autodia::Diagram object which holds all the objects and provides methods for accessing them. - As the file is parsed the handler populates the Class object from any functions/methods, attributes, and relationships it finds. These are added to the Class and in the case of superclasses and packages the Diagram object. (using Autodia::Diagram::Superclass, Autodia::Diagram::Component, etc) - After the files have been parsed redundancies are removed and the positions for each diagram entity (ie class, relationship, superclass) are calculated using a simple tree layout algorithm or passed through an external program such as dot or vcg dependant on command line options. - If using an external program or using a custom output function (in Autodia::Diagram where this is done) the objects are called to build a set of nodes for passing to an external application or transposing into some text to be output - If using a template the template is created and passed the Diagram object, the output file and the template file. - If using a template the template then makes calls to the Diagram Object it was passed, which provide lists of diagram entities which it uses to populate the template. HOW TO ADD A HANDLER -------------------- To add a handler to AutoDia - open Autodia.pm and add the language name and handler name into the %handlers hash in the getHandlers function. - add patterns and regex's for finding appropriate files if not already present in the getPattern function. - examples and documentation in Autodia.pm, also check Autodia/Diagram.pm which is the core of the Application. - create a class that inherits from Autodia::Handler or Autodia::Handler::Perl. You will need to have a method called _parse that is passed the filehandle and does all the diagram and class population. you can add any subroutines you need to make _parse work. - the Handler superclass does most of the work along with the diagram classes. see the Autodia::Handler::Perl parser for example code as it is heavily commented and clearly laid out (well as much as possible) BENCHMARKS --------- Some quick and dirty tests to give you an idea of how long stuff could take. Autodia pre 0.05 contains about 2000 lines of code in 7 files. Autodia 0.05 and higher contains about 2500 to 3000 lines in 11 files. Autodia 1.7 (pre-release) contains a total of 5520 lines in 18 files excluding makefiles, etc version 1.0: (intel Celeron Mendocino 466mhz running linux 2.4.6) 10 loops of autodial.pl took 9 wallclock secs ( 8.87 usr + 0.02 sys = 8.89 CPU) @ 1.12/s (n=10) On a K2 450, running Linux 2.2.12. AutoDial analysed itself 10 times, version 0.09: 10 loops of autodial.pl took 10 wallclock secs ( 9.20 usr + 0.24 sys = 9.44 CPU) version 0.08: 10 loops of autodial.pl took 10 wallclock secs ( 9.00 usr + 0.21 sys = 9.21 CPU) version 0.06: 10 loops of autodial.pl took 10 wallclock secs ( 9.32 usr + 0.23 sys = 9.55 CPU) version 0.05: 10 loops of autodial.pl took 11 wallclock secs ( 9.68 usr + 0.27 sys = 9.95 CPU) version 0.04: 10 loops of autodial.pl took 9 wallclock secs ( 8.36 usr + 0.08 sys = 8.44 CPU) version 0.02: 10 loops of autodial.pl took 8 wallclock secs ( 7.09 usr + 0.13 sys = 7.22 CPU) version 0.01: 10 loops of autodial.pl took 6 wallclock secs ( 5.94 usr + 0.09 sys = 6.03 CPU ) ###################################################################### Please submit bug reports, code, examples, test code, etc to aaron.trevena@gmail.com , see http://www.aarontrevena.co.uk/opensource/autodia/ for details and news. Autodia-2.14/MANIFEST0000644000076400007640000000165511566450350013527 0ustar teejayteejayCHANGES COPYING CREDITS DEVELOP FAQ INSTALL MANIFEST README TODO autodia.pl Makefile.PL t/autodia.t t/pod.t lib/Autodia.pm lib/Autodia/Diagram.pm lib/Autodia/Diagram/Class.pm lib/Autodia/Diagram/Component.pm lib/Autodia/Diagram/Dependancy.pm lib/Autodia/Diagram/Inheritance.pm lib/Autodia/Diagram/Relation.pm lib/Autodia/Diagram/Realization.pm lib/Autodia/Diagram/Object.pm lib/Autodia/Diagram/Superclass.pm lib/Autodia/Handler.pm lib/Autodia/Handler/ASP.pm lib/Autodia/Handler/Cpp.pm lib/Autodia/Handler/Perl.pm lib/Autodia/Handler/PHP.pm lib/Autodia/Handler/DBI.pm lib/Autodia/Handler/DBI_SQLT.pm lib/Autodia/Handler/SQL.pm lib/Autodia/Handler/dia.pm lib/Autodia/Handler/Torque.pm lib/Autodia/Handler/python.pm lib/Autodia/Handler/umbrello.pm lib/Autodia/Handler/CSharp.pm lib/Autodia/Handler/Mason.pm templates/mysql_ddl.tt templates/pod.tt examples/skiplist META.yml Module meta-data (added by MakeMaker)