diff options
| -rwxr-xr-x | run_cpan_test_imports.pl | 86 |
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; +} |