perl
view release on metacpan or search on metacpan
cpan/CPAN/lib/App/Cpan.pm helper package for CPAN.pm
cpan/CPAN/lib/CPAN.pm Interface to Comprehensive Perl Archive Network
cpan/CPAN/lib/CPAN/API/HOWTO.pod recipe book for programming with CPAN.pm
cpan/CPAN/lib/CPAN/Author.pm helper package for CPAN.pm
cpan/CPAN/lib/CPAN/Bundle.pm helper package for CPAN.pm
cpan/CPAN/lib/CPAN/CacheMgr.pm helper package for CPAN.pm
cpan/CPAN/lib/CPAN/Complete.pm helper package for CPAN.pm
cpan/CPAN/lib/CPAN/Debug.pm helper package for CPAN.pm
cpan/CPAN/lib/CPAN/DeferredCode.pm helper package for CPAN.pm
cpan/CPAN/lib/CPAN/Distribution.pm helper package for CPAN.pm
cpan/CPAN/lib/CPAN/Distroprefs.pm helper package for CPAN.pm
cpan/CPAN/lib/CPAN/Distrostatus.pm helper package for CPAN.pm
cpan/CPAN/lib/CPAN/Exception/blocked_urllist.pm helper package for CPAN.pm
cpan/CPAN/lib/CPAN/Exception/RecursiveDependency.pm helper package for CPAN.pm
cpan/CPAN/lib/CPAN/Exception/yaml_not_installed.pm helper package for CPAN.pm
cpan/CPAN/lib/CPAN/Exception/yaml_process_error.pm helper package for CPAN.pm
cpan/CPAN/lib/CPAN/FirstTime.pm Utility for creating CPAN config files
cpan/CPAN/lib/CPAN/FTP.pm helper package for CPAN.pm
cpan/CPAN/lib/CPAN/FTP/netrc.pm helper package for CPAN.pm
cpan/CPAN/lib/CPAN/HandleConfig.pm helper package for CPAN.pm
cpan/CPAN/lib/CPAN/HTTP/Client.pm helper package for CPAN.pm
cpan/CPAN/lib/CPAN/HTTP/Credentials.pm helper package for CPAN.pm
cpan/CPAN/lib/CPAN/Index.pm helper package for CPAN.pm
cpan/CPAN/lib/CPAN/InfoObj.pm helper package for CPAN.pm
cpan/CPAN/lib/CPAN/Kwalify.pm helper package for CPAN.pm
cpan/CPAN/lib/CPAN/Kwalify/distroprefs.dd helper file for validating config files
cpan/CPAN/lib/CPAN/Kwalify/distroprefs.yml helper file for validating config files
cpan/CPAN/lib/CPAN/LWP/UserAgent.pm helper package for CPAN.pm
cpan/CPAN/lib/CPAN/Mirrors.pm helper package for CPAN.pm
cpan/CPAN/lib/CPAN/Module.pm helper package for CPAN.pm
cpan/CPAN/lib/CPAN/Nox.pm Runs CPAN while avoiding compiled extensions
cpan/CPAN/lib/CPAN/Plugin.pm Module related to CPAN
cpan/CPAN/lib/CPAN/Plugin/Specfile.pm Module related to CPAN
cpan/CPAN/lib/CPAN/Prompt.pm Module related to CPAN
cpan/CPAN/lib/CPAN/Queue.pm queueing system for CPAN.pm
cpan/CPAN/lib/CPAN/Shell.pm Module related to CPAN
cpan/CPAN/lib/CPAN/Tarzip.pm helper package for CPAN.pm
Porting/Maintainers.pl view on Meta::CPAN
eg/synopsis.pl
),
],
},
'CPAN' => {
'DISTRIBUTION' => 'ANDK/CPAN-2.38.tar.gz',
'SYNCINFO' => 'tib on Mon Nov 18 08:14:50 2024',
'FILES' => q[cpan/CPAN],
'EXCLUDED' => [
qr{^distroprefs/},
qr{^inc/Test/},
qr{^t/CPAN/},
qr{^t/data/},
qr{^t/97-},
qw( lib/CPAN/Admin.pm
scripts/cpan-mirrors
PAUSE2015.pub
PAUSE2019.pub
PAUSE2021.pub
SlayMakefile
t/00signature.t
t/04clean_load.t
t/12cpan.t
t/13tarzip.t
t/14forkbomb.t
t/30shell.coverage
t/30shell.t
t/31sessions.t
t/41distribution.t
t/42distroprefs.t
t/43distroprefspref.t
t/44cpanmeta.t
t/50pod.t
t/51pod.t
t/52podcover.t
t/60credentials.t
t/70_critic.t
t/71_minimumversion.t
t/local_utils.pm
t/perlcriticrc
t/yaml_code.yml
cpan/CPAN/lib/CPAN.pm view on Meta::CPAN
qq{because Digest::SHA not installed.\n});
} else {
$CPAN::Frontend->mywarn(qq{
CPAN: checksum security checks disabled because Digest::SHA not installed.
Please consider installing the Digest::SHA module.
});
$CPAN::Frontend->mysleep(2);
}
} elsif ($mod eq "Module::Signature") {
# NOT prefs_lookup, we are not a distro
my $check_sigs = $CPAN::Config->{check_sigs};
if (not $check_sigs) {
# they do not want us:-(
} elsif (not $Have_warned->{"Module::Signature"}++) {
# No point in complaining unless the user can
# reasonably install and use it.
if (eval { require Crypt::OpenPGP; 1 } ||
(
defined $CPAN::Config->{'gpg'}
&&
cpan/CPAN/lib/CPAN.pm view on Meta::CPAN
with both a Makefile.PL and a Build.PL, use the
former (EUMM) or the latter (MB); if the module
comes with only one of the two, that one will be
used no matter the setting
prerequisites_policy
what to do if you are missing module prerequisites
('follow' automatically, 'ask' me, or 'ignore')
For 'follow', also sets PERL_AUTOINSTALL and
PERL_EXTUTILS_AUTOINSTALL for "--defaultdeps" if
not already set
prefs_dir local directory to store per-distro build options
proxy_user username for accessing an authenticating proxy
proxy_pass password for accessing an authenticating proxy
pushy_https use https to cpan.org when possible, otherwise use http
to cpan.org and issue a warning
randomize_urllist add some randomness to the sequence of the urllist
recommends_policy whether recommended prerequisites should be included
scan_cache controls scanning of cache ('atstart', 'atexit' or 'never')
shell your favorite shell
show_unparsable_versions
boolean if r command tells which modules are versionless
cpan/CPAN/lib/CPAN.pm view on Meta::CPAN
C<allow_installing_outdated_dists> compares the C<blib/> directory with the CPAN index.
If it finds something there that belongs, according to the index, to a different
dist, it aborts the current build.
C<allow_installing_module_downgrades> compares the C<blib/> directory
with already installed modules, actually their version numbers, as
determined by ExtUtils::MakeMaker or equivalent. If a to-be-installed
module would downgrade an already installed module, the current build
is aborted.
An interesting twist occurs when a distroprefs document demands the
installation of an outdated dist via goto while
C<allow_installing_outdated_dists> forbids it. Without additional
provisions, this would let the C<allow_installing_outdated_dists>
win and the distroprefs lose. So the proper arrangement in such a case
is to write a second distroprefs document for the distro that C<goto>
points to and overrule the C<cpanconfig> there. E.g.:
---
match:
distribution: "^MAUKE/Keyword-Simple-0.04.tar.gz"
goto: "MAUKE/Keyword-Simple-0.03.tar.gz"
---
match:
distribution: "^MAUKE/Keyword-Simple-0.03.tar.gz"
cpanconfig:
allow_installing_outdated_dists: yes
=head2 Configuration for individual distributions (I<Distroprefs>)
(B<Note:> This feature has been introduced in CPAN.pm 1.8854)
Distributions on CPAN usually behave according to what we call the
CPAN mantra. Or since the advent of Module::Build we should talk about
two mantras:
perl Makefile.PL perl Build.PL
make ./Build
make test ./Build test
make install ./Build install
But some modules cannot be built with this mantra. They try to get
some extra data from the user via the environment, extra arguments, or
interactively--thus disturbing the installation of large bundles like
Phalanx100 or modules with many dependencies like Plagger.
The distroprefs system of C<CPAN.pm> addresses this problem by
allowing the user to specify extra informations and recipes in YAML
files to either
=over
=item
pass additional arguments to one of the four commands,
=item
cpan/CPAN/lib/CPAN.pm view on Meta::CPAN
specify dependencies the original maintainer forgot
=item
disable the installation of an object altogether
=back
See the YAML and Data::Dumper files that come with the C<CPAN.pm>
distribution in the C<distroprefs/> directory for examples.
=head2 Filenames
The YAML files themselves must have the C<.yml> extension; all other
files are ignored (for two exceptions see I<Fallback Data::Dumper and
Storable> below). The containing directory can be specified in
C<CPAN.pm> in the C<prefs_dir> config variable. Try C<o conf init
prefs_dir> in the CPAN shell to set and activate the distroprefs
system.
Every YAML file may contain arbitrary documents according to the YAML
specification, and every document is treated as an entity that
can specify the treatment of a single distribution.
Filenames can be picked arbitrarily; C<CPAN.pm> always reads
all files (in alphabetical order) and takes the key C<match> (see
below in I<Language Specs>) as a hashref containing match criteria
that determine if the current distribution matches the YAML document
or not.
=head2 Fallback Data::Dumper and Storable
If neither your configured C<yaml_module> nor YAML.pm is installed,
CPAN.pm falls back to using Data::Dumper and Storable and looks for
files with the extensions C<.dd> or C<.st> in the C<prefs_dir>
directory. These files are expected to contain one or more hashrefs.
For Data::Dumper generated files, this is expected to be done with by
defining C<$VAR1>, C<$VAR2>, etc. The YAML shell would produce these
with the command
ysh < somefile.yml > somefile.dd
For Storable files the rule is that they must be constructed such that
C<Storable::retrieve(file)> returns an array reference and the array
elements represent one distropref object each. The conversion from
cpan/CPAN/lib/CPAN.pm view on Meta::CPAN
distribution.
=item patches [array]
An array of patches on CPAN or on the local disk to be applied in
order via an external patch program. If the value for the C<-p>
parameter is C<0> or C<1> is determined by reading the patch
beforehand. The path to each patch is either an absolute path on the
local filesystem or relative to a patch directory specified in the
C<patches_dir> configuration variable or in the format of a canonical
distro name. For examples please consult the distroprefs/ directory in
the CPAN.pm distribution (these examples are not installed by
default).
Note: if the C<applypatch> program is installed and C<CPAN::Config>
knows about it B<and> a patch is written by the C<makepatch> program,
then C<CPAN.pm> lets C<applypatch> apply the patch. Both C<makepatch>
and C<applypatch> are available from CPAN in the C<JV/makepatch-*>
distribution.
=item pl [hash]
cpan/CPAN/lib/CPAN.pm view on Meta::CPAN
eexpect:
mode: deterministic
timeout: 15
talk: <array>
=back
=head2 Schema verification with C<Kwalify>
If you have the C<Kwalify> module installed (which is part of the
Bundle::CPANxxl), then all your distroprefs files are checked for
syntactic correctness.
=head2 Example Distroprefs Files
C<CPAN.pm> comes with a collection of example YAML files. Note that these
are really just examples and should not be used without care because
they cannot fit everybody's purpose. After all, the authors of the
packages that ask questions had a need to ask, so you should watch
their questions and adjust the examples to your environment and your
needs. You have been warned:-)
=head1 PROGRAMMER'S INTERFACE
cpan/CPAN/lib/CPAN.pm view on Meta::CPAN
=item CPAN::Distribution::perldoc()
Downloads the pod documentation of the file associated with a
distribution (in HTML format) and runs it through the external
command I<lynx> specified in C<< $CPAN::Config->{lynx} >>. If I<lynx>
isn't available, it converts it to plain text with the external
command I<html2text> and runs it through the pager specified
in C<< $CPAN::Config->{pager} >>.
=item CPAN::Distribution::prefs()
Returns the hash reference from the first matching YAML file that the
user has deposited in the C<prefs_dir/> directory. The first
succeeding match wins. The files in the C<prefs_dir/> are processed
alphabetically, and the canonical distro name (e.g.
AUTHOR/Foo-Bar-3.14.tar.gz) is matched against the regular expressions
stored in the $root->{match}{distribution} attribute value.
Additionally all module names contained in a distribution are matched
against the regular expressions in the $root->{match}{module} attribute
value. The two match values are ANDed together. Each of the two
attributes are optional.
=item CPAN::Distribution::prereq_pm()
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
# vim: ts=4 sts=4 sw=4:
package CPAN::Distribution;
use strict;
use Cwd qw(chdir);
use CPAN::Distroprefs;
use CPAN::InfoObj;
use File::Path ();
use POSIX ":sys_wait_h";
@CPAN::Distribution::ISA = qw(CPAN::InfoObj);
use vars qw($VERSION);
$VERSION = "2.34";
my $run_allow_installing_within_test = 1; # boolean; either in test or in install, there is no third option
# no prepare, because prepare is not a command on the shell command line
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
return undef; # no shortcut
}
#-> sub CPAN::Distribution::get ;
sub get {
my($self) = @_;
$self->pre_get();
$self->debug("checking goto id[$self->{ID}]") if $CPAN::DEBUG;
if (my $goto = $self->prefs->{goto}) {
$self->post_get();
return $self->goto($goto);
}
if ( defined( my $sc = $self->shortcut_get) ) {
$self->post_get();
return $sc;
}
local $ENV{PERL5LIB} = defined($ENV{PERL5LIB})
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
$CPAN::Frontend->mysleep(1);
my $mpldh = DirHandle->new($self->{build_dir})
or Carp::croak("Couldn't opendir $self->{build_dir}: $!");
$mpl_exists = grep /^Makefile\.PL$/, $mpldh->read;
$mpldh->close;
}
my $prefer_installer = "eumm"; # eumm|mb
if (-f File::Spec->catfile($self->{build_dir},"Build.PL")) {
if ($mpl_exists) { # they *can* choose
if ($CPAN::META->has_inst("Module::Build")) {
$prefer_installer = CPAN::HandleConfig->prefs_lookup(
$self, q{prefer_installer}
);
# M::B <= 0.35 left a DATA handle open that
# causes problems upgrading M::B on Windows
close *Module::Build::Version::DATA
if fileno *Module::Build::Version::DATA;
}
} else {
$prefer_installer = "mb";
}
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
return CPAN::FTP->localize("authors/id/$norm",
$local_wanted);
}
{
my $stdpatchargs = "";
#-> CPAN::Distribution::patch
sub patch {
my($self) = @_;
$self->debug("checking patches id[$self->{ID}]") if $CPAN::DEBUG;
my $patches = $self->prefs->{patches};
$patches ||= "";
$self->debug("patches[$patches]") if $CPAN::DEBUG;
if ($patches) {
return unless @$patches;
$self->safe_chdir($self->{build_dir});
CPAN->debug("patches[$patches]") if $CPAN::DEBUG;
my $patchbin = $CPAN::Config->{patch};
unless ($patchbin && length $patchbin) {
$CPAN::Frontend->mydie("No external patch command configured\n\n".
"Please run 'o conf init /patch/'\n\n");
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
EXE_FILES => ['$name'],
PREREQ_PM => {
$PREREQ_PM
},
";
}
#-> CPAN::Distribution::_signature_business
sub _signature_business {
my($self) = @_;
my $check_sigs = CPAN::HandleConfig->prefs_lookup($self,
q{check_sigs});
if ($check_sigs) {
if ($CPAN::META->has_inst("Module::Signature")) {
if (-f "SIGNATURE") {
$self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
my $rv = Module::Signature::verify();
if ($rv != Module::Signature::SIGNATURE_OK() and
$rv != Module::Signature::SIGNATURE_MISSING()) {
$CPAN::Frontend->mywarn(
qq{\nSignature invalid for }.
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
# sloppy is 1 when we have an old checksums file that maybe is good
# enough
sub CHECKSUM_check_file {
my($self,$chk_file,$sloppy) = @_;
my($cksum,$file,$basename);
$sloppy ||= 0;
$self->debug("chk_file[$chk_file]sloppy[$sloppy]") if $CPAN::DEBUG;
my $check_sigs = CPAN::HandleConfig->prefs_lookup($self,
q{check_sigs});
if ($check_sigs) {
if ($CPAN::META->has_inst("Module::Signature")) {
$self->debug("Module::Signature is installed, verifying") if $CPAN::DEBUG;
$self->SIG_check_file($chk_file);
} else {
$self->debug("Module::Signature is NOT installed") if $CPAN::DEBUG;
}
}
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
sub force {
my($self, $method,$fforce) = @_;
my %phase_map = (
get => [
"unwrapped",
"build_dir",
"archived",
"localfile",
"CHECKSUM_STATUS",
"signature_verify",
"prefs",
"prefs_file",
"prefs_file_doc",
"cleanup_after_install_done",
],
make => [
"writemakefile",
"make",
"modulebuild",
"prereq_pm",
"cleanup_after_install_done",
],
test => [
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
$CPAN::Frontend->myprint("Configuring ".$self->id." with $configurator\n");
if ($CPAN::Config->{prerequisites_policy} eq "follow") {
$ENV{PERL_AUTOINSTALL} ||= "--defaultdeps";
$ENV{PERL_EXTUTILS_AUTOINSTALL} ||= "--defaultdeps";
}
my $system;
my $pl_commandline;
if ($self->prefs->{pl}) {
$pl_commandline = $self->prefs->{pl}{commandline};
}
local $ENV{PERL} = defined $ENV{PERL}? $ENV{PERL} : $^X;
local $ENV{PERL5_CPAN_IS_EXECUTING} = $ENV{PERL5_CPAN_IS_EXECUTING} || '';
local $ENV{PERL_MM_USE_DEFAULT} = 1 if $CPAN::Config->{use_prompt_default};
local $ENV{NONINTERACTIVE_TESTING} = 1 if $CPAN::Config->{use_prompt_default};
if ($pl_commandline) {
$system = $pl_commandline;
$ENV{PERL} = $^X;
} elsif ($self->{'configure'}) {
$system = $self->{'configure'};
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
my $makepl_arg = $self->_make_phase_arg("pl");
$ENV{PERL5_CPAN_IS_EXECUTING} = File::Spec->catfile($self->{build_dir},
"Makefile.PL");
$system = sprintf("%s%s Makefile.PL%s",
$perl,
$switch ? " $switch" : "",
$makepl_arg ? " $makepl_arg" : "",
);
}
my $pl_env;
if ($self->prefs->{pl}) {
$pl_env = $self->prefs->{pl}{env};
}
local @ENV{keys %$pl_env} = values %$pl_env if $pl_env;
if (exists $self->{writemakefile}) {
} else {
local($SIG{ALRM}) = sub { die "inactivity_timeout reached\n" };
my($ret,$pid,$output);
$@ = "";
my $go_via_alarm;
if ($CPAN::Config->{inactivity_timeout}) {
require Config;
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
waitpid $pid, 0;
my $err = "$@";
$CPAN::Frontend->myprint($err);
$self->{writemakefile} = CPAN::Distrostatus->new("NO $err");
$@ = "";
$self->store_persistent_state;
return $self->goodbye("$system -- TIMED OUT");
}
}
} else {
if (my $expect_model = $self->_prefs_with_expect("pl")) {
# XXX probably want to check _should_report here and warn
# about not being able to use CPAN::Reporter with expect
$ret = $self->_run_via_expect($system,'writemakefile',$expect_model);
if (! defined $ret
&& $self->{writemakefile}
&& $self->{writemakefile}->failed) {
# timeout
return;
}
}
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
my($self) = @_;
$self->pre_make();
if (exists $self->{cleanup_after_install_done}) {
$self->post_make();
return $self->get;
}
$self->debug("checking goto id[$self->{ID}]") if $CPAN::DEBUG;
if (my $goto = $self->prefs->{goto}) {
$self->post_make();
return $self->goto($goto);
}
# Emergency brake if they said install Pippi and get newest perl
# XXX Would this make more sense in shortcut_prepare, since
# that doesn't make sense on a perl dist either? Broader
# question: what is the purpose of suggesting force install
# on a perl distribution? That seems unlikely to result in
# such a dependency being satisfied, even if the perl is
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
# need to chdir again, because $self->satisfy_requires might change the directory
unless (chdir $builddir) {
$CPAN::Frontend->mywarn("Couldn't chdir to '$builddir': $!");
$self->post_make();
return;
}
my $system;
my $make_commandline;
if ($self->prefs->{make}) {
$make_commandline = $self->prefs->{make}{commandline};
}
local $ENV{PERL} = defined $ENV{PERL}? $ENV{PERL} : $^X;
local $ENV{PERL_MM_USE_DEFAULT} = 1 if $CPAN::Config->{use_prompt_default};
local $ENV{NONINTERACTIVE_TESTING} = 1 if $CPAN::Config->{use_prompt_default};
if ($make_commandline) {
$system = $make_commandline;
$ENV{PERL} = CPAN::find_perl();
} else {
if ($self->{modulebuild}) {
unless (-f "Build" || ($^O eq 'VMS' && -f 'Build.com')) {
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
$system = join " ", $self->_make_command(), $CPAN::Config->{make_arg};
}
$system =~ s/\s+$//;
my $make_arg = $self->_make_phase_arg("make");
$system = sprintf("%s%s",
$system,
$make_arg ? " $make_arg" : "",
);
}
my $make_env;
if ($self->prefs->{make}) {
$make_env = $self->prefs->{make}{env};
}
local @ENV{keys %$make_env} = values %$make_env if $make_env;
my $expect_model = $self->_prefs_with_expect("make");
my $want_expect = 0;
if ( $expect_model && @{$expect_model->{talk}} ) {
my $can_expect = $CPAN::META->has_inst("Expect");
if ($can_expect) {
$want_expect = 1;
} else {
$CPAN::Frontend->mywarn("Expect not installed, falling back to ".
"system()\n");
}
}
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
}
#-> CPAN::Distribution::_validate_distropref
sub _validate_distropref {
my($self,@args) = @_;
if (
$CPAN::META->has_inst("CPAN::Kwalify")
&&
$CPAN::META->has_inst("Kwalify")
) {
eval {CPAN::Kwalify::_validate("distroprefs",@args);};
if ($@) {
$CPAN::Frontend->mywarn($@);
}
} else {
CPAN->debug("not validating '@args'") if $CPAN::DEBUG;
}
}
#-> CPAN::Distribution::_find_prefs
sub _find_prefs {
my($self) = @_;
my $distroid = $self->pretty_id;
#CPAN->debug("distroid[$distroid]") if $CPAN::DEBUG;
my $prefs_dir = $CPAN::Config->{prefs_dir};
return if $prefs_dir =~ /^\s*$/;
eval { File::Path::mkpath($prefs_dir); };
if ($@) {
$CPAN::Frontend->mydie("Cannot create directory $prefs_dir");
}
# shortcut if there are no distroprefs files
{
my $dh = DirHandle->new($prefs_dir) or $CPAN::Frontend->mydie("Couldn't open '$prefs_dir': $!");
my @files = map { /\.(yml|dd|st)\z/i } $dh->read;
return unless @files;
}
my $yaml_module = CPAN::_yaml_module();
my $ext_map = {};
my @extensions;
if ($CPAN::META->has_inst($yaml_module)) {
$ext_map->{yml} = 'CPAN';
} else {
my @fallbacks;
if ($CPAN::META->has_inst("Data::Dumper")) {
push @fallbacks, $ext_map->{dd} = 'Data::Dumper';
}
if ($CPAN::META->has_inst("Storable")) {
push @fallbacks, $ext_map->{st} = 'Storable';
}
if (@fallbacks) {
local $" = " and ";
unless ($self->{have_complained_about_missing_yaml}++) {
$CPAN::Frontend->mywarnonce("'$yaml_module' not installed, falling back ".
"to @fallbacks to read prefs '$prefs_dir'\n");
}
} else {
unless ($self->{have_complained_about_missing_yaml}++) {
$CPAN::Frontend->mywarnonce("'$yaml_module' not installed, cannot ".
"read prefs '$prefs_dir'\n");
}
}
}
my $finder = CPAN::Distroprefs->find($prefs_dir, $ext_map);
DIRENT: while (my $result = $finder->next) {
if ($result->is_warning) {
$CPAN::Frontend->mywarn($result->as_string);
$CPAN::Frontend->mysleep(1);
next DIRENT;
} elsif ($result->is_fatal) {
$CPAN::Frontend->mydie($result->as_string);
}
my @prefs = @{ $result->prefs };
ELEMENT: for my $y (0..$#prefs) {
my $pref = $prefs[$y];
$self->_validate_distropref($pref->data, $result->abs, $y);
# I don't know why we silently skip when there's no match, but
# complain if there's an empty match hashref, and there's no
# comment explaining why -- hdp, 2008-03-18
unless ($pref->has_any_match) {
next ELEMENT;
}
unless ($pref->has_valid_subkeys) {
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
my $arg = {
env => \%ENV,
distribution => $distroid,
perl => \&CPAN::find_perl,
perlconfig => \%Config::Config,
module => sub { [ $self->containsmods ] },
};
if ($pref->matches($arg)) {
return {
prefs => $pref->data,
prefs_file => $result->abs,
prefs_file_doc => $y,
};
}
}
}
return;
}
# CPAN::Distribution::prefs
sub prefs {
my($self) = @_;
if (exists $self->{negative_prefs_cache}
&&
$self->{negative_prefs_cache} != $CPAN::CurrentCommandId
) {
delete $self->{negative_prefs_cache};
delete $self->{prefs};
}
if (exists $self->{prefs}) {
return $self->{prefs}; # XXX comment out during debugging
}
if ($CPAN::Config->{prefs_dir}) {
CPAN->debug("prefs_dir[$CPAN::Config->{prefs_dir}]") if $CPAN::DEBUG;
my $prefs = $self->_find_prefs();
$prefs ||= ""; # avoid warning next line
CPAN->debug("prefs[$prefs]") if $CPAN::DEBUG;
if ($prefs) {
for my $x (qw(prefs prefs_file prefs_file_doc)) {
$self->{$x} = $prefs->{$x};
}
my $bs = sprintf(
"%s[%s]",
File::Basename::basename($self->{prefs_file}),
$self->{prefs_file_doc},
);
my $filler1 = "_" x 22;
my $filler2 = int(66 - length($bs))/2;
$filler2 = 0 if $filler2 < 0;
$filler2 = " " x $filler2;
$CPAN::Frontend->myprint("
$filler1 D i s t r o P r e f s $filler1
$filler2 $bs $filler2
");
$CPAN::Frontend->mysleep(1);
return $self->{prefs};
}
}
$self->{negative_prefs_cache} = $CPAN::CurrentCommandId;
return $self->{prefs} = +{};
}
# CPAN::Distribution::_make_phase_arg
sub _make_phase_arg {
my($self, $phase) = @_;
my $_make_phase_arg;
my $prefs = $self->prefs;
if (
$prefs
&& exists $prefs->{$phase}
&& exists $prefs->{$phase}{args}
&& $prefs->{$phase}{args}
) {
$_make_phase_arg = join(" ",
map {CPAN::HandleConfig
->safe_quote($_)} @{$prefs->{$phase}{args}},
);
}
# cpan[2]> o conf make[TAB]
# make make_install_make_command
# make_arg makepl_arg
# make_install_arg
# cpan[2]> o conf mbuild[TAB]
# mbuild_arg mbuild_install_build_command
# mbuild_install_arg mbuildpl_arg
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
return $_make_phase_arg;
}
# CPAN::Distribution::_make_command
sub _make_command {
my ($self) = @_;
if ($self) {
return
CPAN::HandleConfig
->safe_quote(
CPAN::HandleConfig->prefs_lookup($self,
q{make})
|| $Config::Config{make}
|| 'make'
);
} else {
# Old style call, without object. Deprecated
Carp::confess("CPAN::_make_command() used as function. Don't Do That.");
return
safe_quote(undef,
CPAN::HandleConfig->prefs_lookup($self,q{make})
|| $CPAN::Config->{make}
|| $Config::Config{make}
|| 'make');
}
}
sub _make_install_make_command {
my ($self) = @_;
my $mimc =
CPAN::HandleConfig->prefs_lookup($self, q{make_install_make_command});
return $self->_make_command() unless $mimc;
# Quote the "make install" make command on Windows, where it is commonly
# found in, e.g., C:\Program Files\... and therefore needs quoting. We can't
# do this in general because the command maybe "sudo make..." (i.e. a
# program with arguments), but that is unlikely to be the case on Windows.
$mimc = CPAN::HandleConfig->safe_quote($mimc) if $^O eq 'MSWin32';
return $mimc;
}
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
}
sub _feature_depends {
my($self) = @_;
my $meta_yml = $self->parse_meta_yml();
my $optf = $meta_yml->{optional_features} or return;
if (!ref $optf or ref $optf ne "HASH"){
$CPAN::Frontend->mywarn("The content of optional_features is not a HASH reference. Cannot use it.\n");
$optf = {};
}
my $wantf = $self->prefs->{features} or return;
if (!ref $wantf or ref $wantf ne "ARRAY"){
$CPAN::Frontend->mywarn("The content of 'features' is not an ARRAY reference. Cannot use it.\n");
$wantf = [];
}
my $dep = +{};
for my $wf (@$wantf) {
if (my $f = $optf->{$wf}) {
$CPAN::Frontend->myprint("Found the demanded feature '$wf' that ".
"is accompanied by this description:\n".
$f->{description}.
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
"as soon as possible; it is needed for a reliable operation of ".
"the cpan shell; setting requirements to nil for '$1' for now ".
"to prevent deadlock during bootstrapping\n");
return;
}
$before = " before $self->{CALLED_FOR}";
}
$CPAN::Frontend->mydie("Please install CPAN::Meta::Requirements manually$before");
}
my $merged = CPAN::Meta::Requirements->new;
my $prefs_depends = $self->prefs->{depends}||{};
my $feature_depends = $self->_feature_depends();
if ($slot eq "configure_requires_later") {
for my $hash ( $self->configure_requires,
$prefs_depends->{configure_requires},
$feature_depends->{configure_requires},
) {
$merged->add_requirements(
CPAN::Meta::Requirements->from_string_hash($hash)
);
}
if (-f "Build.PL"
&& ! -f File::Spec->catfile($self->{build_dir},"Makefile.PL")
&& ! @{[ $merged->required_modules ]}
&& ! $CPAN::META->has_inst("Module::Build")
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
);
$CPAN::Frontend->mysleep(5);
$merged->add_minimum( "Module::Build" => 0 );
delete $self->{writemakefile};
}
$prereq_pm = {}; # configure_requires defined as "b"
} elsif ($slot eq "later") {
my $prereq_pm_0 = $self->prereq_pm || {};
for my $reqtype (qw(requires build_requires opt_requires opt_build_requires)) {
$prereq_pm->{$reqtype} = {%{$prereq_pm_0->{$reqtype}||{}}}; # copy to not pollute it
for my $dep ($prefs_depends,$feature_depends) {
for my $k (keys %{$dep->{$reqtype}||{}}) {
$prereq_pm->{$reqtype}{$k} = $dep->{$reqtype}{$k};
}
}
}
# XXX what about optional_req|breq? -- xdg, 2012-04-01
for my $hash (
$prereq_pm->{requires},
$prereq_pm->{build_requires},
$prereq_pm->{opt_requires},
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
my($self) = @_;
$self->pre_test();
if (exists $self->{cleanup_after_install_done}) {
$self->post_test();
return $self->make;
}
$self->debug("checking goto id[$self->{ID}]") if $CPAN::DEBUG;
if (my $goto = $self->prefs->{goto}) {
$self->post_test();
return $self->goto($goto);
}
unless ($self->make){
$self->post_test();
return;
}
if ( defined( my $sc = $self->shortcut_test ) ) {
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
$self->{badtestcnt}++;
$CPAN::Frontend->mywarn("Found prior test report -- NOT OK\n");
$self->post_test();
return;
}
}
}
}
my $system;
my $prefs_test = $self->prefs->{test};
if (my $commandline
= exists $prefs_test->{commandline} ? $prefs_test->{commandline} : "") {
$system = $commandline;
$ENV{PERL} = CPAN::find_perl();
} elsif ($self->{modulebuild}) {
$system = sprintf "%s test", $self->_build_command();
unless (-e "Build" || ($^O eq 'VMS' && -e "Build.com")) {
my $id = $self->pretty_id;
$CPAN::Frontend->mywarn("Alert: no 'Build' file found while trying to test '$id'");
}
} else {
$system = join " ", $self->_make_command(), "test";
}
my $make_test_arg = $self->_make_phase_arg("test");
$system = sprintf("%s%s",
$system,
$make_test_arg ? " $make_test_arg" : "",
);
my($tests_ok);
my $test_env;
if ($self->prefs->{test}) {
$test_env = $self->prefs->{test}{env};
}
local @ENV{keys %$test_env} = values %$test_env if $test_env;
my $expect_model = $self->_prefs_with_expect("test");
my $want_expect = 0;
if ( $expect_model && @{$expect_model->{talk}} ) {
my $can_expect = $CPAN::META->has_inst("Expect");
if ($can_expect) {
$want_expect = 1;
} else {
$CPAN::Frontend->mywarn("Expect not installed, falling back to ".
"testing without\n");
}
}
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
}
}
$tests_ok = !$?;
} else { # child
POSIX::setsid() unless $^O eq "MSWin32";
my $c_ok;
$|=1;
if ($want_expect) {
if ($self->_should_report('test')) {
$CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is currently ".
"not supported when distroprefs specify ".
"an interactive test\n");
}
$c_ok = $self->_run_via_expect($system,'test',$expect_model) == 0;
} elsif ( $self->_should_report('test') ) {
$c_ok = CPAN::Reporter::test($self, $system);
} else {
$c_ok = system($system) == 0;
}
exit !$c_ok;
}
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
my $but;
if (@prereq) {
my $cnt = @prereq;
my $which = join ",", @prereq;
$but = $cnt == 1 ? "one dependency not OK ($which)" :
"$cnt dependencies missing ($which)";
}
$but;
}
sub _prefs_with_expect {
my($self,$where) = @_;
return unless my $prefs = $self->prefs;
return unless my $where_prefs = $prefs->{$where};
if ($where_prefs->{expect}) {
return {
mode => "deterministic",
timeout => 15,
talk => $where_prefs->{expect},
};
} elsif ($where_prefs->{"eexpect"}) {
return $where_prefs->{"eexpect"};
}
return;
}
#-> sub CPAN::Distribution::clean ;
sub clean {
my($self) = @_;
my $make = $self->{modulebuild} ? "Build" : "make";
$CPAN::Frontend->myprint(sprintf "Running %s clean for %s\n", $make, $self->pretty_id);
unless (exists $self->{archived}) {
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
# $self->force("make"); # so that this directory won't be used again
}
$self->store_persistent_state;
}
#-> sub CPAN::Distribution::check_disabled ;
sub check_disabled {
my ($self) = @_;
$self->debug("checking disabled id[$self->{ID}]") if $CPAN::DEBUG;
if ($self->prefs->{disabled} && ! $self->{force_update}) {
return sprintf(
"Disabled via prefs file '%s' doc %d",
$self->{prefs_file},
$self->{prefs_file_doc},
);
}
return;
}
#-> sub CPAN::Distribution::goto ;
sub goto {
my($self,$goto) = @_;
$goto = $self->normalize($goto);
my $why = sprintf(
"Goto '$goto' via prefs file '%s' doc %d",
$self->{prefs_file},
$self->{prefs_file_doc},
);
$self->{unwrapped} = CPAN::Distrostatus->new("NO $why");
# 2007-07-16 akoenig : Better than NA would be if we could inherit
# the status of the $goto distro but given the exceptional nature
# of 'goto' I feel reluctant to implement it
my $goodbye_message = "[goto] -- NA $why";
$self->goodbye($goodbye_message);
# inject into the queue
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
sub install {
my($self) = @_;
$self->pre_install();
if (exists $self->{cleanup_after_install_done}) {
return $self->test;
}
$self->debug("checking goto id[$self->{ID}]") if $CPAN::DEBUG;
if (my $goto = $self->prefs->{goto}) {
$self->goto($goto);
$self->post_install();
return;
}
unless ($self->test) {
$self->post_install();
return;
}
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
my $make = $self->{modulebuild} ? "Build" : "make";
$CPAN::Frontend->myprint(sprintf "Running %s install for %s\n", $make, $self->pretty_id);
if ($^O eq 'MacOS') {
Mac::BuildTools::make_install($self);
$self->post_install();
return;
}
my $system;
if (my $commandline = $self->prefs->{install}{commandline}) {
$system = $commandline;
$ENV{PERL} = CPAN::find_perl();
} elsif ($self->{modulebuild}) {
my($mbuild_install_build_command) =
exists $CPAN::HandleConfig::keys{mbuild_install_build_command} &&
$CPAN::Config->{mbuild_install_build_command} ?
$CPAN::Config->{mbuild_install_build_command} :
$self->_build_command();
my $install_directive = $^O eq 'VMS' ? '"install"' : 'install';
$system = sprintf("%s %s %s",
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
);
} else {
my($make_install_make_command) = $self->_make_install_make_command();
$system = sprintf("%s install %s",
$make_install_make_command,
$CPAN::Config->{make_install_arg},
);
}
my($stderr) = $^O eq "MSWin32" || $^O eq 'VMS' ? "" : " 2>&1 ";
my $brip = CPAN::HandleConfig->prefs_lookup($self,
q{build_requires_install_policy});
$brip ||="ask/yes";
my $id = $self->id;
my $reqtype = $self->{reqtype} ||= "c"; # in doubt it was a command
my $want_install = "yes";
if ($reqtype eq "b") {
if ($brip eq "no") {
$want_install = "no";
} elsif ($brip =~ m|^ask/(.+)|) {
my $default = $1;
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
local $ENV{PERL5OPT} = defined $ENV{PERL5OPT} ? $ENV{PERL5OPT} : "";
local $ENV{PERL_USE_UNSAFE_INC} =
exists $ENV{PERL_USE_UNSAFE_INC} && defined $ENV{PERL_USE_UNSAFE_INC}
? $ENV{PERL_USE_UNSAFE_INC} : 1; # install
$CPAN::META->set_perl5lib;
local $ENV{PERL_MM_USE_DEFAULT} = 1 if $CPAN::Config->{use_prompt_default};
local $ENV{NONINTERACTIVE_TESTING} = 1 if $CPAN::Config->{use_prompt_default};
my $install_env;
if ($self->prefs->{install}) {
$install_env = $self->prefs->{install}{env};
}
local @ENV{keys %$install_env} = values %$install_env if $install_env;
if (! $run_allow_installing_within_test) {
my($allow_installing, $why) = $self->_allow_installing;
if (! $allow_installing) {
$CPAN::Frontend->mywarn("Installation stopped: $why\n");
$self->introduce_myself;
$self->{install} = CPAN::Distrostatus->new("NO -- installation stopped due $why");
$CPAN::Frontend->mywarn(" $system -- NOT OK\n");
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
my $yml = "$self->{build_dir}.yml";
if (-e $yml) {
unlink $yml or $CPAN::Frontend->mydie("Couldn't unlink $yml: $!\n");
}
$self->{cleanup_after_install_done}=1;
}
} else {
$self->{install} = CPAN::Distrostatus->new("NO");
$CPAN::Frontend->mywarn(" $system -- NOT OK\n");
my $mimc =
CPAN::HandleConfig->prefs_lookup($self,
q{make_install_make_command});
if (
$makeout =~ /permission/s
&& $> > 0
&& (
! $mimc
|| $mimc eq (CPAN::HandleConfig->prefs_lookup($self,
q{make}))
)
) {
$CPAN::Frontend->myprint(
qq{----\n}.
qq{ You may have to su }.
qq{to root to install the package\n}.
qq{ (Or you may want to run something like\n}.
qq{ o conf make_install_make_command 'sudo make'\n}.
qq{ to raise your permissions.}
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
}
};
}
sub _allow_installing {
my($self) = @_;
my $id = my $pretty_id = $self->pretty_id;
if ($self->{CALLED_FOR}) {
$id .= " (called for $self->{CALLED_FOR})";
}
my $allow_down = CPAN::HandleConfig->prefs_lookup($self,q{allow_installing_module_downgrades});
$allow_down ||= "ask/yes";
my $allow_outdd = CPAN::HandleConfig->prefs_lookup($self,q{allow_installing_outdated_dists});
$allow_outdd ||= "ask/yes";
return 1 if
$allow_down eq "yes"
&& $allow_outdd eq "yes";
if (($allow_outdd ne "yes") && ! $CPAN::META->has_inst('CPAN::DistnameInfo')) {
return 1 if grep { $_ eq 'CPAN::DistnameInfo'} $self->containsmods;
if ($allow_outdd ne "yes") {
$CPAN::Frontend->mywarn("The current configuration of allow_installing_outdated_dists is '$allow_outdd', but for this option we would need 'CPAN::DistnameInfo' installed. Please install 'CPAN::DistnameInfo' as soon as possible. As long as...
$allow_outdd = "yes";
}
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
#-> sub CPAN::Distribution::_should_report
sub _should_report {
my($self, $phase) = @_;
die "_should_report() requires a 'phase' argument"
if ! defined $phase;
return unless $CPAN::META->has_usable("CPAN::Reporter");
# configured
my $test_report = CPAN::HandleConfig->prefs_lookup($self,
q{test_report});
return unless $test_report;
# don't repeat if we cached a result
return $self->{should_report}
if exists $self->{should_report};
# don't report if we generated a Makefile.PL
if ( $self->{had_no_makefile_pl} ) {
$CPAN::Frontend->mywarn(
cpan/CPAN/lib/CPAN/Distribution.pm view on Meta::CPAN
return;
}
}
# appropriate
if ($self->is_dot_dist) {
$CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ".
"for local directories\n");
return $self->{should_report} = 0;
}
if ($self->prefs->{patches}
&&
@{$self->prefs->{patches}}
&&
$self->{patched}
) {
$CPAN::Frontend->mywarn("Reporting via CPAN::Reporter is disabled ".
"when the source has been patched\n");
return $self->{should_report} = 0;
}
# proceed and cache success
return $self->{should_report} = 1;
cpan/CPAN/lib/CPAN/Distroprefs.pm view on Meta::CPAN
# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
# vim: ts=4 sts=4 sw=4:
use 5.006;
use strict;
package CPAN::Distroprefs;
use vars qw($VERSION);
$VERSION = '6.0001';
package CPAN::Distroprefs::Result;
use File::Spec;
sub new { bless $_[1] || {} => $_[0] }
sub abs { File::Spec->catfile($_[0]->dir, $_[0]->file) }
sub __cloner {
my ($class, $name, $newclass) = @_;
$newclass = 'CPAN::Distroprefs::Result::' . $newclass;
no strict 'refs';
*{$class . '::' . $name} = sub {
$newclass->new({
%{ $_[0] },
%{ $_[1] },
});
};
}
BEGIN { __PACKAGE__->__cloner(as_warning => 'Warning') }
BEGIN { __PACKAGE__->__cloner(as_fatal => 'Fatal') }
cpan/CPAN/lib/CPAN/Distroprefs.pm view on Meta::CPAN
my ($class, $key) = @_;
no strict 'refs';
*{$class . '::' . $key} = sub { $_[0]->{$key} };
}
BEGIN { __PACKAGE__->__accessor($_) for qw(type file ext dir) }
sub is_warning { 0 }
sub is_fatal { 0 }
sub is_success { 0 }
package CPAN::Distroprefs::Result::Error;
use vars qw(@ISA);
BEGIN { @ISA = 'CPAN::Distroprefs::Result' } ## no critic
BEGIN { __PACKAGE__->__accessor($_) for qw(msg) }
sub as_string {
my ($self) = @_;
if ($self->msg) {
return sprintf $self->fmt_reason, $self->file, $self->msg;
} else {
return sprintf $self->fmt_unknown, $self->file;
}
}
package CPAN::Distroprefs::Result::Warning;
use vars qw(@ISA);
BEGIN { @ISA = 'CPAN::Distroprefs::Result::Error' } ## no critic
sub is_warning { 1 }
sub fmt_reason { "Error reading distroprefs file %s, skipping: %s" }
sub fmt_unknown { "Unknown error reading distroprefs file %s, skipping." }
package CPAN::Distroprefs::Result::Fatal;
use vars qw(@ISA);
BEGIN { @ISA = 'CPAN::Distroprefs::Result::Error' } ## no critic
sub is_fatal { 1 }
sub fmt_reason { "Error reading distroprefs file %s: %s" }
sub fmt_unknown { "Unknown error reading distroprefs file %s." }
package CPAN::Distroprefs::Result::Success;
use vars qw(@ISA);
BEGIN { @ISA = 'CPAN::Distroprefs::Result' } ## no critic
BEGIN { __PACKAGE__->__accessor($_) for qw(prefs extension) }
sub is_success { 1 }
package CPAN::Distroprefs::Iterator;
sub new { bless $_[1] => $_[0] }
sub next { $_[0]->() }
package CPAN::Distroprefs;
use Carp ();
use DirHandle;
sub _load_method {
my ($self, $loader, $result) = @_;
return '_load_yaml' if $loader eq 'CPAN' or $loader =~ /^YAML(::|$)/;
return '_load_' . $result->ext;
}
cpan/CPAN/lib/CPAN/Distroprefs.pm view on Meta::CPAN
}
sub _build_file_list {
if (@_ > 3) {
die "_build_file_list should be called with 3 arguments, was called with more. First argument is '$_[0]'.";
}
my ($dir, $dir1, $ext_re) = @_;
my @list;
my $dh;
unless (opendir($dh, $dir)) {
$CPAN::Frontend->mywarn("ignoring prefs directory '$dir': $!");
return @list;
}
while (my $fn = readdir $dh) {
next if $fn eq '.' || $fn eq '..';
if (-d "$dir/$fn") {
next if $fn =~ /^[._]/; # prune .svn, .git, .hg, _darcs and what the user wants to hide
push @list, _build_file_list("$dir/$fn", "$dir1$fn/", $ext_re);
} else {
if ($fn =~ $ext_re) {
push @list, "$dir1$fn";
}
}
}
return @list;
}
sub find {
my ($self, $dir, $ext_map) = @_;
return CPAN::Distroprefs::Iterator->new(sub { return }) unless %$ext_map;
my $possible_ext = join "|", map { quotemeta } keys %$ext_map;
my $ext_re = qr/\.($possible_ext)$/;
my @files = _build_file_list($dir, '', $ext_re);
@files = sort @files if @files;
# label the block so that we can use redo in the middle
return CPAN::Distroprefs::Iterator->new(sub { LOOP: {
my $fn = shift @files;
return unless defined $fn;
my ($ext) = $fn =~ $ext_re;
my $loader = $ext_map->{$ext};
my $result = CPAN::Distroprefs::Result->new({
file => $fn, ext => $ext, dir => $dir
});
# copied from CPAN.pm; is this ever actually possible?
redo unless -f $result->abs;
my $load_method = $self->_load_method($loader, $result);
my @prefs = eval { $self->$load_method($loader, $result) };
if (my $err = $@) {
if (ref($err) && eval { $err->isa('CPAN::Distroprefs::Result') }) {
return $err;
}
# rethrow any exceptions that we did not generate
die $err;
} elsif (!@prefs) {
# the loader should have handled this, but just in case:
return $result->as_warning;
}
return $result->as_success({
prefs => [
map { CPAN::Distroprefs::Pref->new({ data => $_ }) } @prefs
],
});
} });
}
package CPAN::Distroprefs::Pref;
use Carp ();
sub new { bless $_[1] => $_[0] }
sub data { shift->{data} }
sub has_any_match { $_[0]->data->{match} ? 1 : 0 }
sub has_match {
cpan/CPAN/lib/CPAN/Distroprefs.pm view on Meta::CPAN
grep { exists $_[0]->data->{match}{$_} }
map { $_, "not_$_" }
$_[0]->match_attributes
}
sub _pattern {
my $re = shift;
my $p = eval sprintf 'qr{%s}', $re;
if ($@) {
$@ =~ s/\n$//;
die "Error in Distroprefs pattern qr{$re}\n$@";
}
return $p;
}
sub _match_scalar {
my ($match, $data) = @_;
my $qr = _pattern($match);
return $data =~ /$qr/;
}
cpan/CPAN/lib/CPAN/Distroprefs.pm view on Meta::CPAN
return $default_match;
}
1;
__END__
=head1 NAME
CPAN::Distroprefs -- read and match distroprefs
=head1 SYNOPSIS
use CPAN::Distroprefs;
my %info = (... distribution/environment info ...);
my $finder = CPAN::Distroprefs->find($prefs_dir, \%ext_map);
while (my $result = $finder->next) {
die $result->as_string if $result->is_fatal;
warn($result->as_string), next if $result->is_warning;
for my $pref (@{ $result->prefs }) {
if ($pref->matches(\%info)) {
return $pref;
}
}
}
=head1 DESCRIPTION
This module encapsulates reading L<Distroprefs|CPAN> and matching them against CPAN distributions.
=head1 INTERFACE
my $finder = CPAN::Distroprefs->find($dir, \%ext_map);
while (my $result = $finder->next) { ... }
Build an iterator which finds distroprefs files in the tree below the
given directory. Within the tree directories matching C<m/^[._]/> are
pruned.
C<%ext_map> is a hashref whose keys are file extensions and whose values are
modules used to load matching files:
{
'yml' => 'YAML::Syck',
'dd' => 'Data::Dumper',
...
}
Each time C<< $finder->next >> is called, the iterator returns one of two
possible values:
=over
=item * a CPAN::Distroprefs::Result object
=item * C<undef>, indicating that no prefs files remain to be found
=back
=head1 RESULTS
L<C<find()>|/INTERFACE> returns CPAN::Distroprefs::Result objects to
indicate success or failure when reading a prefs file.
=head2 Common
All results share some common attributes:
=head3 type
C<success>, C<warning>, or C<fatal>
=head3 file
the file from which these prefs were read, or to which this error refers (relative filename)
=head3 ext
the file's extension, which determines how to load it
=head3 dir
the directory the file was read from
=head3 abs
cpan/CPAN/lib/CPAN/Distroprefs.pm view on Meta::CPAN
Error results (warning and fatal) contain:
=head3 msg
the error message (usually either C<$!> or a YAML error)
=head2 Successes
Success results contain:
=head3 prefs
an arrayref of CPAN::Distroprefs::Pref objects
=head1 PREFS
CPAN::Distroprefs::Pref objects represent individual distroprefs documents.
They are constructed automatically as part of C<success> results from C<find()>.
=head3 data
the pref information as a hashref, suitable for e.g. passing to Kwalify
=head3 match_attributes
returns a list of the valid match attributes (see the Distroprefs section in L<CPAN>)
currently: C<env perl perlconfig distribution module>
=head3 has_any_match
true if this pref has a 'match' attribute at all
=head3 has_valid_subkeys
true if this pref has a 'match' attribute and at least one valid match attribute
cpan/CPAN/lib/CPAN/FirstTime.pm view on Meta::CPAN
but if both are supplied then a decision must be made between EUMM and
MB. See also http://rt.cpan.org/Ticket/Display.html?id=29235 for a
discussion about the right default.
Or, as a third option you can choose RAND which will make a random
decision (something regular CPAN testers will enjoy).
In case you can choose between running a Makefile.PL or a Build.PL,
which installer would you prefer (EUMM or MB or RAND)?
=item prefs_dir
CPAN.pm can store customized build environments based on regular
expressions for distribution names. These are YAML files where the
default options for CPAN.pm and the environment can be overridden and
dialog sequences can be stored that can later be executed by an
Expect.pm object. The CPAN.pm distribution comes with some prefab YAML
files that cover sample distributions that can be used as blueprints
to store your own prefs. Please check out the distroprefs/ directory of
the CPAN.pm distribution to get a quick start into the prefs system.
Directory where to store default options/environment/dialogs for
building modules that need some customization?
=item prerequisites_policy
The CPAN module can detect when a module which you are trying to build
depends on prerequisites. If this happens, it can build the
prerequisites for you automatically ('follow'), ask you for
confirmation ('ask'), or just ignore them ('ignore'). Choosing
cpan/CPAN/lib/CPAN/FirstTime.pm view on Meta::CPAN
my_prompt_loop(install_help => 'local::lib', $matcher,
'local::lib|sudo|manual');
}
$CPAN::Config->{install_help} ||= ''; # Temporary to suppress warnings
if (!$matcher or q{
build_dir
build_dir_reuse
cpan_home
keep_source_where
prefs_dir
} =~ /$matcher/) {
$CPAN::Frontend->myprint($prompts{config_intro}) unless $auto_config;
init_cpan_home($matcher);
my_dflt_prompt("keep_source_where",
File::Spec->catdir($CPAN::Config->{cpan_home},"sources"),
$matcher,
);
my_dflt_prompt("build_dir",
File::Spec->catdir($CPAN::Config->{cpan_home},"build"),
$matcher
);
my_yn_prompt(build_dir_reuse => 0, $matcher);
my_dflt_prompt("prefs_dir",
File::Spec->catdir($CPAN::Config->{cpan_home},"prefs"),
$matcher
);
}
#
#= Config: auto_commit
#
my_yn_prompt(auto_commit => 0, $matcher);
cpan/CPAN/lib/CPAN/FirstTime.pm view on Meta::CPAN
}
else {
$CPAN::Frontend->myprint("\nAttempting to bootstrap local::lib...\n");
$CPAN::Frontend->myprint("\nWriting $configpm for bootstrap...\n");
delete $CPAN::Config->{install_help}; # temporary only
CPAN::HandleConfig->commit;
my($dist, $locallib);
$locallib = CPAN::Shell->expand('Module', 'local::lib');
if ( $locallib and $dist = $locallib->distribution ) {
# this is a hack to force bootstrapping
$dist->{prefs}{pl}{commandline} = "$^X Makefile.PL --bootstrap";
# Set @INC for this process so we find things as they bootstrap
require lib;
lib->import(_local_lib_inc_path());
eval { $dist->install };
}
if ( ! $dist || (my $err = $@) ) {
$err ||= 'Could not locate local::lib in the CPAN index';
$CPAN::Frontend->mywarn("Error bootstrapping local::lib: $@\n");
$CPAN::Frontend->myprint("From the CPAN Shell, you might try 'look local::lib' and \n"
. "run 'perl Makefile --bootstrap' and see if that is successful. Then\n"
cpan/CPAN/lib/CPAN/HandleConfig.pm view on Meta::CPAN
"ncftpget",
"no_proxy",
"pager",
"password",
"patch",
"patches_dir",
"perl5lib_verbosity",
"plugin_list",
"prefer_external_tar",
"prefer_installer",
"prefs_dir",
"prerequisites_policy",
"proxy_pass",
"proxy_user",
"pushy_https",
"randomize_urllist",
"recommends_policy",
"scan_cache",
"shell",
"show_unparsable_versions",
"show_upload_date",
cpan/CPAN/lib/CPAN/HandleConfig.pm view on Meta::CPAN
"use_prompt_default",
"use_sqlite",
"username",
"version_timeout",
"wait_list",
"wget",
"yaml_load_code",
"yaml_module",
);
my %prefssupport = map { $_ => 1 }
(
"allow_installing_module_downgrades",
"allow_installing_outdated_dists",
"build_requires_install_policy",
"check_sigs",
"make",
"make_install_make_command",
"prefer_installer",
"test_report",
);
cpan/CPAN/lib/CPAN/HandleConfig.pm view on Meta::CPAN
return ();
}
my %seen;
my(@o_conf) = sort grep { !$seen{$_}++ }
keys %can,
keys %$CPAN::Config,
keys %keys;
return grep /^\Q$word\E/, @o_conf;
}
sub prefs_lookup {
my($self,$distro,$what) = @_;
if ($prefssupport{$what}) {
return $CPAN::Config->{$what} unless
$distro
and $distro->prefs
and $distro->prefs->{cpanconfig}
and defined $distro->prefs->{cpanconfig}{$what};
return $distro->prefs->{cpanconfig}{$what};
} else {
$CPAN::Frontend->mywarn("Warning: $what not yet officially ".
"supported for distroprefs, doing a normal lookup\n");
return $CPAN::Config->{$what};
}
}
{
package
CPAN::Config; ####::###### #hide from indexer
# note: J. Nick Koston wrote me that they are using
# CPAN::Config->commit although undocumented. I suggested
cpan/CPAN/lib/CPAN/Index.pm view on Meta::CPAN
for my $skipper (qw(
badtestcnt
configure_requires_later
configure_requires_later_for
force_update
later
later_for
notest
should_report
sponsored_mods
prefs
negative_prefs_cache
)) {
delete $do->{$skipper};
}
if ($do->can("tested_ok_but_not_installed")) {
if ($do->tested_ok_but_not_installed) {
$CPAN::META->is_tested($do->{build_dir},$do->{make_test}{TIME});
} else {
next DISTRO;
}
}
cpan/CPAN/lib/CPAN/Kwalify.pm view on Meta::CPAN
use CPAN::Kwalify;
validate($schema_name, $data, $file, $doc);
=head1 DESCRIPTION
=over
=item _validate($schema_name, $data, $file, $doc)
$schema_name is the name of a supported schema. Currently only
C<distroprefs> is supported. $data is the data to be validated. $file
is the absolute path to the file the data are coming from. $doc is the
index of the document within $doc that is to be validated. The last
two arguments are only there for better error reporting.
Relies on being called from within CPAN.pm.
Dies if something fails. Does not return anything useful.
=item yaml($schema_name)
cpan/CPAN/lib/CPAN/Shell.pm view on Meta::CPAN
$VERSION
);
@relo = (
"CPAN.pm",
"CPAN/Author.pm",
"CPAN/CacheMgr.pm",
"CPAN/Complete.pm",
"CPAN/Debug.pm",
"CPAN/DeferredCode.pm",
"CPAN/Distribution.pm",
"CPAN/Distroprefs.pm",
"CPAN/Distrostatus.pm",
"CPAN/Exception/RecursiveDependency.pm",
"CPAN/Exception/yaml_not_installed.pm",
"CPAN/FirstTime.pm",
"CPAN/FTP.pm",
"CPAN/FTP/netrc.pm",
"CPAN/HandleConfig.pm",
"CPAN/Index.pm",
"CPAN/InfoObj.pm",
"CPAN/Kwalify.pm",
cpan/CPAN/t/03pkgs.t view on Meta::CPAN
# test if our own version numbers meet expectations
use strict;
eval 'use warnings';
use lib "lib";
my @m;
if ($ENV{PERL_CORE}){
@m = ("CPAN", map { "CPAN::$_" } qw(Debug
DeferredCode
Distroprefs
FirstTime
Kwalify
Nox
Plugin
Queue
Tarzip
Version
));
} else {
opendir DH, "lib/CPAN" or die;
dist/I18N-LangTags/lib/I18N/LangTags/Detect.pm view on Meta::CPAN
map lc($_),
grep $_,
map {; $_, alternate_language_tags($_) } @_;
return _uniq(@languages) if wantarray;
return $languages[0];
}
#---------------------------------------------------------------------------
# The extent of our functional interface:
sub detect () { return __PACKAGE__->ambient_langprefs; }
#===========================================================================
sub ambient_langprefs { # always returns things untainted
my $base_class = $_[0];
return $base_class->http_accept_langs
if length( $ENV{'REQUEST_METHOD'} || '' ); # I'm a CGI
# it's off in its own routine because it's complicated
# Not running as a CGI: try to puzzle out from the environment
my @languages;
foreach my $envname (qw( LANGUAGE LC_ALL LC_MESSAGES LANG )) {
dist/Locale-Maketext/lib/Locale/Maketext.pm view on Meta::CPAN
# Catch alternation
map I18N::LangTags::locale2language_tag($_),
# If it's a lg tag, fine, pass thru (untainted)
# If it's a locale ID, try converting to a lg tag (untainted),
# otherwise nix it.
@languages;
DEBUG and warn 'Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
}
}
else {
@languages = $base_class->_ambient_langprefs;
}
@languages = $base_class->_langtag_munging(@languages);
my %seen;
foreach my $module_name ( map { $base_class . '::' . $_ } @languages ) {
next unless length $module_name; # sanity
next if $seen{$module_name}++ # Already been here, and it was no-go
|| !&_try_use($module_name); # Try to use() it, but can't it.
return($module_name->new); # Make it!
dist/Locale-Maketext/lib/Locale/Maketext.pm view on Meta::CPAN
# You are free to override that to return whatever.
DEBUG and warn "Finally:\n",
' Lgs@', __LINE__, ': ', map("<$_>", @languages), "\n";
return @languages;
}
###########################################################################
sub _ambient_langprefs {
return I18N::LangTags::Detect::detect();
}
###########################################################################
sub _add_supers {
my($base_class, @languages) = @_;
if (!$MATCH_SUPERS) {
# Nothing
dist/Locale-Maketext/t/92_blacklist.t view on Meta::CPAN
}
my $lh = MyTestLocale->get_handle('en');
my $res;
# get_handle blocked by default
$res = eval { $lh->maketext('[get_handle,en]') };
is( $res, undef, 'no return value from blocked expansion' );
like( $@, qr/Can't use .* as a method name/, 'get_handle blocked in bracket notation by default denylist' );
# _ambient_langprefs blocked by default
$res = eval { $lh->maketext('[_ambient_langprefs]') };
is( $res, undef, 'no return value from blocked expansion' );
like( $@, qr/Can't use .* as a method name/, '_ambient_langprefs blocked in bracket notation by default denylist' );
# _internal_method not blocked by default
$res = eval { $lh->maketext('[_internal_method]') };
is( $res, "_internal_method_response", '_internal_method allowed in bracket notation by default denylist' );
is( $@, '', 'no exception thrown by use of _internal_method under default denylist' );
# sprintf not blocked by default
$res = eval { $lh->maketext('[sprintf,%s,hello]') };
is( $res, "hello", 'sprintf allowed in bracket notation by default denylist' );
is( $@, '', 'no exception thrown by use of sprintf under default denylist' );
dist/Locale-Maketext/t/94_denylist.t view on Meta::CPAN
}
my $lh = MyTestLocale->get_handle('en');
my $res;
# get_handle blocked by default
$res = eval { $lh->maketext('[get_handle,en]') };
is( $res, undef, 'no return value from blocked expansion' );
like( $@, qr/Can't use .* as a method name/, 'get_handle blocked in bracket notation by default denylist' );
# _ambient_langprefs blocked by default
$res = eval { $lh->maketext('[_ambient_langprefs]') };
is( $res, undef, 'no return value from blocked expansion' );
like( $@, qr/Can't use .* as a method name/, '_ambient_langprefs blocked in bracket notation by default denylist' );
# _internal_method not blocked by default
$res = eval { $lh->maketext('[_internal_method]') };
is( $res, "_internal_method_response", '_internal_method allowed in bracket notation by default denylist' );
is( $@, '', 'no exception thrown by use of _internal_method under default denylist' );
# sprintf not blocked by default
$res = eval { $lh->maketext('[sprintf,%s,hello]') };
is( $res, "hello", 'sprintf allowed in bracket notation by default denylist' );
is( $@, '', 'no exception thrown by use of sprintf under default denylist' );
dist/Module-CoreList/lib/Module/CoreList.pm view on Meta::CPAN
'B::Terse' => '1.05',
'Benchmark' => '1.1',
'CGI' => '3.42',
'CGI::Carp' => '1.30_01',
'CGI::Cookie' => '1.29',
'CGI::Fast' => '1.07',
'CGI::Util' => '1.5_01',
'CPAN' => '1.9301',
'CPAN::Debug' => '5.5',
'CPAN::DeferedCode' => '5.50',
'CPAN::Distroprefs' => '6',
'CPAN::FirstTime' => '5.5_01',
'CPAN::HandleConfig' => '5.5',
'CPAN::Kwalify' => '5.50',
'CPAN::Nox' => '5.50',
'CPAN::Queue' => '5.5',
'CPAN::Tarzip' => '5.5',
'CPAN::Version' => '5.5',
'Carp' => '1.10',
'Carp::Heavy' => '1.10',
'Cwd' => '3.29',
dist/Module-CoreList/lib/Module/CoreList.pm view on Meta::CPAN
'CGI::Carp' => '1.30_01',
'CGI::Cookie' => '1.29',
'CPAN' => '1.9402',
'CPAN::Author' => '5.5',
'CPAN::Bundle' => '5.5',
'CPAN::CacheMgr' => '5.5',
'CPAN::Complete' => '5.5',
'CPAN::Debug' => '5.5',
'CPAN::DeferredCode' => '5.50',
'CPAN::Distribution' => '1.93',
'CPAN::Distroprefs' => '6',
'CPAN::Distrostatus' => '5.5',
'CPAN::Exception::RecursiveDependency'=> '5.5',
'CPAN::Exception::blocked_urllist'=> '1.0',
'CPAN::Exception::yaml_not_installed'=> '5.5',
'CPAN::FTP' => '5.5001',
'CPAN::FTP::netrc' => '1.00',
'CPAN::FirstTime' => '5.53',
'CPAN::HandleConfig' => '5.5',
'CPAN::Index' => '1.93',
'CPAN::InfoObj' => '5.5',
dist/Module-CoreList/lib/Module/CoreList.pm view on Meta::CPAN
5.01901 => {
delta_from => 5.019009,
changed => {
'App::Cpan' => '1.62',
'Attribute::Handlers' => '0.96',
'B::Deparse' => '1.26',
'CPAN' => '2.04',
'CPAN::Bundle' => '5.5001',
'CPAN::Complete' => '5.5001',
'CPAN::Distribution' => '2.01',
'CPAN::Distroprefs' => '6.0001',
'CPAN::FirstTime' => '5.5305',
'CPAN::Meta' => '2.140640',
'CPAN::Meta::Converter' => '2.140640',
'CPAN::Meta::Feature' => '2.140640',
'CPAN::Meta::History' => '2.140640',
'CPAN::Meta::Prereqs' => '2.140640',
'CPAN::Meta::Spec' => '2.140640',
'CPAN::Meta::Validator' => '2.140640',
'CPAN::Meta::YAML' => '0.012',
'CPAN::Queue' => '5.5002',
dist/Module-CoreList/lib/Module/CoreList.pm view on Meta::CPAN
'AutoLoader' => 'cpan',
'AutoSplit' => 'cpan',
'CPAN' => 'cpan',
'CPAN::Author' => 'cpan',
'CPAN::Bundle' => 'cpan',
'CPAN::CacheMgr' => 'cpan',
'CPAN::Complete' => 'cpan',
'CPAN::Debug' => 'cpan',
'CPAN::DeferredCode' => 'cpan',
'CPAN::Distribution' => 'cpan',
'CPAN::Distroprefs' => 'cpan',
'CPAN::Distrostatus' => 'cpan',
'CPAN::Exception::RecursiveDependency'=> 'cpan',
'CPAN::Exception::blocked_urllist'=> 'cpan',
'CPAN::Exception::yaml_not_installed'=> 'cpan',
'CPAN::Exception::yaml_process_error'=> 'cpan',
'CPAN::FTP' => 'cpan',
'CPAN::FTP::netrc' => 'cpan',
'CPAN::FirstTime' => 'cpan',
'CPAN::HTTP::Client' => 'cpan',
'CPAN::HTTP::Credentials'=> 'cpan',
dist/Module-CoreList/lib/Module/CoreList.pm view on Meta::CPAN
'Archive::Tar::Constant'=> undef,
'Archive::Tar::File' => undef,
'CPAN' => undef,
'CPAN::Author' => undef,
'CPAN::Bundle' => undef,
'CPAN::CacheMgr' => undef,
'CPAN::Complete' => undef,
'CPAN::Debug' => undef,
'CPAN::DeferredCode' => undef,
'CPAN::Distribution' => undef,
'CPAN::Distroprefs' => undef,
'CPAN::Distrostatus' => undef,
'CPAN::Exception::RecursiveDependency'=> undef,
'CPAN::Exception::blocked_urllist'=> undef,
'CPAN::Exception::yaml_not_installed'=> undef,
'CPAN::Exception::yaml_process_error'=> undef,
'CPAN::FTP' => undef,
'CPAN::FTP::netrc' => undef,
'CPAN::FirstTime' => undef,
'CPAN::HTTP::Client' => undef,
'CPAN::HTTP::Credentials'=> undef,
( run in 2.684 seconds using v1.01-cache-2.11-cpan-8f98c5d2c55 )