View | Details | Raw Unified | Return to bug 17990
Collapse All | Expand All

(-)a/C4/Installer/PerlModules.pm (-41 / +43 lines)
Lines 57-105 sub required { Link Here
57
    }
57
    }
58
}
58
}
59
59
60
sub version_info {
60
sub versions_info {
61
    no warnings; # perl throws warns for invalid $VERSION numbers which some modules use
62
    my $self = shift;
61
    my $self = shift;
63
#   Reset these arrayref each pass through to ensure current information
62
63
    #   Reset these arrayref each pass through to ensure current information
64
    $self->{'missing_pm'} = [];
64
    $self->{'missing_pm'} = [];
65
    $self->{'upgrade_pm'} = [];
65
    $self->{'upgrade_pm'} = [];
66
    $self->{'current_pm'} = [];
66
    $self->{'current_pm'} = [];
67
    my %params = @_;
67
68
    if ($params{'module'}) {
68
    for my $module ( sort keys %$PERL_DEPS ) {
69
        return -1 unless grep {m/$params{'module'}/} keys(%$PERL_DEPS);
69
        my $module_infos = $self->version_info($module);
70
        eval "require $params{'module'}";
70
        my $status       = $module_infos->{status};
71
        my $pkg_version =  $params{'module'} &&  $params{'module'}->can("VERSION") ? $params{'module'}->VERSION : 0;
71
        push @{ $self->{"${status}_pm"} }, { $module => $module_infos };
72
        my $min_version =  $PERL_DEPS->{$params{'module'}}->{'min_ver'} // 0;
72
    }
73
        if ($@) {
73
}
74
            return {$params{'module'} => {cur_ver => 0, min_ver => $PERL_DEPS->{$_}->{'min_ver'}, upgrade => 0, required => $PERL_DEPS->{$_}->{'required'}, usage => $PERL_DEPS->{$_}->{'usage'}}};
74
75
        }
75
sub version_info {
76
        elsif (version->parse("$pkg_version") < version->parse("$min_version")) {
76
    no warnings
77
            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'}}};
77
      ;  # perl throws warns for invalid $VERSION numbers which some modules use
78
        }
78
    my ( $self, $module ) = @_;
79
        else {
79
    return -1 unless grep { /^$module$/ } keys(%$PERL_DEPS);
80
            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'}}};
80
81
        }
81
    eval "require $module";
82
    my $pkg_version = $module->can("VERSION") ? $module->VERSION : 0;
83
    my $min_version = $PERL_DEPS->{$module}->{'min_ver'} // 0;
84
85
    my ( $cur_ver, $upgrade, $status );
86
    if ($@) {
87
        ( $cur_ver, $upgrade, $status ) = ( 0, 0, 'missing' );
88
    }
89
    elsif ( version->parse("$pkg_version") < version->parse("$min_version") ) {
90
        ( $cur_ver, $upgrade, $status ) = ( $module->VERSION, 1, 'upgrade' );
82
    }
91
    }
83
    else {
92
    else {
84
        for (sort keys(%{$PERL_DEPS})) {
93
        ( $cur_ver, $upgrade, $status ) = ( $module->VERSION, 0, 'current' );
85
            my $pkg = $_;  #  $_ holds the string
86
            eval "require $pkg";
87
            my $pkg_version =  $pkg &&  $pkg->can("VERSION") ? $pkg->VERSION : 0;
88
            my $min_version = $PERL_DEPS->{$_}->{'min_ver'} // 0;
89
            if ($@) {
90
                push (@{$self->{'missing_pm'}}, {$_ => {cur_ver => 0, min_ver => $PERL_DEPS->{$_}->{'min_ver'}, required => $PERL_DEPS->{$_}->{'required'}, usage => $PERL_DEPS->{$_}->{'usage'}}});
91
            }
92
            elsif (version->parse("$pkg_version") < version->parse("$min_version")) {
93
                push (@{$self->{'upgrade_pm'}}, {$_ => {cur_ver => $pkg->VERSION, min_ver => $PERL_DEPS->{$_}->{'min_ver'}, required => $PERL_DEPS->{$_}->{'required'}, usage => $PERL_DEPS->{$_}->{'usage'}}});
94
            }
95
            else {
96
                push (@{$self->{'current_pm'}}, {$_ => {cur_ver => $pkg->VERSION, min_ver => $PERL_DEPS->{$_}->{'min_ver'}, required => $PERL_DEPS->{$_}->{'required'}, usage => $PERL_DEPS->{$_}->{'usage'}}});
97
            }
98
        }
99
        return;
100
    }
94
    }
95
96
    return {
97
        cur_ver  => $cur_ver,
98
        min_ver  => $PERL_DEPS->{$module}->{min_ver},
99
        required => $PERL_DEPS->{$module}->{required},
100
        usage    => $PERL_DEPS->{$module}->{usage},
101
        upgrade  => $upgrade,
102
        status   => $status,
103
    };
101
}
104
}
102
105
106
103
sub get_attr {
107
sub get_attr {
104
    return $_[0]->{$_[1]};
108
    return $_[0]->{$_[1]};
105
}
109
}
Lines 157-163 A module for manipulating Koha Perl dependency list objects. Link Here
157
    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.
161
    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.
158
162
159
    example:
163
    example:
160
        C<my $module_status = $perl_modules->version_info(module => 'foo');>
164
        C<my $module_status = $perl_modules->version_info('foo');>
161
165
162
        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:
166
        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:
163
167
Lines 167-178 A module for manipulating Koha Perl dependency list objects. Link Here
167
        required = 0 of the module is optional; 1 if required
171
        required = 0 of the module is optional; 1 if required
168
172
169
        {
173
        {
170
          'CGI::Carp' => {
174
           'required' => 1,
171
                           'required' => 1,
175
           'cur_ver' => '1.30_01',
172
                           'cur_ver' => '1.30_01',
176
           'upgrade' => 0,
173
                           'upgrade' => 0,
177
           'min_ver' => '1.29'
174
                           'min_ver' => '1.29'
175
                         }
176
        };
178
        };
177
179
178
        C<$perl_modules->version_info;>
180
        C<$perl_modules->version_info;>
(-)a/about.pl (-1 / +1 lines)
Lines 316-322 $template->param( Link Here
316
my @components = ();
316
my @components = ();
317
317
318
my $perl_modules = C4::Installer::PerlModules->new;
318
my $perl_modules = C4::Installer::PerlModules->new;
319
$perl_modules->version_info;
319
$perl_modules->versions_info;
320
320
321
my @pm_types = qw(missing_pm upgrade_pm current_pm);
321
my @pm_types = qw(missing_pm upgrade_pm current_pm);
322
322
(-)a/installer/install.pl (-1 / +1 lines)
Lines 67-73 if ( $step && $step == 1 ) { Link Here
67
    }
67
    }
68
68
69
    my $perl_modules = C4::Installer::PerlModules->new;
69
    my $perl_modules = C4::Installer::PerlModules->new;
70
    $perl_modules->version_info;
70
    $perl_modules->versions_info;
71
71
72
    my $modules = $perl_modules->get_attr('missing_pm');
72
    my $modules = $perl_modules->get_attr('missing_pm');
