view release on metacpan or  search on metacpan

lib/Algorithm/DependencySolver/Solver.pm  view on Meta::CPAN

    }

    return \@relations;
}


method build_Graph() {

    my @vertices = keys %{$self->get_nodes_index};
    my @edges    = map {
        [ $_->[0]->id, $_->[1]->id ]
    } @{$self->get_relations};

    # Ensure that each explicit ordering (node.prerequisites) has an edge.
    for my $nodeB (@{$self->get_nodes}) {
        for my $nodeA_id (@{$nodeB->prerequisites}) {
            push @edges, [$nodeA_id, $nodeB->id];
        }
    }


    my $G = Graph::Directed->new(
        vertices    => \@vertices,
        edges       => \@edges,
#       refvertexed => 1,  # refvertexed is broken!
    );

    # Note: Graph::Traversal has a bug in it where noderefs are
    # sometimes stringified, even though they mustn't be with
    # refvertexed! Therefore, assume all of Graph is broken in this
    # respect, and never pass in addresses to references, but never
    # references themselves.

    $self->_apply_orderings($G);
    $self->_remove_redundancy($G);

    return $G;
}

method _get_nondeterministic_attributes() {
    my %nondep_affects;

  AFFECT:
    for my $affect (keys %{$self->get_affects_index}) {
        my @node_ids = map {
            $_->id
        } @{$self->get_affects_index->{$affect}};

        next AFFECT unless @node_ids;

        my @sequentials;

        for my $node_id (@node_ids) {
            my @pred_ids = $self->get_Graph->all_predecessors($node_id);
            push @pred_ids, $node_id;
            my $C = List::Compare->new(\@node_ids, \@pred_ids);
            if ($C->is_LsubsetR) {
                # We're good; we have a nice linear ordering
                next AFFECT;
            } else {
                my @intersection = $C->get_intersection;
                if (@intersection > @sequentials) {
                    @sequentials = @intersection;
                }
            }
        }

        # Nondeterministic affect!
        my @nondeps = List::Compare->new(\@node_ids, \@sequentials)->get_unique;
        $nondep_affects{$affect} = {
            sequentials => \@sequentials,
            nondeps     => \@nondeps,
        };
    }
    return keys(%nondep_affects) ? \%nondep_affects : undef;
}

method _get_undepended_affects() {
    my %undeped_affects;

  AFFECT:
    for my $affect (keys %{$self->get_affects_index}) {
        my @nodes = @{$self->get_affects_index->{$affect}};

        next AFFECT unless @nodes;

        for my $node (@nodes) {
            my $f;
            $f = sub {
                my $suc_id = shift;
                my $suc = $self->get_nodes_index->{$suc_id};
                if ($suc->depends($affect)) {
                    # This path is good
                    return [];
                } elsif ($suc->affects($affect)) {
                    # woah
                    return [$suc];
                } else {
                    return [map { @{$f->($_)} } $self->get_Graph->successors($suc_id)];
                }
            };
            my @bad = map { @{$f->($_)} } $self->get_Graph->successors($node->id);
            $undeped_affects{$affect}{$node->id} = \@bad if @bad;
        }
    }
    return keys(%undeped_affects) ? \%undeped_affects : undef;
}

method is_invalid() {
    my $cyclic           = $self->get_Graph->is_cyclic;
    my $nondeterministic = $self->_get_nondeterministic_attributes;
    my $undeped_affects  = $self->_get_undepended_affects;

    my %r;
    $r{cyclic}           = $cyclic           if $cyclic;
    $r{nondeterministic} = $nondeterministic if $nondeterministic;
    $r{undeped_affects}  = $undeped_affects  if $undeped_affects;

    if (keys %r) {
        return \%r;
    } else {
        return;
    }