File Coverage

File:C4/Installer/PerlModules.pm
Coverage:42.3%

linestmtbrancondsubtimecode
1package C4::Installer::PerlModules;
2
3
3
3
3
3
822
9
177
use warnings;
4
3
3
3
3
14
4
127
use strict;
5
6
3
3
3
3
13
4
113
use File::Spec;
7
8
3
3
3
3
645
73
146
use C4::Installer::PerlDependencies;
9
10
3
3
3
3
514
5479
83
use version; our $VERSION = qv('1.0.0_1');
11
12our $PERL_DEPS = $C4::Installer::PerlDependencies::PERL_DEPS;
13
14sub new {
15
1
1
27
    my $invocant = shift;
16
1
27
    my $self = {
17        missing_pm => [],
18        upgrade_pm => [],
19        current_pm => [],
20    };
21
1
33
35
    my $type = ref($invocant) || $invocant;
22
1
30
    bless ($self, $type);
23
1
28
    return $self;
24}
25
26sub prereq_pm {
27
0
0
0
    my $self = shift;
28
0
0
    my $prereq_pm = {};
29
0
0
    for (keys %$PERL_DEPS) {
30
0
0
        $prereq_pm->{$_} = $PERL_DEPS->{$_}->{'min_ver'};
31    }
32
0
0
    return $prereq_pm;
33}
34
35sub required {
36
0
0
0
    my $self = shift;
37
0
0
    my %params = @_;
38
0
0
0
0
0
    if ($params{'module'}) {
39
0
0
0
0
0
        return -1 unless grep {m/$params{'module'}/} keys(%$PERL_DEPS);
40
0
0
        return $PERL_DEPS->{$params{'module'}}->{'required'};
41    }
42    elsif ($params{'required'}) {
43
0
0
        my $required_pm = [];
44
0
0
        for (keys %$PERL_DEPS) {
45
0
0
0
            push (@$required_pm, $_) if $PERL_DEPS->{$_}->{'required'} == 1;
46        }
47
0
0
        return $required_pm;
48    }
49    elsif ($params{'optional'}) {
50
0
0
        my $optional_pm = [];
51
0
0
        for (keys %$PERL_DEPS) {
52
0
0
0
            push (@$optional_pm, $_) if $PERL_DEPS->{$_}->{'required'} == 0;
53        }
54
0
0
        return $optional_pm;
55    }
56    else {
57
0
0
        return -1; # unrecognized parameter passed in
58    }
59}
60
61sub version_info {
62
3
3
3
3
1318
35
1965
    no warnings; # perl throws warns for invalid $VERSION numbers which some modules use
63
1
1
15
    my $self = shift;
64# Reset these arrayref each pass through to ensure current information
65
1
15
    $self->{'missing_pm'} = [];
66
1
14
    $self->{'upgrade_pm'} = [];
67
1
14
    $self->{'current_pm'} = [];
68
1
15
    my %params = @_;
69
1
50
15
    if ($params{'module'}) {
70
1
102
50
81
186
        return -1 unless grep {m/$params{'module'}/} keys(%$PERL_DEPS);
71
1
90
        eval "require $params{'module'}";
72
1
50
50
109
        if ($@) {
73
0
0
            return {$params{'module'} => {cur_ver => 0, min_ver => $PERL_DEPS->{$_}->{'min_ver'}, upgrade => 0, required => $PERL_DEPS->{$_}->{'required'}, usage => $PERL_DEPS->{$_}->{'usage'}}};
74        }
75        elsif ($params{'module'}->VERSION lt $PERL_DEPS->{$params{'module'}}->{'min_ver'}) {
76
0
0
            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        }
78        else {
79
1
25
            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    }
82    else {
83
0
0
        for (sort keys(%{$PERL_DEPS})) {
84
0
            my $pkg = $_; # $_ holds the string
85
0
            eval "require $pkg";
86
0
0
0
            if ($@) {
87
0
0
                push (@{$self->{'missing_pm'}}, {$_ => {cur_ver => 0, min_ver => $PERL_DEPS->{$_}->{'min_ver'}, required => $PERL_DEPS->{$_}->{'required'}, usage => $PERL_DEPS->{$_}->{'usage'}}});
88            }
89            elsif ($pkg->VERSION lt $PERL_DEPS->{$_}->{'min_ver'}) {
90
0
0
                push (@{$self->{'upgrade_pm'}}, {$_ => {cur_ver => $pkg->VERSION, min_ver => $PERL_DEPS->{$_}->{'min_ver'}, required => $PERL_DEPS->{$_}->{'required'}, usage => $PERL_DEPS->{$_}->{'usage'}}});
91            }
92            else {
93
0
0
                push (@{$self->{'current_pm'}}, {$_ => {cur_ver => $pkg->VERSION, min_ver => $PERL_DEPS->{$_}->{'min_ver'}, required => $PERL_DEPS->{$_}->{'required'}, usage => $PERL_DEPS->{$_}->{'usage'}}});
94            }
95        }
96
0
        return;
97    }
98}
99
100sub get_attr {
101
0
0
    return $_[0]->{$_[1]};
102}
103
104sub module_count {
105
0
0
    return scalar(keys(%$PERL_DEPS));
106}
107
108sub module_list {
109
0
0
    return keys(%$PERL_DEPS);
110}
111
1121;