Depends.pm: add Depends::tsort

Author: AladW

perl/AUR/Depends.pm

@@ -7,11 +7,11 @@ use List::Util qw(first);
 use Carp;
 use Exporter qw(import);
 use AUR::Vercmp qw(vercmp);
-our @EXPORT_OK = qw(recurse prune graph);
 
 use constant EX_SUCCESS => 0;
 use constant EX_FAILURE => 1;
 use constant EX_OUT_OF_RANGE => 34;
+our @EXPORT_OK = qw(recurse prune graph tsort);
 our $VERSION = 'unstable';
 
 # Maximum number of calling the callback
@@ -296,4 +296,65 @@ sub prune {
     return @removals;
 }
 
+=head2 tsort()
+
+Topological sorting adapted from PerlPowerTools.
+
+=Performs depth-first traversal by default.
+
+=over
+
+=item C<$bfs> Perform breadth-first traversal.
+
+=back
+
+=cut
+
+sub tsort {
+    my ($bfs, $input) = @_;
+    $bfs //= 0;
+
+    my %pairs;  # all pairs ($l, $r)
+    my %npred;  # number of predecessors
+    my %succ;   # list of successors
+    my @output;
+
+    if (scalar(@{$input}) % 2 == 1) {
+        say STDERR __PACKAGE__ . ": odd number of tokens";
+        exit EX_FAILURE;
+    }
+
+    while (@{$input}) {
+        my $l = shift @${input};
+        my $r = shift @${input};
+
+        next if defined $pairs{$l}{$r};
+        $pairs{$l}{$r}++;
+        $npred{$l} += 0;
+
+        next if $l eq $r;
+        ++$npred{$r};
+        push @{$succ{$l}}, $r;
+    }
+
+    # create a list of nodes without predecessors
+    my @list = grep {!$npred{$_}} keys %npred;
+
+    while (@list) {
+        $_ = pop @list;
+        push @output, $_;
+
+        foreach my $child (@{$succ{$_}}) {
+            if ($bfs) {     # breadth-first
+                unshift @list, $child unless --$npred{$child};
+            } else {        # depth-first (default)
+                push @list, $child unless --$npred{$child};
+            }
+
+        }
+    }
+    warn "$Program: cycle detected\n" if grep {$npred{$_}} keys %npred;
+
+    return @output;
+}
 # vim: set et sw=4 sts=4 ft=perl: