summaryrefslogtreecommitdiffstats
path: root/scripts/cpanfile_fixed_versions.pl
blob: fdbf25b1f99eff8d279680844f00ca03e83675b8 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
#!/usr/bin/env perl
# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
#
# This Source Code Form is "Incompatible With Secondary Licenses", as
# defined by the Mozilla Public License, v. 2.0.

use 5.10.1;
use strict;
use warnings;

use Bugzilla::Constants;
use Bugzilla::Install::Requirements;
use Bugzilla::Install::Util;

sub _check_vers {
    my ($params) = @_;
    my $module  = $params->{module};
    my $package = $params->{package};
    if (!$package) {
        $package = $module;
        $package =~ s/::/-/g;
    }

    my $wanted = $params->{version};

    eval "require $module;";
    # Don't let loading a module change the output-encoding of STDOUT
    # or STDERR. (CGI.pm tries to set "binmode" on these file handles when
    # it's loaded, and other modules may do the same in the future.)
    Bugzilla::Install::Util::set_output_encoding();

    # VERSION is provided by UNIVERSAL::, and can be called even if
    # the module isn't loaded. We eval'uate ->VERSION because it can die
    # when the version is not valid (yes, this happens from time to time).
    # In that case, we use an uglier method to get the version.
    my $vnum = eval { $module->VERSION };
    if ($@) {
        no strict 'refs';
        $vnum = ${"${module}::VERSION"};

        # If we come here, then the version is not a valid one.
        # We try to sanitize it.
        if ($vnum =~ /^((\d+)(\.\d+)*)/) {
            $vnum = $1;
        }
    }
    $vnum ||= -1;

    # Must do a string comparison as $vnum may be of the form 5.10.1.
    my $vok = ($vnum ne '-1' && version->new($vnum) >= version->new($wanted)) ? 1 : 0;
    if ($vok && $params->{blacklist}) {
        $vok = 0 if grep($vnum =~ /$_/, @{$params->{blacklist}});
    }

    return {
        module => $module,
        ok     => $vok,
        wanted => $wanted,
        found  => $vnum,
    };
}

my $cpanfile;
# Required modules
foreach my $module (@{ REQUIRED_MODULES() }) {
    my $current = _check_vers($module);
    my $requires = "requires '" . $current->{module} . "'";
    $requires .= ", '" . ($current->{ok} ? $current->{found} : $current->{wanted}) . "'";
    $requires .= ";\n";
    $cpanfile .= $requires;
}

# Recommended modules
$cpanfile .= "\n# Optional\n";
my %features;
foreach my $module (@{ OPTIONAL_MODULES() }) {
    next if $module->{package} eq 'mod_perl'; # Skip mod_perl since this would be installed by distro
    my $current = _check_vers($module);
    if (exists $module->{feature}) {
        foreach my $feature (@{ $module->{feature} }) {
            # cpanm requires that each feature only be defined in the cpanfile
            # once, so we use an intermediate hash to consolidate/de-dupe the
            # modules associated with each feature.
            $features{$feature}{$module->{module}}
              = ($current->{ok} ? $current->{found} : $current->{wanted});
        }
    }
    else {
        my $recommends = "";
        $recommends .= "recommends '" . $module->{module} . "'";
        $recommends .= ", '" . ($current->{ok} ? $current->{found} : $current->{wanted}) . "'";
        $recommends .= ";\n";
        $cpanfile .= $recommends;
    }
}

foreach my $feature (sort keys %features) {
    my $recommends = "";
    $recommends .= "feature '" . $feature . "' => sub {\n";
    foreach my $module (sort keys %{ $features{$feature} }) {
        my $version = $features{$feature}{$module};
        $recommends .= "  recommends '" . $module . "'";
        $recommends .= ", '$version'" if $version;
        $recommends .= ";\n";
    }
    $recommends .= "};\n";
    $cpanfile .= $recommends;
}

# Database modules
$cpanfile .= "\n# Database support\n";
foreach my $db (keys %{ DB_MODULE() }) {
    next if !exists DB_MODULE->{$db}->{dbd};
    my $dbd = DB_MODULE->{$db}->{dbd};
    my $current = _check_vers($dbd);
    my $recommends .= "feature '$db' => sub {\n";
    $recommends .= "  recommends '" . $dbd->{module} . "'";
    $recommends .= ", '" . ($current->{ok} ? $current->{found} : $current->{wanted}) . "'";
    $recommends .= ";\n};\n";
    $cpanfile .= $recommends;
}

# Write out the cpanfile to STDOUT
print $cpanfile . "\n";