Add cpan test script

This script is helpful for ensuring regressions haven't been introduced,
naturally it's relying on CPAN which can change over time, but it's
still useful to be able to check that the modules you could import
before applying a patch can still be imported afterwards.

Change-Id: I58ccadf08a3ad58a1c4aa8d3c730ced5e39426de

1 files changed, 86 insertions, 0 deletions

diff --git a/run_cpan_test_imports.pl b/run_cpan_test_imports.pl
new file mode 100755
index 0000000..2643f97
--- /dev/null
+++ b/run_cpan_test_imports.pl
@@ -0,0 +1,86 @@
+#!/usr/bin/env perl
+#
+# This script is helpful for ensuring regressions haven't been introduced,
+# naturally it's relying on CPAN which can change over time,
+# but it's still useful to be able to check that the modules
+# you could import before applying a patch can still be imported afterwards.
+#
+# Copyright © 2015  Codethink Limited
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; version 2 of the License.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along
+# with this program; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+
+use 5.020;
+use warnings;
+use strict;
+use English;
+use autodie;
+
+use File::Path qw(remove_tree);
+use IO::Async::Loop;
+use IO::Async::Process;
+
+my $argc = @ARGV;
+
+unless ($argc == 1) {
+    say STDERR "usage: $PROGRAM_NAME IMPORT_TOOL_PATH";
+    exit 1;
+}
+
+my $import_tool = File::Spec->rel2abs($ARGV[0]);
+
+my $ok = 1;
+
+my @modules = qw(IO::Async DBI CGI CGI::Carp Data::Dumper Net::SCP
+                 Mail::Sendmail CGI::Cookie Net::FTP Date::Simple
+                 LWP::UserAgent WWW::Mechanize XML::Simple Net::Telnet
+                 Text::CSV Log::Log4perl HTML::TreeBuilder Moose Moo
+                 SOAP::Lite Spreadsheet::WriteExcel
+                 Spreadsheet::ParseExcel YAML::LibYAML);
+
+mkdir 'test_results' unless (-d 'test_results');
+chdir 'test_results';
+
+my $i = 1;
+my $numof_modules = @modules;
+for my $module (@modules) {
+    say "Running test for $module ($i/$numof_modules)";
+    remove_tree($module);
+    mkdir $module;
+
+    my @args = [$import_tool, 'cpan', $module, "--log=importlog_$module"];
+
+    my $loop = IO::Async::Loop->new;
+    my $process = IO::Async::Process->new(command => @args,
+                                          setup => [chdir => $module],
+                                          on_finish => sub { $loop->stop });
+    $loop->add($process);
+    $loop->run;
+    $i++;
+}
+
+for my $module (@modules) {
+    my @expected_stratum_path = glob "$module/definitions/strata/*.morph";
+
+    unless (@expected_stratum_path) {
+        say "no stratum for $module";
+        $ok = 0;
+    }
+}
+
+if ($ok) {
+    say 'Looks ok';
+}
+else {
+    exit 1;
+}