Alien-ROOT
view release on metacpan or search on metacpan
inc/inc_Archive-Extract/Archive/Extract.pm view on Meta::CPAN
### add pure perl extractor if allowed & add bin extractor if allowed
my @methods;
push @methods, $map->{'pp'} if $_ALLOW_PURE_PERL;
push @methods, $map->{'bin'} if $_ALLOW_BIN;
### reverse it if we prefer bin extractors
@methods = reverse @methods if $PREFER_BIN;
my($na, $fail);
for my $method (@methods) {
$self->debug( "# Extracting with ->$method\n" );
my $rv = $self->$method;
### a positive extraction
if( $rv and $rv ne METHOD_NA ) {
$self->debug( "# Extraction succeeded\n" );
$self->_extractor($method);
last;
### method is not available
} elsif ( $rv and $rv eq METHOD_NA ) {
$self->debug( "# Extraction method not available\n" );
$na++;
} else {
$self->debug( "# Extraction method failed\n" );
$fail++;
}
}
### warn something went wrong if we didn't get an extractor
unless( $self->_extractor ) {
my $diag = $fail ? loc("Extract failed due to errors") :
$na ? loc("Extract failed; no extractors available") :
'';
inc/inc_Archive-Extract/Archive/Extract.pm view on Meta::CPAN
### make sure we have a fallback aref
my $aref = do {
shift()
? $self->_error_msg_long
: $self->_error_msg
} || [];
return join $/, @$aref;
}
=head2 debug( MESSAGE )
This method outputs MESSAGE to the default filehandle if C<$DEBUG> is
true. It's a small method, but it's here if you'd like to subclass it
so you can so something else with any debugging output.
=cut
### this is really a stub for subclassing
sub debug {
return unless $DEBUG;
print $_[1];
}
sub _no_buffer_files {
my $self = shift;
my $file = shift or return;
return loc("No buffer captured, unable to tell ".
"extracted files or extraction dir for '%1'", $file);
inc/inc_File-Fetch/File/Fetch.pm view on Meta::CPAN
This variable controls whether errors encountered internally by
C<File::Fetch> should be C<carp>'d or not.
Set to false to silence warnings. Inspect the output of the C<error()>
method manually to see what went wrong.
Defaults to C<true>.
=head2 $File::Fetch::DEBUG
This enables debugging output when calling commandline utilities to
fetch files.
This also enables C<Carp::longmess> errors, instead of the regular
C<carp> errors.
Good for tracking down why things don't work with your particular
setup.
Default is 0.
=head2 $File::Fetch::BLACKLIST
inc/inc_IPC-Cmd/IPC/Cmd.pm view on Meta::CPAN
local $SIG{ALRM} = sub { die bless sub {
ALARM_CLASS .
qq[: Command '$pp_cmd' aborted by alarm after $timeout seconds]
}, ALARM_CLASS } if $timeout;
alarm $timeout || 0;
### IPC::Run is first choice if $USE_IPC_RUN is set.
if( !IS_WIN32 and $USE_IPC_RUN and $self->can_use_ipc_run( 1 ) ) {
### ipc::run handlers needs the command as a string or an array ref
$self->_debug( "# Using IPC::Run. Have buffer: $have_buffer" )
if $DEBUG;
$ok = $self->_ipc_run( $cmd, $_out_handler, $_err_handler );
### since IPC::Open3 works on all platforms, and just fails on
### win32 for capturing buffers, do that ideally
} elsif ( $USE_IPC_OPEN3 and $self->can_use_ipc_open3( 1 ) ) {
$self->_debug("# Using IPC::Open3. Have buffer: $have_buffer")
if $DEBUG;
### in case there are pipes in there;
### IPC::Open3 will call exec and exec will do the right thing
my $method = IS_WIN32 ? '_open3_run_win32' : '_open3_run';
$ok = $self->$method(
$cmd, $_out_handler, $_err_handler, $verbose
);
### if we are allowed to run verbose, just dispatch the system command
} else {
$self->_debug( "# Using system(). Have buffer: $have_buffer" )
if $DEBUG;
$ok = $self->_system_run( $cmd, $verbose );
}
alarm 0;
};
### restore STDIN after duping, or STDIN will be closed for
### this current perl process!
$self->__reopen_fds( @{ $self->_fds} ) if $self->_fds;
inc/inc_IPC-Cmd/IPC/Cmd.pm view on Meta::CPAN
my $cmd = shift;
### command has a special char in it
if( ref $cmd and grep { $sc_lookup{$_} } @$cmd ) {
### since we have special chars, we have to quote white space
### this *may* conflict with the parsing :(
my $fixed;
my @cmd = map { / / ? do { $fixed++; QUOTE.$_.QUOTE } : $_ } @$cmd;
$self->_debug( "# Quoted $fixed arguments containing whitespace" )
if $DEBUG && $fixed;
### stringify it, so the special char isn't escaped as argument
### to the program
$cmd = join ' ', @cmd;
}
return $cmd;
}
}
inc/inc_IPC-Cmd/IPC/Cmd.pm view on Meta::CPAN
STDOUT => [qw|>&|, \*STDOUT, Symbol::gensym() ],
STDERR => [qw|>&|, \*STDERR, Symbol::gensym() ],
STDIN => [qw|<&|, \*STDIN, Symbol::gensym() ],
);
### dups FDs and stores them in a cache
sub __dup_fds {
my $self = shift;
my @fds = @_;
__PACKAGE__->_debug( "# Closing the following fds: @fds" ) if $DEBUG;
for my $name ( @fds ) {
my($redir, $fh, $glob) = @{$Map{$name}} or (
Carp::carp(loc("No such FD: '%1'", $name)), next );
### MUST use the 2-arg version of open for dup'ing for
### 5.6.x compatibility. 5.8.x can use 3-arg open
### see perldoc5.6.2 -f open for details
open $glob, $redir . fileno($fh) or (
Carp::carp(loc("Could not dup '$name': %1", $!)),
inc/inc_IPC-Cmd/IPC/Cmd.pm view on Meta::CPAN
}
return 1;
}
### reopens FDs from the cache
sub __reopen_fds {
my $self = shift;
my @fds = @_;
__PACKAGE__->_debug( "# Reopening the following fds: @fds" ) if $DEBUG;
for my $name ( @fds ) {
my($redir, $fh, $glob) = @{$Map{$name}} or (
Carp::carp(loc("No such FD: '%1'", $name)), next );
### MUST use the 2-arg version of open for dup'ing for
### 5.6.x compatibility. 5.8.x can use 3-arg open
### see perldoc5.6.2 -f open for details
open( $fh, $redir . fileno($glob) ) or (
Carp::carp(loc("Could not restore '$name': %1", $!)),
inc/inc_IPC-Cmd/IPC/Cmd.pm view on Meta::CPAN
);
### close this FD, we're not using it anymore
close $glob;
}
return 1;
}
}
sub _debug {
my $self = shift;
my $msg = shift or return;
my $level = shift || 0;
local $Carp::CarpLevel += $level;
Carp::carp($msg);
return 1;
}
inc/inc_IPC-Cmd/IPC/Cmd.pm view on Meta::CPAN
} elsif ( $ce & 127 ) {
### some signal
$str = loc( "'%1' died with signal %d, %s coredump\n",
$pp_cmd, ($ce & 127), ($ce & 128) ? 'with' : 'without');
} else {
### Otherwise, the command run but gave error status.
$str = "'$pp_cmd' exited with value " . ($ce >> 8);
}
$self->_debug( "# Child error '$ce' translated to: $str" ) if $DEBUG;
return $str;
}
1;
=head2 $q = QUOTE
Returns the character used for quoting strings on this platform. This is
usually a C<'> (single quote) on most systems, but some systems use different
inc/inc_Module-Build/Module/Build.pm view on Meta::CPAN
[version 0.01]
This will use C<Test::Harness> or C<TAP::Harness> to run any regression
tests and report their results. Tests can be defined in the standard
places: a file called C<test.pl> in the top-level directory, or several
files ending with C<.t> in a C<t/> directory.
If you want tests to be 'verbose', i.e. show details of test execution
rather than just summary information, pass the argument C<verbose=1>.
If you want to run tests under the perl debugger, pass the argument
C<debugger=1>.
If you want to have Module::Build find test files with different file
name extensions, pass the C<test_file_exts> argument with an array
of extensions, such as C<[qw( .t .s .z )]>.
If you want test to be run by C<TAP::Harness>, rather than C<Test::Harness>,
pass the argument C<tap_harness_args> as an array reference of arguments to
pass to the TAP::Harness constructor.
In addition, if a file called C<visual.pl> exists in the top-level
inc/inc_Module-Build/Module/Build.pm view on Meta::CPAN
To pass options to C<Devel::Cover>, set the C<$DEVEL_COVER_OPTIONS>
environment variable:
DEVEL_COVER_OPTIONS=-ignore,Build ./Build testcover
=item testdb
[version 0.05]
This is a synonym for the 'test' action with the C<debugger=1>
argument.
=item testpod
[version 0.25]
This checks all the files described in the C<docs> action and
produces C<Test::Harness>-style output. If you are a module author,
this is useful to run before creating a new release.
inc/inc_Module-Build/Module/Build.pm view on Meta::CPAN
false to prevent the custom resource file from being loaded.
=item allow_mb_mismatch
Suppresses the check upon startup that the version of Module::Build
we're now running under is the same version that was initially invoked
when building the distribution (i.e. when the C<Build.PL> script was
first run). As of 0.3601, a mismatch results in a warning instead of
a fatal error, so this option effectively just suppresses the warning.
=item debug
Prints Module::Build debugging information to STDOUT, such as a trace of
executed build actions.
=back
=head2 Default Options File (F<.modulebuildrc>)
[version 0.28]
When Module::Build starts up, it will look first for a file,
F<$ENV{HOME}/.modulebuildrc>. If it's not found there, it will look
inc/inc_Module-Build/Module/Build/API.pod view on Meta::CPAN
=item cpan_client()
=item create_license()
=item create_makefile_pl()
=item create_packlist()
=item create_readme()
=item debug()
=item debugger()
=item destdir()
=item dynamic_config()
=item get_options()
=item html_css()
=item include_dirs()
inc/inc_Module-Build/Module/Build/Base.pm view on Meta::CPAN
################## End constructors #########################
sub log_info {
my $self = shift;
print @_ if ref($self) && ( $self->verbose || ! $self->quiet );
}
sub log_verbose {
my $self = shift;
print @_ if ref($self) && $self->verbose;
}
sub log_debug {
my $self = shift;
print @_ if ref($self) && $self->debug;
}
sub log_warn {
# Try to make our call stack invisible
shift;
if (@_ and $_[-1] !~ /\n$/) {
my (undef, $file, $line) = caller();
warn @_, " at $file line $line.\n";
} else {
warn @_;
inc/inc_Module-Build/Module/Build/Base.pm view on Meta::CPAN
__PACKAGE__->add_property($_) for qw(
PL_files
autosplit
base_dir
bindoc_dirs
c_source
create_license
create_makefile_pl
create_readme
debugger
destdir
dist_abstract
dist_author
dist_name
dist_suffix
dist_version
dist_version_from
extra_compiler_flags
extra_linker_flags
has_config_data
inc/inc_Module-Build/Module/Build/Base.pm view on Meta::CPAN
program_name
quiet
recursive_test_files
release_status
script_files
scripts
share_dir
sign
test_files
verbose
debug
xs_files
);
sub config {
my $self = shift;
my $c = ref($self) ? $self->{config} : 'Module::Build::Config';
return $c->all_config unless @_;
my $key = shift;
return $c->get($key) unless @_;
inc/inc_Module-Build/Module/Build/Base.pm view on Meta::CPAN
}
sub _call_action {
my ($self, $action) = @_;
return if $self->{_completed_actions}{$action}++;
local $self->{action} = $action;
my $method = $self->can_action( $action );
die "No action '$action' defined, try running the 'help' action.\n" unless $method;
$self->log_debug("Starting ACTION_$action\n");
my $rc = $self->$method();
$self->log_debug("Finished ACTION_$action\n");
return $rc;
}
sub can_action {
my ($self, $action) = @_;
return $self->can( "ACTION_$action" );
}
# cuts the user-specified options out of the command-line args
sub cull_options {
inc/inc_Module-Build/Module/Build/Base.pm view on Meta::CPAN
test_files
use_rcfile
use_tap_harness
tap_harness_args
cpan_client
); # normalize only selected option names
return $opt;
}
my %singular_argument = map { ($_ => 1) } qw/install_base prefix destdir installdir verbose quiet uninst debug sign/;
sub _read_arg {
my ($self, $args, $key, $val) = @_;
$key = $self->_translate_option($key);
if ( exists $args->{$key} and not $singular_argument{$key} ) {
$args->{$key} = [ $args->{$key} ] unless ref $args->{$key};
push @{$args->{$key}}, $val;
} else {
inc/inc_Module-Build/Module/Build/Base.pm view on Meta::CPAN
my @bool_opts = qw(
build_bat
create_license
create_readme
pollute
quiet
uninst
use_rcfile
verbose
debug
sign
use_tap_harness
);
# inverted boolean options; eg --noverbose or --no-verbose
# converted to proper name & returned with false value (verbose, 0)
if ( grep $opt =~ /^no[-_]?$_$/, @bool_opts ) {
$opt =~ s/^no-?//;
return ($opt, 0);
}
inc/inc_Module-Build/Module/Build/Base.pm view on Meta::CPAN
sub run_visual_script {
my $self = shift;
# This will get run and the user will see the output. It doesn't
# emit Test::Harness-style output.
$self->run_perl_script('visual.pl', '-Mblib='.$self->blib)
if -e 'visual.pl';
}
sub harness_switches {
shift->{properties}{debugger} ? qw(-w -d) : ();
}
sub test_files {
my $self = shift;
my $p = $self->{properties};
if (@_) {
return $p->{test_files} = (@_ == 1 ? shift : [@_]);
}
return $self->find_test_files;
}
inc/inc_Module-Build/Module/Build/Base.pm view on Meta::CPAN
my $exts = $self->{properties}{test_file_exts};
return sort map { @{$self->rscan_dir($dir, qr{^[^.].*\Q$_\E$})} } @$exts
if $self->recursive_test_files;
return sort map { glob File::Spec->catfile($dir, "*$_") } @$exts;
}
sub ACTION_testdb {
my ($self) = @_;
local $self->{properties}{debugger} = 1;
$self->depends_on('test');
}
sub ACTION_testcover {
my ($self) = @_;
unless (Module::Build::ModuleInfo->find_module_by_name('Devel::Cover')) {
warn("Cannot run testcover action unless Devel::Cover is installed.\n");
return;
}
inc/inc_Module-Build/Module/Build/Base.pm view on Meta::CPAN
my( %prime, %alt );
foreach my $file (@{$file_list}) {
my $mapped_filename = $filename_map->{$file};
my @path = split( /\//, $mapped_filename );
(my $prime_package = join( '::', @path[1..$#path] )) =~ s/\.pm$//;
my $pm_info = Module::Build::ModuleInfo->new_from_file( $file );
foreach my $package ( $pm_info->packages_inside ) {
next if $package eq 'main'; # main can appear numerous times, ignore
next if $package eq 'DB'; # special debugging package, ignore
next if grep /^_/, split( /::/, $package ); # private package, ignore
my $version = $pm_info->version( $package );
if ( $package eq $prime_package ) {
if ( exists( $prime{$package} ) ) {
# M::B::ModuleInfo will handle this conflict
die "Unexpected conflict in '$package'; multiple versions found.\n";
} else {
$prime{$package}{file} = $mapped_filename;
inc/inc_Params-Check/Params/Check.pm view on Meta::CPAN
If set to true, L<Params::Check> will require all values passed to be
C<defined>. If you wish to enable this on a 'per key' basis, use the
template option C<defined> instead.
Default is 0;
=head2 $Params::Check::SANITY_CHECK_TEMPLATE
If set to true, L<Params::Check> will sanity check templates, validating
for errors and unknown keys. Although very useful for debugging, this
can be somewhat slow in hot-code and large loops.
To disable this check, set this variable to C<false>.
Default is 1;
=head2 $Params::Check::WARNINGS_FATAL
If set to true, L<Params::Check> will C<croak> when an error during
template validation occurs, rather than return C<false>.
( run in 1.203 second using v1.01-cache-2.11-cpan-49f99fa48dc )