diff options
Diffstat (limited to 'Bugzilla/CPAN.pm')
| -rw-r--r-- | Bugzilla/CPAN.pm | 153 |
1 files changed, 78 insertions, 75 deletions
diff --git a/Bugzilla/CPAN.pm b/Bugzilla/CPAN.pm index 1b6fb93b9..96a7cee05 100644 --- a/Bugzilla/CPAN.pm +++ b/Bugzilla/CPAN.pm @@ -15,107 +15,110 @@ use Bugzilla::Constants qw(bz_locations); use Bugzilla::Install::Requirements qw(check_cpan_feature); BEGIN { - my $json_xs_ok = eval { - require JSON::XS; - require JSON; - JSON->VERSION("2.5"); - 1; - }; - if ($json_xs_ok) { - $ENV{PERL_JSON_BACKEND} = 'JSON::XS'; - } + my $json_xs_ok = eval { + require JSON::XS; + require JSON; + JSON->VERSION("2.5"); + 1; + }; + if ($json_xs_ok) { + $ENV{PERL_JSON_BACKEND} = 'JSON::XS'; + } } use constant _CAN_HAS_FEATURE => eval { - require CPAN::Meta::Prereqs; - require CPAN::Meta::Requirements; - require Module::Metadata; - require Module::Runtime; - CPAN::Meta::Prereqs->VERSION('2.132830'); - CPAN::Meta::Requirements->VERSION('2.121'); - Module::Metadata->VERSION('1.000019'); - 1; + require CPAN::Meta::Prereqs; + require CPAN::Meta::Requirements; + require Module::Metadata; + require Module::Runtime; + CPAN::Meta::Prereqs->VERSION('2.132830'); + CPAN::Meta::Requirements->VERSION('2.121'); + Module::Metadata->VERSION('1.000019'); + 1; }; my (%FEATURE, %FEATURE_LOADED); sub cpan_meta { - my ($class) = @_; - my $dir = bz_locations()->{libpath}; - my $file = File::Spec->catfile($dir, 'MYMETA.json'); - state $CPAN_META; - - return $CPAN_META if $CPAN_META; - - if (-f $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 = CPAN::Meta->load_json_string($str); - } - else { - require Bugzilla::Error; - Bugzilla::Error::ThrowCodeError('cpan_meta_missing'); - } + my ($class) = @_; + my $dir = bz_locations()->{libpath}; + my $file = File::Spec->catfile($dir, 'MYMETA.json'); + state $CPAN_META; + + return $CPAN_META if $CPAN_META; + + if (-f $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 = CPAN::Meta->load_json_string($str); + } + else { + require Bugzilla::Error; + Bugzilla::Error::ThrowCodeError('cpan_meta_missing'); + } } sub cpan_requirements { - my ($class, $prereqs) = @_; - if ($prereqs->can('merged_requirements')) { - return $prereqs->merged_requirements( [ 'configure', 'runtime' ], ['requires'] ); - } - else { - my $req = CPAN::Meta::Requirements->new; - $req->add_requirements( $prereqs->requirements_for('configure', 'requires') ); - $req->add_requirements( $prereqs->requirements_for('runtime', 'requires') ); - return $req; - } + my ($class, $prereqs) = @_; + if ($prereqs->can('merged_requirements')) { + return $prereqs->merged_requirements(['configure', 'runtime'], ['requires']); + } + else { + my $req = CPAN::Meta::Requirements->new; + $req->add_requirements($prereqs->requirements_for('configure', 'requires')); + $req->add_requirements($prereqs->requirements_for('runtime', 'requires')); + return $req; + } } sub has_feature { - my ($class, $feature_name) = @_; + my ($class, $feature_name) = @_; - return 0 unless _CAN_HAS_FEATURE; - return $FEATURE{$feature_name} if exists $FEATURE{ $feature_name }; + return 0 unless _CAN_HAS_FEATURE; + return $FEATURE{$feature_name} if exists $FEATURE{$feature_name}; - my $meta = $class->cpan_meta; - my $feature = eval { $meta->feature($feature_name) }; - unless ($feature) { - require Bugzilla::Error; - Bugzilla::Error::ThrowCodeError('invalid_feature', { feature => $feature_name }); - } + my $meta = $class->cpan_meta; + my $feature = eval { $meta->feature($feature_name) }; + unless ($feature) { + require Bugzilla::Error; + Bugzilla::Error::ThrowCodeError('invalid_feature', {feature => $feature_name}); + } - return $FEATURE{$feature_name} = check_cpan_feature($feature)->{ok}; + return $FEATURE{$feature_name} = check_cpan_feature($feature)->{ok}; } # Bugzilla expects this will also load all the modules.. so we have to do that. # Later we should put a deprecation warning here, and favor calling has_feature(). sub feature { - my ($class, $feature_name) = @_; - return 0 unless _CAN_HAS_FEATURE; - return 1 if $FEATURE_LOADED{$feature_name}; - return 0 unless $class->has_feature($feature_name); - - my $meta = $class->cpan_meta; - my $feature = $meta->feature($feature_name); - my @modules = $feature->prereqs->merged_requirements(['runtime'], ['requires'])->required_modules; - Module::Runtime::require_module($_) foreach grep { !/^Test::Taint$/ } @modules; - return $FEATURE_LOADED{$feature_name} = 1; + my ($class, $feature_name) = @_; + return 0 unless _CAN_HAS_FEATURE; + return 1 if $FEATURE_LOADED{$feature_name}; + return 0 unless $class->has_feature($feature_name); + + my $meta = $class->cpan_meta; + my $feature = $meta->feature($feature_name); + my @modules = $feature->prereqs->merged_requirements(['runtime'], ['requires']) + ->required_modules; + Module::Runtime::require_module($_) foreach grep { !/^Test::Taint$/ } @modules; + return $FEATURE_LOADED{$feature_name} = 1; } sub preload_features { - my ($class) = @_; - return 0 unless _CAN_HAS_FEATURE; - my $meta = $class->cpan_meta; - - foreach my $feature ($meta->features) { - next if $feature->identifier eq 'mod_perl'; - $class->feature($feature->identifier); - } + my ($class) = @_; + return 0 unless _CAN_HAS_FEATURE; + my $meta = $class->cpan_meta; + + foreach my $feature ($meta->features) { + next if $feature->identifier eq 'mod_perl'; + $class->feature($feature->identifier); + } } 1; |