diff options
Diffstat (limited to 'Bugzilla/Install/Requirements.pm')
| -rw-r--r-- | Bugzilla/Install/Requirements.pm | 990 |
1 files changed, 767 insertions, 223 deletions
diff --git a/Bugzilla/Install/Requirements.pm b/Bugzilla/Install/Requirements.pm index 43c441d6b..27549ca41 100644 --- a/Bugzilla/Install/Requirements.pm +++ b/Bugzilla/Install/Requirements.pm @@ -1,9 +1,19 @@ -# 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/. +# -*- Mode: perl; indent-tabs-mode: nil -*- # -# This Source Code Form is "Incompatible With Secondary Licenses", as -# defined by the Mozilla Public License, v. 2.0. +# The contents of this file are subject to the Mozilla Public +# License Version 1.1 (the "License"); you may not use this file +# except in compliance with the License. You may obtain a copy of +# the License at http://www.mozilla.org/MPL/ +# +# Software distributed under the License is distributed on an "AS +# IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or +# implied. See the License for the specific language governing +# rights and limitations under the License. +# +# The Original Code is the Bugzilla Bug Tracking System. +# +# Contributor(s): Max Kanat-Alexander <mkanat@bugzilla.org> +# Marc Schumann <wurblzap@gmail.com> package Bugzilla::Install::Requirements; @@ -13,37 +23,38 @@ package Bugzilla::Install::Requirements; # Subroutines may "require" and "import" from modules, but they # MUST NOT "use." -use 5.10.1; use strict; -use warnings; +use version; use Bugzilla::Constants; -use Bugzilla::Install::Util qw(install_string bin_loc success - extension_requirement_packages); +use Bugzilla::Install::Util qw(vers_cmp install_string bin_loc + success extension_requirement_packages); use List::Util qw(max); +use Safe; use Term::ANSIColor; -use CPAN::Meta; -use CPAN::Meta::Prereqs; -use CPAN::Meta::Requirements; -use Module::Metadata; -use parent qw(Exporter); -use autodie; +# Return::Value 1.666002 pollutes the error log with warnings about this +# deprecated module. We have to set NO_CLUCK = 1 before loading Email::Send +# in have_vers() to disable these warnings. +BEGIN { + $Return::Value::NO_CLUCK = 1; +} +use base qw(Exporter); +use autodie; our @EXPORT = qw( + REQUIRED_MODULES + OPTIONAL_MODULES FEATURE_FILES - load_cpan_meta - check_cpan_requirements - check_cpan_feature - check_all_cpan_features - check_webdotbase - check_font_file + check_requirements + check_graphviz + export_cpanfile + have_vers + install_command map_files_to_features ); -our $checking_for_indent = 0; - # This is how many *'s are in the top of each "box" message printed # by checksetup.pl. use constant TABLE_WIDTH => 71; @@ -53,12 +64,10 @@ use constant TABLE_WIDTH => 71; # # The keys are the names of the modules, the values are what the module # is called in the output of "apachectl -t -D DUMP_MODULES". -use constant APACHE_MODULES => { +use constant APACHE_MODULES => { mod_headers => 'headers_module', mod_env => 'env_module', mod_expires => 'expires_module', - mod_rewrite => 'rewrite_module', - mod_version => 'version_module' }; # These are all of the binaries that we could possibly use that can @@ -72,131 +81,471 @@ use constant APACHE => qw(apachectl httpd apache2 apache); # If we don't find any of the above binaries in the normal PATH, # these are extra places we look. use constant APACHE_PATH => [qw( - /usr/sbin + /usr/sbin /usr/local/sbin /usr/libexec /usr/local/libexec )]; +# The below two constants are subroutines so that they can implement +# a hook. Other than that they are actually constants. + +# "package" is the perl package we're checking for. "module" is the name +# of the actual module we load with "require" to see if the package is +# installed or not. "version" is the version we need, or 0 if we'll accept +# any version. +# +# "blacklist" is an arrayref of regular expressions that describe versions that +# are 'blacklisted'--that is, even if the version is high enough, Bugzilla +# will refuse to say that it's OK to run with that version. +sub REQUIRED_MODULES { + my $perl_ver = sprintf('%vd', $^V); + my @modules = ( + { + package => 'CGI.pm', + module => 'CGI', + # 3.51 fixes a security problem that affects Bugzilla. + # (bug 591165) + version => '3.51', + }, + { + package => 'Digest-SHA', + module => 'Digest::SHA', + version => 0 + }, + { + package => 'TimeDate', + module => 'Date::Format', + version => '2.21' + }, + # 0.28 fixed some important bugs in DateTime. + { + package => 'DateTime', + module => 'DateTime', + version => '0.28' + }, + # 0.79 is required to work on Windows Vista and Windows Server 2008. + # As correctly detecting the flavor of Windows is not easy, + # we require this version for all Windows installations. + # 0.71 fixes a major bug affecting all platforms. + { + package => 'DateTime-TimeZone', + module => 'DateTime::TimeZone', + version => ON_WINDOWS ? '0.79' : '0.71' + }, + { + package => 'DBI', + module => 'DBI', + version => (vers_cmp($perl_ver, '5.13.3') > -1) ? '1.614' : '1.41' + }, + # 2.22 fixes various problems related to UTF8 strings in hash keys, + # as well as line endings on Windows. + { + package => 'Template-Toolkit', + module => 'Template', + version => '2.22' + }, + { + package => 'Email-Send', + module => 'Email::Send', + version => ON_WINDOWS ? '2.16' : '2.00', + blacklist => ['^2\.196$'] + }, + { + package => 'Email-MIME', + module => 'Email::MIME', + # This fixes a memory leak in walk_parts that affected jobqueue.pl. + version => '1.904' + }, + { + package => 'URI', + module => 'URI', + # This version properly handles a semicolon as the delimiter + # in a URL query string. + version => '1.37', + }, + { + package => 'List-MoreUtils', + module => 'List::MoreUtils', + version => 0.22, + }, + { + package => 'Math-Random-ISAAC', + module => 'Math::Random::ISAAC', + version => '1.0.1', + }, + ); + + if (ON_WINDOWS) { + push(@modules, { + package => 'Win32', + module => 'Win32', + # 0.35 fixes a memory leak in GetOSVersion, which we use. + version => 0.35, + }, + { + package => 'Win32-API', + module => 'Win32::API', + # 0.55 fixes a bug with char* that might affect Bugzilla::RNG. + version => '0.55', + }); + } + + my $extra_modules = _get_extension_requirements('REQUIRED_MODULES'); + push(@modules, @$extra_modules); + return \@modules; +}; + +sub OPTIONAL_MODULES { + my $perl_ver = sprintf('%vd', $^V); + my @modules = ( + { + package => 'GD', + module => 'GD', + version => '1.20', + feature => [qw(graphical_reports new_charts old_charts)], + }, + { + package => 'Chart', + module => 'Chart::Lines', + # Versions below 2.1 cannot be detected accurately. + # There is no 2.1.0 release (it was 2.1), but .0 is required to fix + # https://rt.cpan.org/Public/Bug/Display.html?id=28218. + version => '2.1.0', + feature => [qw(new_charts old_charts)], + }, + { + package => 'Template-GD', + # This module tells us whether or not Template-GD is installed + # on Template-Toolkits after 2.14, and still works with 2.14 and lower. + module => 'Template::Plugin::GD::Image', + version => 0, + feature => ['graphical_reports'], + }, + { + package => 'GDTextUtil', + module => 'GD::Text', + version => 0, + feature => ['graphical_reports'], + }, + { + package => 'GDGraph', + module => 'GD::Graph', + version => 0, + feature => ['graphical_reports'], + }, + { + package => 'MIME-tools', + # MIME::Parser is packaged as MIME::Tools on ActiveState Perl + module => ON_WINDOWS ? 'MIME::Tools' : 'MIME::Parser', + version => '5.406', + feature => ['moving'], + }, + { + package => 'libwww-perl', + module => 'LWP::UserAgent', + version => 0, + feature => ['updates'], + }, + { + package => 'XML-Twig', + module => 'XML::Twig', + version => 0, + feature => ['moving', 'updates'], + }, + { + package => 'PatchReader', + module => 'PatchReader', + # 0.9.6 fixes two notable bugs and significantly improves the UX. + version => '0.9.6', + feature => ['patch_viewer'], + }, + { + package => 'perl-ldap', + module => 'Net::LDAP', + version => 0, + feature => ['auth_ldap'], + }, + { + package => 'Authen-SASL', + module => 'Authen::SASL', + version => 0, + feature => ['smtp_auth'], + }, + { + package => 'RadiusPerl', + module => 'Authen::Radius', + version => 0, + feature => ['auth_radius'], + }, + { + package => 'SOAP-Lite', + module => 'SOAP::Lite', + # Fixes various bugs, including 542931 and 552353 + stops + # throwing warnings with Perl 5.12. + version => '0.712', + feature => ['xmlrpc'], + }, + { + package => 'JSON-RPC', + module => 'JSON::RPC', + version => 0, + feature => ['jsonrpc', 'rest'], + }, + { + package => 'JSON-XS', + module => 'JSON::XS', + # 2.0 is the first version that will work with JSON::RPC. + version => '2.0', + feature => ['jsonrpc_faster'], + }, + { + package => 'Test-Taint', + module => 'Test::Taint', + version => 0, + feature => ['jsonrpc', 'xmlrpc', 'rest'], + }, + { + # We need the 'utf8_mode' method of HTML::Parser, for HTML::Scrubber. + package => 'HTML-Parser', + module => 'HTML::Parser', + version => (vers_cmp($perl_ver, '5.13.3') > -1) ? '3.67' : '3.40', + feature => ['html_desc'], + }, + { + package => 'HTML-Scrubber', + module => 'HTML::Scrubber', + version => 0, + feature => ['html_desc'], + }, + { + # we need version 2.21 of Encode for mime_name + package => 'Encode', + module => 'Encode', + version => 2.21, + feature => ['detect_charset'], + }, + { + package => 'Encode-Detect', + module => 'Encode::Detect', + version => 0, + feature => ['detect_charset'], + }, + + # S3 attachments + { + package => 'Class-Accessor-Fast', + module => 'Class::Accessor::Fast', + version => 0, + feature => ['s3'], + }, + { + package => 'XML-Simple', + module => 'XML::Simple', + version => 0, + feature => ['s3'], + }, + + # Inbound Email + { + package => 'Email-MIME-Attachment-Stripper', + module => 'Email::MIME::Attachment::Stripper', + version => 0, + feature => ['inbound_email'], + }, + { + package => 'Email-Reply', + module => 'Email::Reply', + version => 0, + feature => ['inbound_email'], + }, + + # Mail Queueing + { + package => 'TheSchwartz', + module => 'TheSchwartz', + # 1.10 supports declining of jobs. + version => 1.10, + feature => ['jobqueue'], + }, + { + package => 'Daemon-Generic', + module => 'Daemon::Generic', + version => 0, + feature => ['jobqueue'], + }, + + # mod_perl + { + package => 'mod_perl', + module => 'mod_perl2', + version => '1.999022', + feature => ['mod_perl'], + }, + { + package => 'Apache-SizeLimit', + module => 'Apache2::SizeLimit', + # 0.96 properly determines process size on Linux. + version => '0.96', + feature => ['mod_perl'], + }, + + # memcached + { + package => 'URI-Escape', + module => 'URI::Escape', + version => 0, + feature => ['memcached', 's3'], + }, + { + package => 'Cache-Memcached', + module => 'Cache::Memcached', + version => '0', + feature => ['memcached'], + }, + + # BMO - metrics + { + package => 'ElasticSearch', + module => 'ElasticSearch', + version => '0', + feature => ['elasticsearch'], + }, + + # multi factor auth - totp + { + package => 'Auth-GoogleAuth', + module => 'Auth::GoogleAuth', + version => '1.01', + feature => ['mfa'], + }, + { + package => 'GD-Barcode-QRcode', + module => 'GD::Barcode::QRcode', + version => '0', + feature => ['mfa'], + }, + # Documentation + { + package => 'File-Copy-Recursive', + module => 'File::Copy::Recursive', + version => 0, + feature => ['documentation'], + } + ); + + my $extra_modules = _get_extension_requirements('OPTIONAL_MODULES'); + push(@modules, @$extra_modules); + return \@modules; +}; + # This maps features to the files that require that feature in order # to compile. It is used by t/001compile.t and mod_perl.pl. use constant FEATURE_FILES => ( jsonrpc => ['Bugzilla/WebService/Server/JSONRPC.pm', 'jsonrpc.cgi'], xmlrpc => ['Bugzilla/WebService/Server/XMLRPC.pm', 'xmlrpc.cgi', 'Bugzilla/WebService.pm', 'Bugzilla/WebService/*.pm'], - rest => ['Bugzilla/API/Server.pm', 'rest.cgi', 'Bugzilla/API/*/*.pm', - 'Bugzilla/API/*/Server.pm', 'Bugzilla/API/*/Resource/*.pm'], - psgi => ['app.psgi'], + rest => ['Bugzilla/WebService/Server/REST.pm', 'rest.cgi'], moving => ['importxml.pl'], auth_ldap => ['Bugzilla/Auth/Verify/LDAP.pm'], auth_radius => ['Bugzilla/Auth/Verify/RADIUS.pm'], - documentation => ['docs/makedocs.pl'], inbound_email => ['email_in.pl'], jobqueue => ['Bugzilla/Job/*', 'Bugzilla/JobQueue.pm', 'Bugzilla/JobQueue/*', 'jobqueue.pl'], patch_viewer => ['Bugzilla/Attachment/PatchReader.pm'], updates => ['Bugzilla/Update.pm'], - mfa => ['Bugzilla/MFA/*.pm'], - markdown => ['Bugzilla/Markdown.pm'], memcached => ['Bugzilla/Memcache.pm'], - auth_delegation => ['auth.cgi'], + mfa => ['Bugzilla/MFA/*.pm'], ); -sub load_cpan_meta { - my $dir = bz_locations()->{libpath}; - my @meta_json = map { File::Spec->catfile($dir, $_) } qw( MYMETA.json META.json ); - my ($file) = grep { -f $_ } @meta_json; - - if ($file) { - open my $meta_fh, '<', $file or die "unable to open $file: $!"; - my $str = do { local $/ = undef; scalar <$meta_fh> }; - # detaint - $str =~ /^(.+)$/s; $str = $1; - close $meta_fh; - - return CPAN::Meta->load_json_string($str); - } - else { - ThrowCodeError('cpan_meta_missing'); +# This implements the REQUIRED_MODULES and OPTIONAL_MODULES stuff +# described in in Bugzilla::Extension. +sub _get_extension_requirements { + my ($function) = @_; + + my $packages = extension_requirement_packages(); + my @modules; + foreach my $package (@$packages) { + if ($package->can($function)) { + my $extra_modules = $package->$function; + push(@modules, @$extra_modules); + } } -} - -sub check_all_cpan_features { - my ($meta, $dirs, $output) = @_; - my %report; + return \@modules; +}; - local $checking_for_indent = 2; +sub check_requirements { + my ($output) = @_; - print "\nOptional features:\n" if $output; - my @features = sort { $a->identifier cmp $b->identifier } $meta->features; - foreach my $feature (@features) { - next if $feature->identifier eq 'features'; - printf "Feature '%s': %s\n", $feature->identifier, $feature->description if $output; - my $result = check_cpan_feature($feature, $dirs, $output); - print "\n" if $output; + print "\n", install_string('checking_modules'), "\n" if $output; + my $root = ROOT_USER; + my $missing = _check_missing(REQUIRED_MODULES, $output); - $report{$feature->identifier} = { - description => $feature->description, - result => $result, - }; + print "\n", install_string('checking_dbd'), "\n" if $output; + my $have_one_dbd = 0; + my $db_modules = DB_MODULE; + foreach my $db (keys %$db_modules) { + my $dbd = $db_modules->{$db}->{dbd}; + $have_one_dbd = 1 if have_vers($dbd, $output); } - return \%report; -} - -sub check_cpan_feature { - my ($feature, $dirs, $output) = @_; + print "\n", install_string('checking_optional'), "\n" if $output; + my $missing_optional = _check_missing(OPTIONAL_MODULES, $output); - return _check_prereqs($feature->prereqs, $dirs, $output); -} + my $missing_apache = _missing_apache_modules(APACHE_MODULES, $output); -sub check_cpan_requirements { - my ($meta, $dirs, $output) = @_; + # If we're running on Windows, reset the input line terminator so that + # console input works properly - loading CGI tends to mess it up + $/ = "\015\012" if ON_WINDOWS; - my $result = _check_prereqs($meta->effective_prereqs, $dirs, $output); - print colored(install_string('installation_failed'), COLOR_ERROR), "\n" if !$result->{ok} && $output; - return $result; + my $pass = !scalar(@$missing) && $have_one_dbd; + return { + pass => $pass, + one_dbd => $have_one_dbd, + missing => $missing, + optional => $missing_optional, + apache => $missing_apache, + any_missing => !$pass || scalar(@$missing_optional), + }; } -sub _check_prereqs { - my ($prereqs, $dirs, $output) = @_; - $dirs //= \@INC; - my $reqs = $prereqs->merged_requirements(['configure', 'runtime'], ['requires']); - my @found; - my @missing; +# A helper for check_requirements +sub _check_missing { + my ($modules, $output) = @_; - foreach my $module (sort $reqs->required_modules) { - my $ok = _check_module($reqs, $module, $dirs, $output); - if ($ok) { - push @found, $module; - } - else { - push @missing, $module; + my @missing; + foreach my $module (@$modules) { + unless (have_vers($module, $output)) { + push(@missing, $module); } } - return { ok => (@missing == 0), found => \@found, missing => \@missing }; + return \@missing; } -sub _check_module { - my ($reqs, $module, $dirs, $output) = @_; - my $required_version = $reqs->requirements_for_module($module); - - if ($module eq 'perl') { - my $ok = $reqs->accepts_module($module, $]); - _checking_for({package => "perl", found => $], wanted => $required_version, ok => $ok}) if $output; - return $ok; - } else { - my $metadata = Module::Metadata->new_from_module($module, inc => $dirs); - my $version = eval { $metadata->version }; - my $ok = $metadata && $version && $reqs->accepts_module($module, $version || 0); - _checking_for({package => $module, $version ? ( found => $version ) : (), wanted => $required_version, ok => $ok}) if $output; - - return $ok; +sub _missing_apache_modules { + my ($modules, $output) = @_; + my $apachectl = _get_apachectl(); + return [] if !$apachectl; + my $command = "$apachectl -t -D DUMP_MODULES"; + my $cmd_info = `$command 2>&1`; + # If apachectl returned a value greater than 0, then there was an + # error parsing Apache's configuration, and we can't check modules. + my $retval = $?; + if ($retval > 0) { + print STDERR install_string('apachectl_failed', + { command => $command, root => ROOT_USER }), "\n"; + return []; + } + my @missing; + foreach my $module (keys %$modules) { + my $ok = _check_apache_module($module, $modules->{$module}, + $cmd_info, $output); + push(@missing, $module) if !$ok; } + return \@missing; } - sub _get_apachectl { foreach my $bin_name (APACHE) { my $bin = bin_loc($bin_name); @@ -210,10 +559,125 @@ sub _get_apachectl { return undef; } -sub check_webdotbase { +sub _check_apache_module { + my ($module, $config_name, $mod_info, $output) = @_; + my $ok; + if ($mod_info =~ /^\s+\Q$config_name\E\b/m) { + $ok = 1; + } + if ($output) { + _checking_for({ package => $module, ok => $ok }); + } + return $ok; +} + +sub print_module_instructions { + my ($check_results, $output) = @_; + + # First we print the long explanatory messages. + + if (scalar @{$check_results->{missing}}) { + print install_string('modules_message_required'); + } + + if (!$check_results->{one_dbd}) { + print install_string('modules_message_db'); + } + + if (my @missing = @{$check_results->{optional}} and $output) { + print install_string('modules_message_optional'); + # Now we have to determine how large the table cols will be. + my $longest_name = max(map(length($_->{package}), @missing)); + + # The first column header is at least 11 characters long. + $longest_name = 11 if $longest_name < 11; + + # The table is TABLE_WIDTH characters long. There are seven mandatory + # characters (* and space) in the string. So, we have a total + # of TABLE_WIDTH - 7 characters to work with. + my $remaining_space = (TABLE_WIDTH - 7) - $longest_name; + print '*' x TABLE_WIDTH . "\n"; + printf "* \%${longest_name}s * %-${remaining_space}s *\n", + 'MODULE NAME', 'ENABLES FEATURE(S)'; + print '*' x TABLE_WIDTH . "\n"; + foreach my $package (@missing) { + printf "* \%${longest_name}s * %-${remaining_space}s *\n", + $package->{package}, + _translate_feature($package->{feature}); + } + } + + if (my @missing = @{ $check_results->{apache} }) { + print install_string('modules_message_apache'); + my $missing_string = join(', ', @missing); + my $size = TABLE_WIDTH - 7; + printf "* \%-${size}s *\n", $missing_string; + my $spaces = TABLE_WIDTH - 2; + print "*", (' ' x $spaces), "*\n"; + } + + my $need_module_instructions = + ( (!$output and @{$check_results->{missing}}) + or ($output and $check_results->{any_missing}) ) ? 1 : 0; + + if ($need_module_instructions or @{ $check_results->{apache} }) { + # If any output was required, we want to close the "table" + print "*" x TABLE_WIDTH . "\n"; + } + + # And now we print the actual installation commands. + + if (my @missing = @{$check_results->{optional}} and $output) { + print install_string('commands_optional') . "\n\n"; + foreach my $module (@missing) { + my $command = install_command($module); + printf "%15s: $command\n", $module->{package}; + } + print "\n"; + } + + if (!$check_results->{one_dbd}) { + print install_string('commands_dbd') . "\n"; + my %db_modules = %{DB_MODULE()}; + foreach my $db (keys %db_modules) { + my $command = install_command($db_modules{$db}->{dbd}); + printf "%10s: \%s\n", $db_modules{$db}->{name}, $command; + } + print "\n"; + } + + if (my @missing = @{$check_results->{missing}}) { + print colored(install_string('commands_required'), COLOR_ERROR), "\n"; + foreach my $package (@missing) { + my $command = install_command($package); + print " $command\n"; + } + } + + if ($output && $check_results->{any_missing} && !ON_ACTIVESTATE + && !$check_results->{hide_all}) + { + print install_string('install_all', { perl => $^X }); + } + if (!$check_results->{pass}) { + print colored(install_string('installation_failed'), COLOR_ERROR), + "\n\n"; + } +} + +sub _translate_feature { + my $features = shift; + my @strings; + foreach my $feature (@$features) { + push(@strings, install_string("feature_$feature")); + } + return join(', ', @strings); +} + +sub check_graphviz { my ($output) = @_; - my $webdotbase = Bugzilla->localconfig->{'webdotbase'}; + my $webdotbase = Bugzilla->params->{'webdotbase'}; return 1 if $webdotbase =~ /^https?:/; my $return; @@ -230,9 +694,9 @@ sub check_webdotbase { my $webdotdir = bz_locations()->{'webdotdir'}; # Check .htaccess allows access to generated images if (-e "$webdotdir/.htaccess") { - my $htaccess = new IO::File("$webdotdir/.htaccess", 'r') + my $htaccess = new IO::File("$webdotdir/.htaccess", 'r') || die "$webdotdir/.htaccess: " . $!; - if (!grep(/ \\\.png\$/, $htaccess->getlines)) { + if (!grep(/png/, $htaccess->getlines)) { print STDERR install_string('webdot_bad_htaccess', { dir => $webdotdir }), "\n"; } @@ -242,40 +706,68 @@ sub check_webdotbase { return $return; } -sub check_font_file { - my ($output) = @_; - - my $font_file = Bugzilla->localconfig->{'font_file'}; - - my $readable; - $readable = 1 if -r $font_file; - - my $ttf; - $ttf = 1 if $font_file =~ /\.(ttf|otf)$/; - - if ($output) { - _checking_for({ package => 'Font file', ok => $readable && $ttf}); +# This was originally clipped from the libnet Makefile.PL, adapted here for +# accurate version checking. +sub have_vers { + my ($params, $output) = @_; + my $module = $params->{module}; + my $package = $params->{package}; + if (!$package) { + $package = $module; + $package =~ s/::/-/g; } - - if (!$readable) { - print install_string('bad_font_file', { file => $font_file }), "\n"; + 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; + } } - elsif (!$ttf) { - print install_string('bad_font_file_name', { file => $font_file }), "\n"; + $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; + my $blacklisted; + if ($vok && $params->{blacklist}) { + $blacklisted = grep($vnum =~ /$_/, @{$params->{blacklist}}); + $vok = 0 if $blacklisted; } - return $readable && $ttf; + if ($output) { + _checking_for({ + package => $package, ok => $vok, wanted => $wanted, + found => $vnum, blacklisted => $blacklisted + }); + } + + return $vok ? 1 : 0; } sub _checking_for { my ($params) = @_; - my ($package, $ok, $wanted, $blacklisted, $found) = + my ($package, $ok, $wanted, $blacklisted, $found) = @$params{qw(package ok wanted blacklisted found)}; my $ok_string = $ok ? install_string('module_ok') : ''; # If we're actually checking versions (like for Perl modules), then - # we have some rather complex logic to determine what we want to + # we have some rather complex logic to determine what we want to # show. If we're not checking versions (like for GraphViz) we just # show "ok" or "not found". if (exists $params->{found}) { @@ -298,14 +790,30 @@ sub _checking_for { } my $black_string = $blacklisted ? install_string('blacklisted') : ''; - my $want_string = $wanted ? "$wanted" : install_string('any'); + my $want_string = $wanted ? "v$wanted" : install_string('any'); my $str = sprintf "%s %20s %-11s $ok_string $black_string\n", - ( ' ' x $checking_for_indent ) . install_string('checking_for'), - $package, "($want_string)"; + install_string('checking_for'), $package, "($want_string)"; print $ok ? $str : colored($str, COLOR_ERROR); } +sub install_command { + my $module = shift; + my ($command, $package); + + if (ON_ACTIVESTATE) { + $command = 'ppm install %s'; + $package = $module->{package}; + } + else { + $command = 'cpanm %s'; + # Non-Windows installations need to use module names, because + # CPAN doesn't understand package names. + $package = $module->{module}; + } + return sprintf $command, $package; +} + # This does a reverse mapping for FEATURE_FILES. sub map_files_to_features { my %features = FEATURE_FILES; @@ -321,6 +829,68 @@ sub map_files_to_features { return \%files; } +sub export_cpanfile { + my $cpanfile; + # Required modules + foreach my $module (@{ REQUIRED_MODULES() }) { + my $requires = "requires '" . $module->{module} . "'"; + $requires .= ", '" . $module->{version} . "'" if $module->{version}; + $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 + 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}} = $module->{version}; + } + } + else { + my $recommends = ""; + $recommends .= "recommends '" . $module->{module} . "'"; + $recommends .= ", '" . $module->{version} . "'" if $module->{version}; + $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 $recommends .= "feature '$db' => sub {\n"; + $recommends .= " recommends '" . $dbd->{module} . "'"; + $recommends .= ", '" . $dbd->{version} . "'" if $dbd->{version}; + $recommends .= ";\n};\n"; + $cpanfile .= $recommends; + } + + # Write out the cpanfile to the document root + my $file = bz_locations()->{'libpath'} . '/cpanfile'; + open(my $fh, '>', $file); + print $fh $cpanfile; + close $fh; + success(install_string('cpanfile_created', { file => $file })); +} + 1; __END__ @@ -340,73 +910,59 @@ perl modules it requires.) =over -=item C<FEATURE_FILES> +=item C<REQUIRED_MODULES> -A hashref that describes what files should only be compiled if a certain -feature is enabled. The feature is the key, and the values are arrayrefs -of file names (which are passed to C<glob>, so shell patterns work). - -=back - -=head1 SUBROUTINES - -=over 4 - -=item C<check_cpan_requirements> +An arrayref of hashrefs that describes the perl modules required by +Bugzilla. The hashes have three keys: =over -=item B<Description> +=item C<package> - The name of the Perl package that you'd find on +CPAN for this requirement. -This checks what required perl modules are installed, like -C<checksetup.pl> does. +=item C<module> - The name of a module that can be passed to the +C<install> command in C<CPAN.pm> to install this module. -=item B<Params> - -=over - -=item C<$meta> - A C<CPAN::Meta> object. - -=item C<$dirs> - the include dirs to search for modules, defaults to @INC. - -=item C<$output> - C<true> if you want the function to print out information -about what it's doing, and the versions of everything installed. +=item C<version> - The version of this module that we require, or C<0> +if any version is acceptable. =back -=item B<Returns> +=item C<OPTIONAL_MODULES> -A hashref containing these values: +An arrayref of hashrefs that describes the perl modules that add +additional features to Bugzilla if installed. Its hashes have all +the fields of L</REQUIRED_MODULES>, plus a C<feature> item--an arrayref +of strings that describe what features require this module. -=over +=item C<FEATURE_FILES> -=item C<ok> - if all the requirements are met, this is true. +A hashref that describes what files should only be compiled if a certain +feature is enabled. The feature is the key, and the values are arrayrefs +of file names (which are passed to C<glob>, so shell patterns work). -=item C<found> - an arrayref of found modules +=back -=item C<missing> - an arrayref of missing modules -=back +=head1 SUBROUTINES -=back +=over 4 -=item C<check_cpan_feature> +=item C<check_requirements> =over =item B<Description> -This checks that the optional Perl modules required for a feature are installed. +This checks what optional or required perl modules are installed, like +C<checksetup.pl> does. =item B<Params> =over -=item C<$feature> - A C<CPAN::Meta::Feature> object. - -=item C<$dirs> - the include dirs to search for modules, defaults to @INC. - -=item C<$output> - C<true> if you want the function to print out information about what it's doing, and the versions of everything installed. +=item C<$output> - C<true> if you want the function to print out information +about what it's doing, and the versions of everything installed. =back @@ -416,50 +972,28 @@ A hashref containing these values: =over -=item C<ok> - if all the requirements are met, this is true. - -=item C<found> - an arrayref of found modules - -=item C<missing> - an arrayref of missing modules +=item C<pass> - Whether or not we have all the mandatory requirements. -=back +=item C<missing> - An arrayref containing any required modules that +are not installed or that are not up-to-date. Each item in the array is +a hashref in the format of items from L</REQUIRED_MODULES>. -=item C<check_all_cpan_features> +=item C<optional> - The same as C<missing>, but for optional modules. -=over +=item C<apache> - The name of each optional Apache module that is missing. -=item B<Description> - -This checks which optional Perl modules are currently installed which can enable optional features. - -=item B<Params> - -=over +=item C<have_one_dbd> - True if at least one C<DBD::> module is installed. -=item C<$meta> - A C<CPAN::Meta> object. - -=item C<$dirs> - the include dirs to search for modules, defaults to @INC. - -=item C<$output> - C<true> if you want the function to print out information -about what it's doing, and the versions of everything installed. +=item C<any_missing> - True if there are any missing Perl modules, even +optional modules. =back -=item B<Returns> - -A hashref keyed on the feature name. The values -are hashrefs containing C<description> and C<result> keys. - -C<description> is the English description of the feature. - -C<result> is a hashref in the same format as the return value of C<check_cpan_requirements()>, -described previously. - =back -=item C<check_webdotbase($output)> +=item C<check_graphviz($output)> -Description: Checks if the graphviz binary specified in the +Description: Checks if the graphviz binary specified in the C<webdotbase> parameter is a valid binary, or a valid URL. Params: C<$output> - C<$true> if you want the function to @@ -467,26 +1001,36 @@ Params: C<$output> - C<$true> if you want the function to Returns: C<1> if the check was successful, C<0> otherwise. -=item C<check_font_file($output)> +=item C<have_vers($module, $output)> -Description: Checks if the font file specified in the C<font_type> parameter - is a valid-looking font file. + Description: Tells you whether or not you have the appropriate + version of the module requested. It also prints + out a message to the user explaining the check + and the result. -Params: C<$output> - C<$true> if you want the function to - print out information about what it's doing. + Params: C<$module> - A hashref, in the format of an item from + L</REQUIRED_MODULES>. + C<$output> - Set to true if you want this function to + print information to STDOUT about what it's + doing. -Returns: C<1> if the check was successful, C<0> otherwise. + Returns: C<1> if you have the module installed and you have the + appropriate version. C<0> otherwise. -=item C<map_files_to_features> +=item C<install_command($module)> -Returns a hashref where file names are the keys and the value is the feature -that must be enabled in order to compile that file. + Description: Prints out the appropriate command to install the + module specified, depending on whether you're + on Windows or Linux. -=item C<load_cpan_meta> + Params: C<$module> - A hashref, in the format of an item from + L</REQUIRED_MODULES>. -Load MYMETA.json or META.json from the bugzilla directory, and a return a L<CPAN::Meta> object. + Returns: nothing -=back +=item C<map_files_to_features> -=back +Returns a hashref where file names are the keys and the value is the feature +that must be enabled in order to compile that file. +=back |