From b4f9173a98535eefeabbd5c8c4435abaaa1ac2e1 Mon Sep 17 00:00:00 2001 From: Jonathan Druart Date: Wed, 25 Jan 2017 11:33:43 +0100 Subject: [PATCH] Bug 17990: Refactor Perl module versions check The code is duplicated, variable are not set ($_), code is hard to read, not covered by tests and the subroutine has 2 completely different behaviors depending on the presence of the "module" parameter. No need more ti rewrite it. Test plan: - Use koha_perl_deps.pl with the different options (-u -m -a -i) - Go on the about page, "Perl modules" tab You should not see any differences from before and after this patch Signed-off-by: David Cook Signed-off-by: Marcel de Rooy Signed-off-by: Mason James --- 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(-) diff --git a/C4/Installer/PerlModules.pm b/C4/Installer/PerlModules.pm index 2a64826f43..35cbfebeea 100644 --- a/C4/Installer/PerlModules.pm +++ b/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;> diff --git a/about.pl b/about.pl index ca8ff9f28f..35c41fc35e 100755 --- a/about.pl +++ b/about.pl @@ -285,7 +285,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); diff --git a/installer/install.pl b/installer/install.pl index 512ca3cd8d..10b642292a 100755 --- a/installer/install.pl +++ b/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)) { diff --git a/koha_perl_deps.pl b/koha_perl_deps.pl index 54e6de0b75..9ca2a14cdb 100755 --- a/koha_perl_deps.pl +++ b/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 = (); diff --git a/t/Installer_PerlModules.t b/t/Installer_PerlModules.t index fafdd48e8d..dad968fed6 100755 --- a/t/Installer_PerlModules.t +++ b/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' ); +}; diff --git a/t/Installer_pm.t b/t/Installer_pm.t index 4370174e3f..73781724fb 100755 --- a/t/Installer_pm.t +++ b/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'); -- 2.11.4.GIT