# Copyright (c) 2002 Cunningham & Cunningham, Inc.
# Released under the terms of the GNU General Public License version 2 or later.
#
# Perl port by Martin Busik <martin.busik@busik.de>
#

{
package Test::C2FIT::eg::AllPairs::Var;

sub new {
    my $pkg = shift;
    my ($index,$files) = @_;
    return bless {
        files => $files,
        index => $index,
        items => []
    }, $pkg;
}
sub size { scalar(@{$_[0]->{items}}) }
sub get  {
    my ($self,$index) = @_;
    return $self->{items}->[$index];
}
1;
};

{
package Test::C2FIT::eg::AllPairs::Item;

sub new {
    my $pkg = shift;
    my ($var, $i, $n) = @_;
    return bless {
        var     => $var,
        index   => $i,
        rank    => $n
    }, $pkg;
}

sub file {
    my ($self) = shift;
    return $self->{var}->{files}->[$self->{index}];
}
sub toString {  # TBD: overload stringify operator?
    my $self = shift;
    $self->file;
}
sub isFit {
    my ($self,$slug) = @_;
    my $idx = $self->{var}->{index};
    return !defined($slug->[$idx]) || $slug->[$idx] == $self;
}
1;
}

{
package Test::C2FIT::eg::AllPairs::Pair;

sub new {
    my $pkg = shift;
    my ($allPairsRank,$left, $right) = @_;
    return bless {
        allPairsRank => $allPairsRank,
        left    => $left,
        right   => $right,
        used    => 0
    }, $pkg;
}

sub toString {  # TBD: overload stringify operator?
    my $self = shift;
    my $ls = (defined($self->{left}))  ? $self->{left}->toString  : "null";
    my $rs = (defined($self->{right})) ? $self->{right}->toString : "null";
    return $ls ."-". $rs . " (".$self->{used}.")";
}

sub isFit {
    my ($self,$slug) = @_;
    return  $self->{left}->isFit($slug) &&
            $self->{right}->isFit($slug);
}

sub rank {
    my $self = shift;
    my $parRank = ${$self->{allPairsRank}};
    return $parRank * ( $parRank * $self->{used} + $self->{left}->{rank} ) +
                        $self->{right}->{rank};
}

sub compareTo {
    my ($self,$other) = @_;
    return $self->rank - $other->rank;
}

1;
};

package Test::C2FIT::eg::AllPairs;
use base 'Test::C2FIT::eg::AllCombinations';

sub new {
    my $pkg = shift;
    my $self = $pkg->SUPER::new(@_);
    $self->{rank} = undef;
    $self->{steps} = 0;
    $self->{toItem} = {};
    $self->{vars}   = [];
    $self->{pairs}  = [];
    return $self;
}



sub combinations2 {
    my $self = shift;
    $self->populate;
    $self->generate;
}

sub populate {
    my $self = shift;
    $self->doAllVars;
    $self->doAllVarPairs;
}

sub doAllVars {
    my $self = shift;
    $self->{rank} = 0;
    for(my $i = 0; $i < @{$self->{lists}}; $i++) {
        my $files = $self->{lists}->[$i];
        my $var  = new Test::C2FIT::eg::AllPairs::Var($i,$files);
        push(@{$self->{vars}},$var);
        $self->doAllItems($var,$files);
    }
}

sub doAllItems {
    my ($self,$var,$files) = @_;
    my $toItem = $self->{toItem};
    for(my $i = 0; $i < @$files; $i++) {
        my $item = new Test::C2FIT::eg::AllPairs::Item($var,$i,$self->{rank}++);
        $toItem->{$files->[$i]} = $item;
        push(@{$var->{items}},$item);
    }
}

sub doAllVarPairs {
    my ($self) = shift;
    my $vars = $self->{vars};
    for(my $i=0; $i < @$vars; $i++) {
        for (my $j=$i+1; $j < @$vars; $j++) {
            $self->doAllItemPairs($vars->[$i], $vars->[$j]);
        }
    }
}

sub doAllItemPairs {
    my ($self,$vl, $vr) = @_;
    for(my $l=0; $l < $vl->size; $l++) {
        for(my $r=0; $r < $vr->size; $r++) {
            push(@{$self->{pairs}}, new Test::C2FIT::eg::AllPairs::Pair(\$self->{rank}, $vl->get($l),$vr->get($r)));
        }
    }
}

sub generate {
    my $self = shift;
    while($self->getFirstPair()->{used} == 0) {
        $self->emit($self->nextCase);
    }
}

sub nextCase {
    my $self = shift;
    my $slug = [];
    my $slugSize = @{$self->{vars}};
    while(!$self->isFull($slug,$slugSize)) {
        my $p = $self->nextFit($slug);
        $self->fill($slug,$p);
    }
    return $slug;
}

sub fill {
    my ($self,$slug,$pair) = @_;
    $slug->[ $pair->{left}->{var}->{index}  ] = $pair->{left};
    $slug->[ $pair->{right}->{var}->{index} ] = $pair->{right};
    $pair->{used}++;
    push(@{$self->{pairs}},$pair);
}

sub isFull {
    my($self,$slug,$targetSize) = @_;
    return 0 if @$slug != $targetSize;
    foreach (@$slug) {
        return 0 unless defined($_);
    }
    return 1;
}

sub nextFit {
    my ($self,$slug) = @_;
    my $hold = [];
    my $pair;
    while(!($pair = $self->nextPair)->isFit($slug)) {
        push(@$hold,$pair);
    }
    push(@{$self->{pairs}},@$hold);
    return $pair;
}

sub nextPair {
    my $self = shift;
    my $first = $self->removeFirstPair;
    $self->{steps}++;
    return $first;
}

sub emit {
    my ($self,$slug) = @_;
    my $combination = [];
    for (my $i=0; $i < @$slug; $i++) {
        push(@$combination,$slug->[$i]->file());
    }
    $self->doCase($combination);
}

sub getFirstPair {  # java uses a sorted collection, in the perl port pairs are sorted on demand
    my $self = shift;
    my $pairs = $self->{pairs};
    my @sorted = sort { $a->compareTo($b) } @$pairs;
    $self->{pairs} = \@sorted;
    return $self->{pairs}->[0];
}

sub removeFirstPair {
    my $self = shift;
    $self->getFirstPair;
    my $r = shift(@{$self->{pairs}});
    return $r;
}

1;
