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
127
128
129
130
|
#!/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 lib qw(. lib local/lib/perl5);
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";
|