73
    if (scalar(@$modules)) {
73
    if (scalar(@$modules)) {
(-)a/koha_perl_deps.pl (-1 / +1 lines)
Lines 35-41 GetOptions( Link Here
35
pod2usage(1) if $help || (!$missing && !$installed && !$upgrade && !$all);
35
pod2usage(1) if $help || (!$missing && !$installed && !$upgrade && !$all);
36
36
37
my $koha_pm = C4::Installer::PerlModules->new;
37
my $koha_pm = C4::Installer::PerlModules->new;
38
$koha_pm->version_info(all => 1);
38
$koha_pm->versions_info;
39
39
40
my @pm = ();
40
my @pm = ();
41
41
(-)a/t/Installer_PerlModules.t (-13 / +37 lines)
Lines 3-26 Link Here
3
# This Koha test module is a stub!  
3
# This Koha test module is a stub!  
4
# Add more tests here!!!
4
# Add more tests here!!!
5
5
6
use strict;
6
use Modern::Perl;
7
use warnings;
8
7
9
use Test::More tests => 19;
8
use Test::More tests => 22;
10
9
11
BEGIN {
10
BEGIN {
12
        use_ok('C4::Installer::PerlModules');
11
        use_ok('C4::Installer::PerlModules');
13
}
12
}
14
13
15
$C4::Installer::PerlModules::PERL_DEPS->{'Local::Module::Sort'} = {
14
$C4::Installer::PerlModules::PERL_DEPS->{'Local::Module::Upgraded'} = {
16
    'required' => '1',
15
    'required' => '1',
17
    'min_ver' => '0.9.3',
16
    'min_ver' => '0.9.3',
18
    'usage' => "Testing: make sure numbers are compared numerically and not lexicographically",
17
    'usage' => "Testing: make sure numbers are compared numerically and not lexicographically",
19
};
18
};
19
$Local::Module::Upgraded::VERSION = '0.9.13';
20
$INC{"Local/Module/Upgraded.pm"} = 1;
21
use_ok("Local::Module::Upgraded");
20
22
21
$Local::Module::Sort::VERSION = '0.9.13';
23
$C4::Installer::PerlModules::PERL_DEPS->{'Local::Module::NotUpgraded'} = {
22
$INC{"Local/Module/Sort.pm"} = 1;
24
    'required' => '1',
23
use_ok("Local::Module::Sort");
25
    'min_ver' => '0.9.3',
26
    'usage' => "Testing: make sure numbers are compared numerically and not lexicographically",
27
};
28
$Local::Module::NotUpgraded::VERSION = '0.9.1';
29
$INC{"Local/Module/NotUpgraded.pm"} = 1;
30
use_ok("Local::Module::NotUpgraded");
24
31
25
my $modules;
32
my $modules;
26
ok ($modules = C4::Installer::PerlModules->new(), 'Tests modules object');
33
ok ($modules = C4::Installer::PerlModules->new(), 'Tests modules object');
Lines 37-51 my $optional = $modules->required('optional'=>1); Link Here
37
%params = map { $_ => 1 } @$optional;
44
%params = map { $_ => 1 } @$optional;
38
ok (exists($params{"Test::Strict"}), 'test::strict optional for installer to run');
45
ok (exists($params{"Test::Strict"}), 'test::strict optional for installer to run');
39
is ($optional = $modules->required('spaghetti'=>1),-1, '-1 returned when parsing in unknown parameter');
46
is ($optional = $modules->required('spaghetti'=>1),-1, '-1 returned when parsing in unknown parameter');
40
my $version_info = $modules->version_info('module'=>"DBI");
47
my $version_info = $modules->version_info('DBI');
41
ok (exists($version_info->{'DBI'}->{"required"}), 'required exists');
48
ok (exists($version_info->{"required"}), 'required exists');
42
ok (exists($version_info->{'DBI'}->{"upgrade"}), 'upgrade exists');
49
ok (exists($version_info->{"upgrade"}), 'upgrade exists');
43
is ($modules->version_info('module'=>"thisdoesn'texist"),-1, 'thisdoesntexist should return -1');
50
is ($modules->version_info("thisdoesn'texist"),-1, 'thisdoesntexist should return -1');
44
ok ($modules->module_count() >10 , 'count should be greater than 10');
51
ok ($modules->module_count() >10 , 'count should be greater than 10');
45
my @module_list = $modules->module_list;
52
my @module_list = $modules->module_list;
46
%params = map { $_ => 1 } @module_list;
53
%params = map { $_ => 1 } @module_list;
47
ok (exists($params{"DBI"}), 'DBI exists in array');
54
ok (exists($params{"DBI"}), 'DBI exists in array');
48
is ($modules->required('module'=>"String::Random"),1, 'String::Random should return 1 since required');
55
is ($modules->required('module'=>"String::Random"),1, 'String::Random should return 1 since required');
49
ok (!$modules->version_info(), "Testing empty modules");
56
is ($modules->version_info(), -1, "Testing empty modules");
57
58
is($modules->version_info("Local::Module::Upgraded")->{"upgrade"},0,"Version 0.9.13 is greater than 0.9.3, so no upgrade needed");
59
is($modules->version_info("Local::Module::NotUpgraded")->{"upgrade"},1,"Version 0.9.1 is smaller than 0.9.1, so no upgrade needed");
50
60
51
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");
61
subtest 'versions_info' => sub {
62
    plan tests => 4;
63
    my $modules = C4::Installer::PerlModules->new;
64
    $modules->versions_info;
65
    ok( exists $modules->{missing_pm}, 'versions_info fills the missing_pm key' );
66
    ok( exists $modules->{upgrade_pm}, 'versions_info fills the upgrade_pm key' );
67
    ok( exists $modules->{current_pm}, 'versions_info fills the current_pm key' );
68
    my $missing_modules = $modules->get_attr( 'missing_pm' );
69
    my $upgrade_modules = $modules->get_attr( 'upgrade_pm' );
70
    my $current_modules = $modules->get_attr( 'current_pm' );
71
    my $dbi_is_missing = grep { exists $_->{DBI} ? 1 : () } @$missing_modules;
72
    my $dbi_is_upgrade = grep { exists $_->{DBI} ? 1 : () } @$upgrade_modules;
73
    my $dbi_is_current = grep { exists $_->{DBI} ? 1 : () } @$current_modules;
74
    ok( $dbi_is_missing || $dbi_is_upgrade || $dbi_is_current, 'DBI should either be missing, upgrade or current' );
75
};
(-)a/t/Installer_pm.t (-4 / +3 lines)
Lines 14-25 my $obj = C4::Installer::PerlModules->new; Link Here
14
14
15
isa_ok($obj,'C4::Installer::PerlModules');
15
isa_ok($obj,'C4::Installer::PerlModules');
16
16
17
my $hash_ref = $obj->version_info(module => 'Test::More');
17
my $module_info = $obj->version_info('Test::More');
18
18
19
my $control = $Test::More::VERSION;
19
my $control = $Test::More::VERSION;
20
20
21
like($hash_ref->{'Test::More'}->{cur_ver}, qr/\d/, 'returns numeric version');
21
like($module_info->{cur_ver}, qr/\d/, 'returns numeric version');
22
22
23
ok($hash_ref->{'Test::More'}->{cur_ver} == $control, 'returns correct version');
23
is($module_info->{cur_ver}, $control, 'returns correct version');
24
24
25
25
26
- 

Return to bug 17990