Perl Dependency Tree Solver

Question

I am trying to find a creative way to define dependencies so that I can run the test regression in the correct sequence.

For instance:

a: d, e, f

b: c, d

c: f

d: e

This means that the test "a" depends on the completion of the tests "d, e and f", etc.

I have the following code that will print the "leaf" nodes "e" and "f", however I am stuck with how to go about crawling and print the parent nodes. Any advice would be greatly appreciated.

Thank!

my @input = ("a:d,e,f", "b:c,d", "c:f", "d:e");
my %Tests = ();
my %Built = ();

## Build Structure
foreach my $elem (@input) {
     my $depends = [];
     my $target;
     ($target,$depends) = parseData($elem);
     $Tests{$target} = $depends; ## Setting array ref to hashkey $target     
}


sub parseData {
  my $data = shift;
  my ($target, $deps) = split(/:/, $data);
  my @deps;
  @deps = split(/,/, $deps);
  return ($target,\@deps);
}

foreach my $key (keys %Tests) {
  doIT(\%Tests, \%Built, $key);
}

sub doIT {
 my ($testRef, $builtRef, $target) = @_;
 my $depends = $testRef->{$target};
 if(exists $builtRef->{$target}) {
   return;
 }
 if(!$depends) {
   ## No dependency, build it
   print "RunTest($target)\n";
   $builtRef->{$target}++;
   return;
 }

 foreach my $dep (@$depends) {
    doIT($testRef, $builtRef, $dep);
 }
}

Answer 1

There is always brute force. I will let someone come up with something clever:

use strict;
use warnings;

my @input = ("a:d,e,f", "b:c,d", "c:f", "d:e");

my %children;
my %parents;

for (@input) {
    my ($parent, @kids) = split /[:,]/;
    for (@kids) {
        $children{$parent}{$_}++;
        $children{$_} ||= {};
        push @{$parents{$_}}, $parent;
    }
}

my @order;
while (my $count = scalar keys %children) {
    while (my ($p, $k) = each %children) {
        if (! keys %$k) {
            push @order, $p;
            delete $children{$p};
            delete $children{$_}{$p} for @{$parents{$p}};
        }
    }

    die "circular dependency exists" if $count == scalar keys %children;
}

print "@order";

Answer 2

, Graph:: Directed. , , :

use Graph::Directed;

my $graph = Graph::Directed->new();

my @edges = qw(d a e a f a c b d b f c e d);
while (my ($from, $to) = splice @edges, 0, 2) {
    $graph->add_edge($from, $to);
}
my @order = $graph->toposort();
print "@order\n";

f e c d a b

Answer 3

Here's an object-oriented example using MooX :: Role :: DependsOn .

use feature 'say';

# Class (representing a 'job') that consumes MooX::Role::DependsOn:
package Task;
use Moo;
with 'MooX::Role::DependsOn';

sub execute {
  my ($self) = @_;
  say "execute called for job ".$self->dependency_tag;
}

package main;
# Create some objects that consume MooX::Role::DependsOn:
my $job = {};
for my $jobname (qw/ A B C D E F /) {
  $job->{$jobname} = Task->new(dependency_tag => $jobname)
}

# Add some dependencies:
# A depends on D, E, F
$job->{A}->depends_on( $job->{D}, $job->{E}, $job->{F} );
# B depends on C, D
$job->{B}->depends_on( $job->{C}, $job->{D} );
# C depends on F
$job->{C}->depends_on( $job->{F} );
# D depends on E
$job->{D}->depends_on( $job->{E} );

# Resolve dependencies for an object:
say "Object A:";
my @ordered = $job->{A}->dependency_schedule;
for my $obj (@ordered) {
  $obj->execute;
}