From 3040ee0f3c62e47c55fb42956b86e228be986990 Mon Sep 17 00:00:00 2001
From: Hauke D <haukex@zero-g.net>
Date: Wed, 22 Aug 2018 18:04:55 +0200
Subject: [PATCH] Added experimental module dependency resolver

---
 experiments/depend.pl | 111 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 111 insertions(+)
 create mode 100755 experiments/depend.pl

diff --git a/experiments/depend.pl b/experiments/depend.pl
new file mode 100755
index 0000000..a5c41db
--- /dev/null
+++ b/experiments/depend.pl
@@ -0,0 +1,111 @@
+#!/usr/bin/env perl
+use warnings;
+use 5.026;
+use Getopt::Long qw/ HelpMessage :config posix_default gnu_compat
+	bundling auto_version auto_help /;
+use Graph ();
+use Memoize 'memoize';
+use Memoize::Storable ();
+
+=head1 SYNOPSIS
+
+ depend.pl MODULE(s)
+ OPTIONS:
+   -v | --verbose         - more output
+   -t | --want-test       - include modules needed for test phase
+   -p | --perl-ver VER    - Perl version for corelist (default: 5.026)
+   -c | --cache-file FILE - cache file for MetaCPAN API requests
+                            (default: /tmp/.metacpan_deps_cache)
+   -C | --clear-cache     - clear cache before running
+
+=head1 DESCRIPTION
+
+A test of resolving module dependences, currently via the MetaCPAN API.
+(The list of dependencies that MetaCPAN knows about may not always be complete.)
+
+Outputs a possible install order that should satisfy dependencies.
+Note this order can change across runs, but theoretically it should
+always be a valid install order.
+
+Notes for WebPerl:
+Could be used in F<build.pl>.
+I don't really need C<is_installed>.
+Perhaps instead of C<is_core> I should check if the module exists
+in the Perl source tree and is enabled in F<config.sh>...
+
+=cut
+
+our $VERSION = '0.01-beta';
+
+GetOptions(
+	'v|verbose'      => \(my $VERBOSE),
+	't|want-test'    => \(my $WANT_TEST),
+	'p|perl-ver=s'   => \(my $PERL_VER='5.026'),
+	'c|cache-file=s' => \(my $CACHE_FILE='/tmp/.metacpan_deps_cache'),
+	'C|clear-cache'  => \(my $NO_CACHE),
+	) or HelpMessage(-exitval=>255);
+HelpMessage(-msg=>'Not enough arguments',-exitval=>255) unless @ARGV;
+
+
+if ($NO_CACHE && -e $CACHE_FILE)
+	{ unlink($CACHE_FILE)==1 or die "Failed to unlink $CACHE_FILE: $!" }
+tie my %get_deps_cache, 'Memoize::Storable', $CACHE_FILE;
+memoize 'get_deps', SCALAR_CACHE=>[HASH=>\%get_deps_cache], LIST_CACHE=>'FAULT';
+memoize 'is_core';
+memoize 'is_installed';
+
+
+my $dep_graph = Graph->new(directed => 1);
+resolve_deps($_, $dep_graph) for @ARGV;
+my @topo = $dep_graph->topological_sort;
+say for reverse @topo;
+warn "No (non-core) dependencies\n" unless @topo;
+
+
+use MetaCPAN::Client ();
+sub get_deps { # will be memoized (and persisted)
+	my ($module) = @_;
+	state $mcpan = MetaCPAN::Client->new();
+	$VERBOSE and say STDERR "Fetching dependencies of $module from MetaCPAN API";
+	return $mcpan->release($mcpan->module($module)->distribution)->dependency;
+}
+
+use Module::CoreList ();
+sub is_core { # will be memoized
+	my ($module,$version) = @_;
+	return Module::CoreList::is_core($module,$version,$PERL_VER);
+}
+
+use Module::Load::Conditional ();
+sub is_installed { # will be memoized
+	my ($module,$version) = @_;
+	return Module::Load::Conditional::check_install(module=>$module,version=>$version);
+}
+
+sub resolve_deps {
+	my $module = shift;
+	my $graph = @_ ? shift : Graph->new(directed => 1);
+	for my $dep ( get_deps($module)->@* ) {
+		next if is_core( $dep->{module}, $dep->{version} );  # ignore core modules
+		next if $dep->{module} eq 'perl';                    # ignore perl dist itself
+		next unless $dep->{relationship} eq 'requires';      # ignore 'recommends' and 'suggests'
+		die "Unknown relationship '$dep->{relationship}'"
+			unless $dep->{relationship}=~/\A(?:requires|recommends|suggests)\z/;
+		next if $dep->{phase} eq 'develop';                  # ignore phase 'develop'
+		next if !$WANT_TEST && $dep->{phase} eq 'test';      # ignore phase 'test' unless user wants it
+		next if $dep->{phase}=~/\Ax_/;                       # ignore e.g. "x_Dist_Zilla"
+		die "Unknown phase '$dep->{phase}'"
+			unless $dep->{phase}=~/\A(?:configure|build|runtime|test)\z/;
+		my $installed = is_installed( $dep->{module}, $dep->{version} );  # just for info
+		$VERBOSE and say STDERR "$module requires $dep->{module}",
+			$dep->{version} ? " (version $dep->{version})" : " (any version)",
+			" for $dep->{phase}",
+			$installed ? " (installed)" : " (not installed)";
+		$graph->add_edge($module, $dep->{module});
+		die "Fatal: Circular dependency detected (just added $module->$dep->{module})"
+			if $graph->has_a_cycle;
+		resolve_deps($dep->{module}, $graph)
+	}
+	return $graph;
+}
+