@@ -, +, @@ - Use koha_perl_deps.pl with the different options (-u -m -a -i) - Go on the about page, "Perl modules" tab --- C4/Installer/PerlModules.pm | 84 +++++++++++++++++++++++---------------------- about.pl | 2 +- installer/install.pl | 2 +- koha_perl_deps.pl | 2 +- t/Installer_PerlModules.t | 50 ++++++++++++++++++++------- t/Installer_pm.t | 6 ++-- 6 files changed, 86 insertions(+), 60 deletions(-) --- a/C4/Installer/PerlModules.pm +++ a/C4/Installer/PerlModules.pm @@ -57,49 +57,53 @@ sub required { } } -sub version_info { - no warnings; # perl throws warns for invalid $VERSION numbers which some modules use +sub versions_info { my $self = shift; -# Reset these arrayref each pass through to ensure current information + + # Reset these arrayref each pass through to ensure current information $self->{'missing_pm'} = []; $self->{'upgrade_pm'} = []; $self->{'current_pm'} = []; - my %params = @_; - if ($params{'module'}) { - return -1 unless grep {m/$params{'module'}/} keys(%$PERL_DEPS); - eval "require $params{'module'}"; - my $pkg_version = $params{'module'} && $params{'module'}->can("VERSION") ? $params{'module'}->VERSION : 0; - my $min_version = $PERL_DEPS->{$params{'module'}}->{'min_ver'} // 0; - if ($@) { - return {$params{'module'} => {cur_ver => 0, min_ver => $PERL_DEPS->{$_}->{'min_ver'}, upgrade => 0, required => $PERL_DEPS->{$_}->{'required'}, usage => $PERL_DEPS->{$_}->{'usage'}}}; - } - elsif (version->parse("$pkg_version") < version->parse("$min_version")) { - return {$params{'module'} => {cur_ver => $params{'module'}->VERSION, min_ver => $PERL_DEPS->{$params{'module'}}->{'min_ver'}, upgrade => 1, required => $PERL_DEPS->{$params{'module'}}->{'required'}, usage => $PERL_DEPS->{$_}->{'usage'}}}; - } - else { - return {$params{'module'} => {cur_ver => $params{'module'}->VERSION, min_ver => $PERL_DEPS->{$params{'module'}}->{'min_ver'}, upgrade => 0, required => $PERL_DEPS->{$params{'module'}}->{'required'}, usage => $PERL_DEPS->{$_}->{'usage'}}}; - } + + for my $module ( sort keys %$PERL_DEPS ) { + my $module_infos = $self->version_info($module); + my $status = $module_infos->{status}; + push @{ $self->{"${status}_pm"} }, { $module => $module_infos }; + } +} + +sub version_info { + no warnings + ; # perl throws warns for invalid $VERSION numbers which some modules use + my ( $self, $module ) = @_; + return -1 unless grep { /^$module$/ } keys(%$PERL_DEPS); + + eval "require $module"; + my $pkg_version = $module->can("VERSION") ? $module->VERSION : 0; + my $min_version = $PERL_DEPS->{$module}->{'min_ver'} // 0; + + my ( $cur_ver, $upgrade, $status ); + if ($@) { + ( $cur_ver, $upgrade, $status ) = ( 0, 0, 'missing' ); + } + elsif ( version->parse("$pkg_version") < version->parse("$min_version") ) { + ( $cur_ver, $upgrade, $status ) = ( $module->VERSION, 1, 'upgrade' ); } else { - for (sort keys(%{$PERL_DEPS})) { - my $pkg = $_; # $_ holds the string - eval "require $pkg"; - my $pkg_version = $pkg && $pkg->can("VERSION") ? $pkg->VERSION : 0; - my $min_version = $PERL_DEPS->{$_}->{'min_ver'} // 0; - if ($@) { - push (@{$self->{'missing_pm'}}, {$_ => {cur_ver => 0, min_ver => $PERL_DEPS->{$_}->{'min_ver'}, required => $PERL_DEPS->{$_}->{'required'}, usage => $PERL_DEPS->{$_}->{'usage'}}}); - } - elsif (version->parse("$pkg_version") < version->parse("$min_version")) { - push (@{$self->{'upgrade_pm'}}, {$_ => {cur_ver => $pkg->VERSION, min_ver => $PERL_DEPS->{$_}->{'min_ver'}, required => $PERL_DEPS->{$_}->{'required'}, usage => $PERL_DEPS->{$_}->{'usage'}}}); - } - else { - push (@{$self->{'current_pm'}}, {$_ => {cur_ver => $pkg->VERSION, min_ver => $PERL_DEPS->{$_}->{'min_ver'}, required => $PERL_DEPS->{$_}->{'required'}, usage => $PERL_DEPS->{$_}->{'usage'}}}); - } - } - return; + ( $cur_ver, $upgrade, $status ) = ( $module->VERSION, 0, 'current' ); } + + return { + cur_ver => $cur_ver, + min_ver => $PERL_DEPS->{$module}->{min_ver}, + required => $PERL_DEPS->{$module}->{required}, + usage => $PERL_DEPS->{$module}->{usage}, + upgrade => $upgrade, + status => $status, + }; } + sub get_attr { return $_[0]->{$_[1]}; } @@ -157,7 +161,7 @@ A module for manipulating Koha Perl dependency list objects. Depending on the parameters passed when invoking, this method will give the current status of modules currently used in Koha as well as the currently installed version if the module is installed, the current minimum required version, and the upgrade status. If passed C module_name>, the method evaluates only that module. If passed C 1>, all modules are evaluated. example: - Cversion_info(module => 'foo');> + Cversion_info('foo');> This usage returns a hashref with a single key/value pair. The key is the module name. The value is an anonymous hash with the following keys: @@ -167,12 +171,10 @@ A module for manipulating Koha Perl dependency list objects. required = 0 of the module is optional; 1 if required { - 'CGI::Carp' => { - 'required' => 1, - 'cur_ver' => '1.30_01', - 'upgrade' => 0, - 'min_ver' => '1.29' - } + 'required' => 1, + 'cur_ver' => '1.30_01', + 'upgrade' => 0, + 'min_ver' => '1.29' }; C<$perl_modules->version_info;> --- a/about.pl +++ a/about.pl @@ -316,7 +316,7 @@ $template->param( my @components = (); my $perl_modules = C4::Installer::PerlModules->new; -$perl_modules->version_info; +$perl_modules->versions_info; my @pm_types = qw(missing_pm upgrade_pm current_pm); --- a/installer/install.pl +++ a/installer/install.pl @@ -67,7 +67,7 @@ if ( $step && $step == 1 ) { } my $perl_modules = C4::Installer::PerlModules->new; - $perl_modules->version_info; + $perl_modules->versions_info; my $modules = $perl_modules->get_attr('missing_pm'); if (scalar(@$modules)) { --- a/koha_perl_deps.pl +++ a/koha_perl_deps.pl @@ -35,7 +35,7 @@ GetOptions( pod2usage(1) if $help || (!$missing && !$installed && !$upgrade && !$all); my $koha_pm = C4::Installer::PerlModules->new; -$koha_pm->version_info(all => 1); +$koha_pm->versions_info; my @pm = (); --- a/t/Installer_PerlModules.t +++ a/t/Installer_PerlModules.t @@ -3,24 +3,31 @@ # This Koha test module is a stub! # Add more tests here!!! -use strict; -use warnings; +use Modern::Perl; -use Test::More tests => 19; +use Test::More tests => 22; BEGIN { use_ok('C4::Installer::PerlModules'); } -$C4::Installer::PerlModules::PERL_DEPS->{'Local::Module::Sort'} = { +$C4::Installer::PerlModules::PERL_DEPS->{'Local::Module::Upgraded'} = { 'required' => '1', 'min_ver' => '0.9.3', 'usage' => "Testing: make sure numbers are compared numerically and not lexicographically", }; +$Local::Module::Upgraded::VERSION = '0.9.13'; +$INC{"Local/Module/Upgraded.pm"} = 1; +use_ok("Local::Module::Upgraded"); -$Local::Module::Sort::VERSION = '0.9.13'; -$INC{"Local/Module/Sort.pm"} = 1; -use_ok("Local::Module::Sort"); +$C4::Installer::PerlModules::PERL_DEPS->{'Local::Module::NotUpgraded'} = { + 'required' => '1', + 'min_ver' => '0.9.3', + 'usage' => "Testing: make sure numbers are compared numerically and not lexicographically", +}; +$Local::Module::NotUpgraded::VERSION = '0.9.1'; +$INC{"Local/Module/NotUpgraded.pm"} = 1; +use_ok("Local::Module::NotUpgraded"); my $modules; ok ($modules = C4::Installer::PerlModules->new(), 'Tests modules object'); @@ -37,15 +44,32 @@ my $optional = $modules->required('optional'=>1); %params = map { $_ => 1 } @$optional; ok (exists($params{"Test::Strict"}), 'test::strict optional for installer to run'); is ($optional = $modules->required('spaghetti'=>1),-1, '-1 returned when parsing in unknown parameter'); -my $version_info = $modules->version_info('module'=>"DBI"); -ok (exists($version_info->{'DBI'}->{"required"}), 'required exists'); -ok (exists($version_info->{'DBI'}->{"upgrade"}), 'upgrade exists'); -is ($modules->version_info('module'=>"thisdoesn'texist"),-1, 'thisdoesntexist should return -1'); +my $version_info = $modules->version_info('DBI'); +ok (exists($version_info->{"required"}), 'required exists'); +ok (exists($version_info->{"upgrade"}), 'upgrade exists'); +is ($modules->version_info("thisdoesn'texist"),-1, 'thisdoesntexist should return -1'); ok ($modules->module_count() >10 , 'count should be greater than 10'); my @module_list = $modules->module_list; %params = map { $_ => 1 } @module_list; ok (exists($params{"DBI"}), 'DBI exists in array'); is ($modules->required('module'=>"String::Random"),1, 'String::Random should return 1 since required'); -ok (!$modules->version_info(), "Testing empty modules"); +is ($modules->version_info(), -1, "Testing empty modules"); + +is($modules->version_info("Local::Module::Upgraded")->{"upgrade"},0,"Version 0.9.13 is greater than 0.9.3, so no upgrade needed"); +is($modules->version_info("Local::Module::NotUpgraded")->{"upgrade"},1,"Version 0.9.1 is smaller than 0.9.1, so no upgrade needed"); -is($modules->version_info('module'=>"Local::Module::Sort")->{"Local::Module::Sort"}->{"upgrade"},0,"Version 0.9.13 is greater than 0.9.3, so no upgrade needed"); +subtest 'versions_info' => sub { + plan tests => 4; + my $modules = C4::Installer::PerlModules->new; + $modules->versions_info; + ok( exists $modules->{missing_pm}, 'versions_info fills the missing_pm key' ); + ok( exists $modules->{upgrade_pm}, 'versions_info fills the upgrade_pm key' ); + ok( exists $modules->{current_pm}, 'versions_info fills the current_pm key' ); + my $missing_modules = $modules->get_attr( 'missing_pm' ); + my $upgrade_modules = $modules->get_attr( 'upgrade_pm' ); + my $current_modules = $modules->get_attr( 'current_pm' ); + my $dbi_is_missing = grep { exists $_->{DBI} ? 1 : () } @$missing_modules; + my $dbi_is_upgrade = grep { exists $_->{DBI} ? 1 : () } @$upgrade_modules; + my $dbi_is_current = grep { exists $_->{DBI} ? 1 : () } @$current_modules; + ok( $dbi_is_missing || $dbi_is_upgrade || $dbi_is_current, 'DBI should either be missing, upgrade or current' ); +}; --- a/t/Installer_pm.t +++ a/t/Installer_pm.t @@ -14,12 +14,12 @@ my $obj = C4::Installer::PerlModules->new; isa_ok($obj,'C4::Installer::PerlModules'); -my $hash_ref = $obj->version_info(module => 'Test::More'); +my $module_info = $obj->version_info('Test::More'); my $control = $Test::More::VERSION; -like($hash_ref->{'Test::More'}->{cur_ver}, qr/\d/, 'returns numeric version'); +like($module_info->{cur_ver}, qr/\d/, 'returns numeric version'); -ok($hash_ref->{'Test::More'}->{cur_ver} == $control, 'returns correct version'); +is($module_info->{cur_ver}, $control, 'returns correct version'); --