Attachment #59601 for bug #17990

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




    }
}

sub versions_info {
    no warnings; # perl throws warns for invalid $VERSION numbers which some modules use
    my $self = shift;

    #   Reset these arrayref each pass through to ensure current information
    $self->{'missing_pm'} = [];
    $self->{'upgrade_pm'} = [];
    $self->{'current_pm'} = [];

    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 {
        ( $cur_ver, $upgrade, $status ) = ( $module->VERSION, 0, 'current' );
            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;
    }

    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]};
}

    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('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:


        required = 0 of the module is optional; 1 if required

        {
           'required' => 1,
           'cur_ver' => '1.30_01',
           'upgrade' => 0,
           'min_ver' => '1.29'
                           'min_ver' => '1.29'
                         }
        };

        C<$perl_modules->version_info;>

Lines 316-322 $template->param( Link Here

(-)a/about.pl (-1 / +1 lines)
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

Lines 67-73 if ( $step && $step == 1 ) { Link Here

(-)a/installer/install.pl (-1 / +1 lines)
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)) {

Lines 35-41 GetOptions( Link Here

(-)a/koha_perl_deps.pl (-1 / +1 lines)
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




# This Koha test module is a stub!  
# Add more tests here!!!

use Modern::Perl;
use warnings;

use Test::More tests => 22;

BEGIN {
        use_ok('C4::Installer::PerlModules');
}

$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");

$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');

%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('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');
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");

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' );
};





isa_ok($obj,'C4::Installer::PerlModules');

my $module_info = $obj->version_info('Test::More');

my $control = $Test::More::VERSION;

like($module_info->{cur_ver}, qr/\d/, 'returns numeric version');

is($module_info->{cur_ver}, $control, 'returns correct version');


- 

Return to bug 17990

Lines 57-105 sub required { Link Here

(-)a/C4/Installer/PerlModules.pm (-41 / +43 lines)
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;>

Lines 3-26 Link Here

(-)a/t/Installer_PerlModules.t (-13 / +37 lines)
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	};

Lines 14-25 my $obj = C4::Installer::PerlModules->new; Link Here

(-)a/t/Installer_pm.t (-4 / +3 lines)
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	-