Attachment 59590 Details for Bug 17990 – Bug 17990: Refactor Perl module versions check

[patch] Bug 17990: Refactor Perl module versions check

Bug-17990-Refactor-Perl-module-versions-check.patch (text/plain), 12.30 KB, created by David Cook on 2017-01-26 23:20:40 UTC

(hide)

Description:

Filename:

MIME Type:

Creator: David Cook

Created: 2017-01-26 23:20:40 UTC

Size: 12.30 KB

patch

obsolete

>From 63ec8e58505bae61adae3e8654abb95567e15ece Mon Sep 17 00:00:00 2001
>From: Jonathan Druart <jonathan.druart@bugs.koha-community.org>
>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 <dcook@prosentient.com.au>
>---
> 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 2a64826..35cbfeb 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 => module_name>, the method evaluates only that module. If passed C<all => 1>, all modules are evaluated.
> 
>     example:
>-        C<my $module_status = $perl_modules->version_info(module => 'foo');>
>+        C<my $module_status = $perl_modules->version_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 f0b0499..ef91b24 100755
>--- a/about.pl
>+++ b/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);
> 
>diff --git a/installer/install.pl b/installer/install.pl
>index 512ca3c..10b6422 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 54e6de0..9ca2a14 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 fafdd48..dad968f 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 4370174..7378172 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.10.2

Actions: View | Diff | Splinter Review

Attachments on bug 17990: 59546 | 59590 | 59601