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