#!/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;
}