package UML::XForm::AssociationNames;

use 5.6.1;
use strict;
use warnings;

our $AUTHOR = q{ ks.perl@kurtstephens.com 2004/05/04 };
our $VERSION = do { my @r = (q$Revision: 1.5 $ =~ /\d+/g); sprintf "%d." . "%03d" x $#r, @r };

=head1 NAME

UML::XForm::AssociationNames - Generates names for all Associations, renames AssociationEnds that collide across Generalizations.

=head1 SYNOPSIS

  use UML::XForm::AssociationNames;

  my $xform = UML::XForm::AssociationNames->new();
  $model = $xform->apply_Model($model);

=head1 DESCRIPTION


=head1 USAGE

=head1 PATTERNS

=head1 EXPORT

None exported.

=head1 AUTHOR

Kurt Stephens, ks.perl@kurtstephens.com 2003/05/04

=head1 SEE ALSO

L<UML::MetaMetaModel|UML::MetaMetaModel>

=head1 VERSION

$Revision: 1.5 $

=head1 METHODS

=cut

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

use base qw(UML::XForm);

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

use UML::MetaMetaModel::Util qw(:all);
use Carp qw(confess);

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

sub initialize
{
  my ($self) = @_;

  $self->SUPER::initialize;

  $self;
}


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

sub index_array
{
  my ($x, @x) = @_;

  for ( my $i = -1; ++ $i < @x;  ) {
    return $i if $x[$i] eq $x;
  }

  undef;
}


sub unique
{
  my %x = map(($_, $_), @_);
  values %x;
}


sub apply_Model
{
  my ($self, $model) = @_;

  print STDERR "* Pass 1:\n" if $self->{'verbose'} > 0;
  # Find all Associations
  my %assoc;
  for my $cls ( Namespace_classifier($model) ) {
    for my $cls_end ( $cls->association ) {
      my $assoc = AssociationEnd_association($cls_end);
      $assoc{$assoc} = $assoc;
    }	
  }
  my @assoc = values %assoc;
  $self->{'association'} = \@assoc;

  if ( $self->{'generate_names'} ) {
    print STDERR "* Pass 2:\n" if $self->{'verbose'} > 0;
    # Generate names for all Associations and AssociationEnds
    for my $assoc ( @assoc ) {
      my @x = $assoc->connection;
      
      # IMPLEMENT: Use set_name methods for namespace ownedElement
      # name collision checks.
      UML::MetaMetaModel::Object::__fix_association_end_names
      (
       $x[0]{'participant'},
       $x[0]{'name'},
       $x[1]{'participant'},
       $x[1]{'name'},
       );
      die("Too many AssociationEnds") if @x > 2;
      
      $assoc->{'name'} ||= join('_', map($_->{'name'}, @x));
    }
  }


  print STDERR "* Pass 3: Check for AssocationEnd name collisions\n" 
  if $self->{'verbose'} > 0;

  my @rename;
  for my $cls ( Namespace_classifier($model) ) {
    # Get all opposite AssociationEnds for $cls and all its Generalization parents.
    my @other_end = ();
    my @x = ($cls);
    my @gens;
    while ( @x ) {
      my $x = pop @x;

      next if grep($_ eq $x, @gens);
      push(@gens, $x);

      push(@x, map($_->parent, $x->generalization));
   
      for my $cls_end ( $x->association ) {
	push(@other_end, AssociationEnd_opposite($cls_end));
      }
    }


    @other_end = unique(@other_end);

    my $print_gens;
    for my $end ( @other_end ) {
      no warnings; # Use of uninitialized value in string eq at
      for my $same_name_end (
			     grep($_ ne $end && $_->name && $_->name eq $end->name, 
				  @other_end
				  )
			     ) {
	if ( $self->{'verbose'} > 0 ) {
	  unless ( $print_gens ++ ) {
	    print STDERR "\nIn Classifier $cls->{name}:\n", map("\t$_->{name}\n", @gens), "\n\n";
	  }
	  
	  print STDERR "\nCollision in $cls->{name}:\n\t", 
	  Association_asString(AssociationEnd_association($end)), "\n";
	  print STDERR "\n  with: \n\t", 
	  Association_asString(AssociationEnd_association($same_name_end)), "\n\n";
	}

	push(@rename, $end, $same_name_end);
      }
    }
  }

  print STDERR "* Pass 4: Rename\n" 
  if $self->{'verbose'} > 0;

  @rename = unique(@rename);
  for my $end ( @rename ) {
    $self->rename_end($end);
  }
  
  $model;
}


sub rename_end
{
  my ($self, $end) = @_;

  my $name = $end->name;
  my ($other_end) = AssociationEnd_opposite($end);
  $name = $name . '_' . $other_end->participant->name;;
  
  my $assoc = AssociationEnd_association($end);
  my $i = index_array($end, $assoc->connection);
  print STDERR "Changing AssocationEnd [$i] name:\n\t", Association_asString($assoc), "\n"
  if $self->{'verbose'} >= 0;

  $end->set_name($name);
  
  print STDERR "  To:\n\t", AssociationEnd_asString($end), "\n\n"
  if $self->{'verbose'} >= 0;

  $self
}


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


1;

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


### Keep these comments at end of file: ks.perl@kurtstephens.com 2003/04/06 ###
### Local Variables: ###
### mode:perl ###
### perl-indent-level:2 ###
### perl-continued-statement-offset:0 ###
### perl-brace-offset:0 ###
### perl-label-offset:0 ###
### End: ###

