################################################################
# 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 Diagram;

use strict;

use Template;
use Data::Dumper;

use DiagramClass;
use DiagramComponent;
use DiagramSuperclass;
use DiagramDependancy;
use DiagramInheritance;

#----------------------------------------------------------------
# Constructor Methods

sub new
{
  my $class = shift;

  my $config_ref = shift;
  my $Diagram = {};
  bless ($Diagram, ref($class) || $class);
  $Diagram->_initialise($config_ref);
  return $Diagram;
}

#
#----------------------------------------------------------------
#

################
# Access Methods

sub add_dependancy
{
    my $self = shift;
    my $dependancy = shift;

    $self->_package_add($dependancy);
    $dependancy->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_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";
	return -1;
      }
    # 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 1;
}

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)
		  { $inheritance->Parent($class->Id); }
		$class->has_child(scalar $superclass->Inheritances);
	      }

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

sub export_xml
{
    my $self            = shift;

    my %config          = %{$self->{_config}};

    my $output_filename = $config{outputfile};
    my $template_file   = $config{templatefile};
    if ($config{no_deps})
      { $self->_no_deps; }

    $self->_layout;     # calculate the positions of the elements within diagram

    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,
		 }; # cleanup whitespace and allow absolute paths
    my $template = Template->new($template_conf);
    my $template_variables = { "diagram" => $self, };

    my @template_args = ($template_file,$template_variables);
    push (@template_args, $output_filename)
      unless ( $config{use_stdout} );

    $template->process(@template_args)
	|| die $template->error();

    print "\n\noutput file is : $output_filename\n" unless ( $config{silent} );
    return;
}

#---------------------------------------------------------------------------------
# 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
    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, "DiagramSuperclass");
	    }
	  last SWITCH;
	}
       if ($object->Type eq "Component")
	{
	  if ($self->{"packages"}{"Component"}{$object->Name})
	    {
	      $return = $self->{"packages"}{"Component"}{$object->Name};
	      bless ($return, "DiagramComponent");
	    }
	  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;

    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
  }

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};
	    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;
	    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;
	    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, $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->Inheritances)
      { push(@relationships, @{$self->Inheritances}); }

    foreach my $relationship (@relationships)
      { $relationship->Reposition; }

    return 1;
  }

1;

##################################################################

=head1 NAME

Diagram - Class to hold a collection of objects representing parts of a Dia Diagram.

=head1 SYNOPSIS

use Diagram;

=item class methods

$Diagram = Diagram->new;

=item object data methods

# get versions #

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(), and Dependancies(); These are all called in the template to get the collections of objects to loop through.


# add versions #

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 names generated automagically.


# remove versions #

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 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.

=head2 Creating a new Diagram object

=item new()

creates and returns an unpopulated diagram object.

=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() ).

The diagram is laid out and output to a file using the export_xml() method.


=head2 See Also

DiagramObject DiagramClass DiagramSuperclass DiagramComponent DiagramInheritance DiagramDependancy

=cut

########################################################################






