view release on metacpan or  search on metacpan

lib/Autodia/Diagram.pm  view on Meta::CPAN

package 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_<object type> 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 nam...

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_<elementname> method (ie add_classes() ).

Collections of elements are retrieved through the <elementname> method (ie Classes() ).

lib/Autodia/Diagram.pm  view on Meta::CPAN

      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";
	}
      }