Result:
found more than 407 distributions - search limited to the first 2001 files matching your query
( run in 1.666 )
Alien-libtiff
view release on metacpan or search on metacpan
6. As an exception to the Sections above, you may also combine or
link a "work that uses the Library" with the Library to produce a
work containing portions of the Library, and distribute that work
under terms of your choice, provided that the terms permit
modification of the work for the customer's own use and reverse
engineering for debugging such modifications.
You must give prominent notice with each copy of the work that the
Library is used in it and that the Library and its use are covered by
this License. You must supply a copy of this License. If the work
during execution displays copyright notices, you must include the
Alien-libuv
view release on metacpan or search on metacpan
- Only require Alien::MSYS on Windows
0.006 2017-07-10
- Bump the share version to libuv v1.13.1
- Add a recommended test install of FFI::Platypus
- Diag out the install_type for better debugging later
0.005 2017-07-08
- Updated the requirements to include Alien::m4
- Update requirements of Alien::libtool, automake, and autoconf for some
corrections
Alien-libzookeeper
view release on metacpan or search on metacpan
plugin 'Build::CMake' => ();
build [
'cd %{.install.extract}/zookeeper-client/zookeeper-client-c',
[
'%{cmake}',
'-DCMAKE_BUILD_TYPE=Release', # release, no debug symbols
'-DWANT_SYNCAPI=ON', # sync and async symbols
'-DWANT_CPPUNIT=OFF', # we don't run `make test`
'-DWITH_CYRUS_SASL:BOOL=OFF', # TODO: should probe for sasl
@{ meta->prop->{plugin_build_cmake}->{args} },
'%{.install.extract}/zookeeper-client/zookeeper-client-c',
Alien-patchelf
view release on metacpan or search on metacpan
6. As an exception to the Sections above, you may also combine or
link a "work that uses the Library" with the Library to produce a
work containing portions of the Library, and distribute that work
under terms of your choice, provided that the terms permit
modification of the work for the customer's own use and reverse
engineering for debugging such modifications.
You must give prominent notice with each copy of the work that the
Library is used in it and that the Library and its use are covered by
this License. You must supply a copy of this License. If the work
during execution displays copyright notices, you must include the
Alien-proj
view release on metacpan or search on metacpan
1.26 2023-09-25
- Share builds: add bin dirs to PATH on Windows
1.25 2022-11-26
- Share builds: use https for downloads
- Noisier tests for debug purposes
1.24 2022-03-30
- Fix dependency versions in Makefile.PL
1.23 2022-03-27
Alien-spatialite
view release on metacpan or search on metacpan
4. Combined Works.
You may convey a Combined Work under terms of your choice that,
taken together, effectively do not restrict modification of the
portions of the Library contained in the Combined Work and reverse
engineering for debugging such modifications, if you also do each of
the following:
a) Give prominent notice with each copy of the Combined Work that
the Library is used in it and that the Library and its use are
covered by this License.
Alien-sqlite
view release on metacpan or search on metacpan
4. Combined Works.
You may convey a Combined Work under terms of your choice that,
taken together, effectively do not restrict modification of the
portions of the Library contained in the Combined Work and reverse
engineering for debugging such modifications, if you also do each of
the following:
a) Give prominent notice with each copy of the Combined Work that
the Library is used in it and that the Library and its use are
covered by this License.
Alien-uv
view release on metacpan or search on metacpan
libuv/AUTHORS view on Meta::CPAN
Isaac Z. Schlueter <i@izs.me>
Pieter Noordhuis <pcnoordhuis@gmail.com>
Marek Jelen <marek@jelen.biz>
Fedor Indutny <fedor.indutny@gmail.com>
Saúl Ibarra Corretgé <saghul@gmail.com>
Felix Geisendörfer <felix@debuggable.com>
Yuki Okumura <mjt@cltn.org>
Roman Shtylman <shtylman@gmail.com>
Frank Denis <github@pureftpd.org>
Carter Allen <CarterA@opt-6.com>
Tj Holowaychuk <tj@vision-media.ca>
Alien-wxWidgets
view release on metacpan or search on metacpan
inc/My/Build/Any_wx_config.pm view on Meta::CPAN
our @CONTRIB_LIBRARIES = qw(gizmos_xrc ogl plot svg);
our @CRITICAL = qw(base core);
our @IMPORTANT = qw(net xml adv aui gl html media richtext stc xrc );
my $initialized;
my( $wx_debug, $wx_unicode, $wx_monolithic );
sub _find {
my( $name ) = @_;
return $name if File::Spec->file_name_is_absolute( $name );
inc/My/Build/Any_wx_config.pm view on Meta::CPAN
$build->notes( 'wx_config' => _find( $wx_config ) )
if $build && !$build->notes( 'wx_config' );
$ver = __PACKAGE__->_version_2_dec( $ver );
my $base = `$wx_config --basename`;
$wx_debug = $base =~ m/d$/ ? 1 : 0;
$wx_unicode = $base =~ m/ud?$/ ? 1 : 0;
$WX_CONFIG_LIBSEP = `$wx_config --libs base > /dev/null 2>&1 || echo 'X'` eq "X\n" ? '=' : ' ';
$wx_monolithic = `$wx_config --libs${WX_CONFIG_LIBSEP}adv` eq
`$wx_config --libs${WX_CONFIG_LIBSEP}core`;
sub awx_is_debug {
$_[0]->notes( 'build_wx' )
? $_[0]->SUPER::awx_is_debug
: $wx_debug;
}
sub awx_is_unicode {
$_[0]->notes( 'build_wx' )
? $_[0]->SUPER::awx_is_unicode
: $wx_unicode;
inc/My/Build/Any_wx_config.pm view on Meta::CPAN
die 'PANIC: ', $self->wx_config( 'basename' );
$config{config}{toolkit} = lc $1;
}
$config{compiler} = $ENV{CXX} || $self->wx_config( 'cxx' );
if( $self->awx_debug ) {
$config{c_flags} .= ' -g ';
}
my $cccflags = $self->wx_config( 'cxxflags' );
my $libs = $self->wx_config( 'libs' );
inc/My/Build/Any_wx_config.pm view on Meta::CPAN
my $compiler = $ENV{CXX} || $Config{ccname} || $Config{cc};
my $key = $self->awx_get_name
( toolkit => $self->awx_build_toolkit,
version => $self->_version_2_dec
( $self->notes( 'build_data' )->{data}{version} ),
debug => $self->awx_is_debug,
unicode => $self->awx_is_unicode,
mslu => $self->awx_is_mslu,
# it is unlikely it will ever be required under *nix
$self->notes( 'build_wx' ) ? () :
( compiler => $self->awx_compiler_kind( $compiler ),
inc/My/Build/Any_wx_config.pm view on Meta::CPAN
my $opengl = $self->notes( 'build_wx_opengl' );
my $args = sprintf '--with-%s %s--disable-compat24',
$self->awx_build_toolkit,
$opengl ? '--with-opengl ' : '';
my $unicode = $self->awx_is_unicode ? 'enable' : 'disable';
my $debug = '';
if( $self->awx_version_type == 2 ) {
$debug = ( $self->awx_debug ) ? '--enable-debug' : '--disable-debug';
} else {
$debug = ( $self->awx_debug ) ? '--enable-debug=max' : '';
}
my $monolithic = $self->awx_is_monolithic ? 'enable' : 'disable';
my $universal = $self->awx_is_universal ? 'enable' : 'disable';
my $dir = $self->notes( 'build_data' )->{data}{directory};
my $cmd = "echo exit | " . # for OS X 10.3...
"sh ../configure --prefix=$prefix $args --$unicode-unicode"
. " $debug --$monolithic-monolithic"
. " --$universal-universal_binary $extra_flags";
my $old_dir = Cwd::cwd;
chdir $dir;
Alien-xmake
view release on metacpan or search on metacpan
builder/xmake.pm view on Meta::CPAN
sub download {
my ( $s, $url, $path ) = @_;
my $local = File::Spec->rel2abs( File::Spec->catfile( $s->cwd, $path ) );
my $response = $s->http->mirror( $url, $local );
if ( $response->{success} ) {
$s->log_debug( 'Install executable mirrored at ' . $local );
$s->make_executable($local); # get it ready to run
return $local;
}
$s->log_debug( 'Status: [' . $response->{status} . '] ' . $response->{content} );
$s->log_warn( 'Failed to download ' . $response->{url} );
return ();
}
#~ sub download_shget {
#~ my ($s) = @_;
#~ my $local = File::Spec->rel2abs( File::Spec->catfile( $s->cwd, 'xmake_installer.sh' ) );
#~ my $response = $s->http->mirror( $installer_sh, $local );
#~ if ( $response->{success} ) {
#~ $s->log_debug( 'Install script mirrored at ' . $local );
#~ $s->make_executable($local); # get it ready to run
#~ return $local;
#~ }
#~ $s->log_debug( 'Status: [' . $response->{status} . '] ' . $response->{content} );
#~ $s->log_warn( 'Failed to download installer script from ' . $response->{url} );
#~ exit 1;
#~ }
sub gather_info {
my ( $s, $xmake ) = @_;
AlignDB-IntSpanXS
view release on metacpan or search on metacpan
debop||5.005000|
debprofdump||5.005000|
debprof|||
debstackptrs||5.007003|
debstack||5.007003|
debug_start_match|||
deb||5.007003|v
del_sv|||
delete_eval_scope|||
delimcpy||5.004000|
deprecate_old|||
get_av|5.006000||p
get_context||5.006000|n
get_cvn_flags||5.009005|
get_cv|5.006000||p
get_db_sub|||
get_debug_opts|||
get_hash_seed|||
get_hv|5.006000||p
get_mstats|||
get_no_modify|||
get_num|||
incline|||
incpush_if_exists|||
incpush|||
ingroup|||
init_argv_symbols|||
init_debugger|||
init_global_struct|||
init_i18nl10n||5.006000|
init_i18nl14n||5.006000|
init_ids|||
init_interp|||
rsignal_save|||
rsignal_state||5.004000|
rsignal||5.004000|
run_body|||
run_user_filter|||
runops_debug||5.005000|
runops_standard||5.005000|
rvpv_dup|||
rxres_free|||
rxres_restore|||
rxres_save|||
unpackstring||5.008001|
unshare_hek_or_pvn|||
unshare_hek|||
unsharepvn||5.004000|
unwind_handler_stack|||
update_debugger_info|||
upg_version||5.009005|
usage|||
utf16_to_utf8_reversed||5.006001|
utf16_to_utf8||5.006001|
utf8_distance||5.006000|
Alister-Base-Sums
view release on metacpan or search on metacpan
lib/Alister/Base/Sums.pm view on Meta::CPAN
$layout =~s/\t+| {2,}/ /g;
for my $sql ( split( /\;/, $layout) ){
$sql=~/\w/ or next;
debug("layout [$sql]\n");
debug('-');
$dbh->do($sql)
or die($dbh->errstr);
}
debug("Done.");
#$self->dbh->commit; should commit at script level instead
1;
}
lib/Alister/Base/Sums.pm view on Meta::CPAN
if ( validate_argument_sum($arg) ){
my $sth = $dbh->prepare("UPDATE $TABLE_NAME SET sum = ? WHERE sum = ?");
my $r = $sth->execute($new_sum, $arg);
$sth->finish;
debug("result '$r'") if $r;
return (($r and $r eq '0E0') ? 0 : $r);
}
elsif( validate_argument_id($arg) ){
my $sth = $dbh->prepare("UPDATE $TABLE_NAME SET sum = ? WHERE id = ?");
my $r = $sth->execute($new_sum, $arg);
$sth->finish;
debug("result '$r'") if $r;
return (($r and $r eq '0E0') ? 0 : $r);
}
else {
AllKnowingDNS
view release on metacpan or search on metacpan
script/all-knowing-dns view on Meta::CPAN
'help' => sub {
say "all-knowing-dns [--configfile <path>] [--querylog]";
say "";
say "\t--configfile <path>\tSpecifies an alternate configfile location.";
say "\t\t\t\tThe default is /etc/all-knowing-dns.conf";
say "\t--querylog\t\tLogs every query to stdout (for debugging).";
say "";
exit 0;
},
);
script/all-knowing-dns view on Meta::CPAN
Use I<path> instead of /etc/all-knowing-dns.conf as configuration file.
=item B<--querylog>
Enable logging every query to stdout (for debugging).
=back
=head1 CONFIGURATION FILE (/etc/all-knowing-dns.conf)
Alt-Acme-Math-XS-CPP
view release on metacpan or search on metacpan
inc/Capture/Tiny.pm view on Meta::CPAN
##our $DEBUG = $ENV{PERL_CAPTURE_TINY_DEBUG};
##
##my $DEBUGFH;
##open $DEBUGFH, "> DEBUG" if $DEBUG;
##
##*_debug = $DEBUG ? sub(@) { print {$DEBUGFH} @_ } : sub(){0};
our $TIMEOUT = 30;
#--------------------------------------------------------------------------#
# command to tee output -- the argument is a filename that must
inc/Capture/Tiny.pm view on Meta::CPAN
# filehandle manipulation
#--------------------------------------------------------------------------#
sub _relayer {
my ($fh, $layers) = @_;
# _debug("# requested layers (@{$layers}) for @{[fileno $fh]}\n");
my %seen = ( unix => 1, perlio => 1 ); # filter these out
my @unique = grep { !$seen{$_}++ } @$layers;
# _debug("# applying unique layers (@unique) to @{[fileno $fh]}\n");
binmode($fh, join(":", ":raw", @unique));
}
sub _name {
my $glob = shift;
inc/Capture/Tiny.pm view on Meta::CPAN
return *{$glob}{NAME};
}
sub _open {
open $_[0], $_[1] or Carp::confess "Error from open(" . join(q{, }, @_) . "): $!";
# _debug( "# open " . join( ", " , map { defined $_ ? _name($_) : 'undef' } @_ ) . " as " . fileno( $_[0] ) . "\n" );
}
sub _close {
# _debug( "# closing " . ( defined $_[0] ? _name($_[0]) : 'undef' ) . " on " . fileno( $_[0] ) . "\n" );
close $_[0] or Carp::confess "Error from close(" . join(q{, }, @_) . "): $!";
}
my %dup; # cache this so STDIN stays fd0
my %proxy_count;
inc/Capture/Tiny.pm view on Meta::CPAN
my %proxies;
if ( ! defined fileno STDIN ) {
$proxy_count{stdin}++;
if (defined $dup{stdin}) {
_open \*STDIN, "<&=" . fileno($dup{stdin});
# _debug( "# restored proxy STDIN as " . (defined fileno STDIN ? fileno STDIN : 'undef' ) . "\n" );
}
else {
_open \*STDIN, "<" . File::Spec->devnull;
# _debug( "# proxied STDIN as " . (defined fileno STDIN ? fileno STDIN : 'undef' ) . "\n" );
_open $dup{stdin} = IO::Handle->new, "<&=STDIN";
}
$proxies{stdin} = \*STDIN;
binmode(STDIN, ':utf8') if $] >= 5.008;
}
if ( ! defined fileno STDOUT ) {
$proxy_count{stdout}++;
if (defined $dup{stdout}) {
_open \*STDOUT, ">&=" . fileno($dup{stdout});
# _debug( "# restored proxy STDOUT as " . (defined fileno STDOUT ? fileno STDOUT : 'undef' ) . "\n" );
}
else {
_open \*STDOUT, ">" . File::Spec->devnull;
# _debug( "# proxied STDOUT as " . (defined fileno STDOUT ? fileno STDOUT : 'undef' ) . "\n" );
_open $dup{stdout} = IO::Handle->new, ">&=STDOUT";
}
$proxies{stdout} = \*STDOUT;
binmode(STDOUT, ':utf8') if $] >= 5.008;
}
if ( ! defined fileno STDERR ) {
$proxy_count{stderr}++;
if (defined $dup{stderr}) {
_open \*STDERR, ">&=" . fileno($dup{stderr});
# _debug( "# restored proxy STDERR as " . (defined fileno STDERR ? fileno STDERR : 'undef' ) . "\n" );
}
else {
_open \*STDERR, ">" . File::Spec->devnull;
# _debug( "# proxied STDERR as " . (defined fileno STDERR ? fileno STDERR : 'undef' ) . "\n" );
_open $dup{stderr} = IO::Handle->new, ">&=STDERR";
}
$proxies{stderr} = \*STDERR;
binmode(STDERR, ':utf8') if $] >= 5.008;
}
return %proxies;
}
sub _unproxy {
my (%proxies) = @_;
# _debug( "# unproxying: " . join(" ", keys %proxies) . "\n" );
for my $p ( keys %proxies ) {
$proxy_count{$p}--;
# _debug( "# unproxied " . uc($p) . " ($proxy_count{$p} left)\n" );
if ( ! $proxy_count{$p} ) {
_close $proxies{$p};
_close $dup{$p} unless $] < 5.008; # 5.6 will have already closed this as dup
delete $dup{$p};
}
inc/Capture/Tiny.pm view on Meta::CPAN
sub _start_tee {
my ($which, $stash) = @_; # $which is "stdout" or "stderr"
# setup pipes
$stash->{$_}{$which} = IO::Handle->new for qw/tee reader/;
pipe $stash->{reader}{$which}, $stash->{tee}{$which};
# _debug( "# pipe for $which\: " . _name($stash->{tee}{$which}) . " " . fileno( $stash->{tee}{$which} ) . " => " . _name($stash->{reader}{$which}) . " " . fileno( $stash->{reader}{$which}) . "\n" );
select((select($stash->{tee}{$which}), $|=1)[0]); # autoflush
# setup desired redirection for parent and child
$stash->{new}{$which} = $stash->{tee}{$which};
$stash->{child}{$which} = {
stdin => $stash->{reader}{$which},
inc/Capture/Tiny.pm view on Meta::CPAN
$stash->{flag_files}{$which} = scalar tmpnam();
# execute @cmd as a separate process
if ( $IS_WIN32 ) {
local $@;
eval "use Win32API::File qw/CloseHandle GetOsFHandle SetHandleInformation fileLastError HANDLE_FLAG_INHERIT INVALID_HANDLE_VALUE/ ";
# _debug( "# Win32API::File loaded\n") unless $@;
my $os_fhandle = GetOsFHandle( $stash->{tee}{$which} );
# _debug( "# Couldn't get OS handle: " . fileLastError() . "\n") if ! defined $os_fhandle || $os_fhandle == INVALID_HANDLE_VALUE();
my $result = SetHandleInformation( $os_fhandle, HANDLE_FLAG_INHERIT(), 0);
# _debug( $result ? "# set no-inherit flag on $which tee\n" : ("# can't disable tee handle flag inherit: " . fileLastError() . "\n"));
_open_std( $stash->{child}{$which} );
$stash->{pid}{$which} = system(1, @cmd, $stash->{flag_files}{$which});
# not restoring std here as it all gets redirected again shortly anyway
}
else { # use fork
inc/Capture/Tiny.pm view on Meta::CPAN
my $pid = fork;
if ( not defined $pid ) {
Carp::confess "Couldn't fork(): $!";
}
elsif ($pid == 0) { # child
# _debug( "# in child process ...\n" );
untie *STDIN; untie *STDOUT; untie *STDERR;
_close $stash->{tee}{$which};
# _debug( "# redirecting handles in child ...\n" );
_open_std( $stash->{child}{$which} );
# _debug( "# calling exec on command ...\n" );
exec @cmd, $stash->{flag_files}{$which};
}
$stash->{pid}{$which} = $pid
}
inc/Capture/Tiny.pm view on Meta::CPAN
}
sub _kill_tees {
my ($stash) = @_;
if ( $IS_WIN32 ) {
# _debug( "# closing handles with CloseHandle\n");
CloseHandle( GetOsFHandle($_) ) for values %{ $stash->{tee} };
# _debug( "# waiting for subprocesses to finish\n");
my $start = time;
1 until wait == -1 || (time - $start > 30);
}
else {
_close $_ for values %{ $stash->{tee} };
inc/Capture/Tiny.pm view on Meta::CPAN
}
sub _slurp {
my ($name, $stash) = @_;
my ($fh, $pos) = map { $stash->{$_}{$name} } qw/capture pos/;
# _debug( "# slurping captured $name from " . fileno($fh) . " at pos $pos with layers: @{[PerlIO::get_layers($fh)]}\n");
seek( $fh, $pos, 0 ) or die "Couldn't seek on capture handle for $name\n";
my $text = do { local $/; scalar readline $fh };
return defined($text) ? $text : "";
}
#--------------------------------------------------------------------------#
# _capture_tee() -- generic main sub for capturing or teeing
#--------------------------------------------------------------------------#
sub _capture_tee {
# _debug( "# starting _capture_tee with (@_)...\n" );
my ($do_stdout, $do_stderr, $do_merge, $do_tee, $code, @opts) = @_;
my %do = ($do_stdout ? (stdout => 1) : (), $do_stderr ? (stderr => 1) : ());
Carp::confess("Custom capture options must be given as key/value pairs\n")
unless @opts % 2 == 0;
my $stash = { capture => { @opts } };
inc/Capture/Tiny.pm view on Meta::CPAN
my %layers = (
stdin => [PerlIO::get_layers(\*STDIN) ],
stdout => [PerlIO::get_layers(\*STDOUT, output => 1)],
stderr => [PerlIO::get_layers(\*STDERR, output => 1)],
);
# _debug( "# existing layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
# get layers from underlying glob of tied filehandles if we can
# (this only works for things that work like Tie::StdHandle)
$layers{stdout} = [PerlIO::get_layers(tied *STDOUT)]
if tied(*STDOUT) && (reftype tied *STDOUT eq 'GLOB');
$layers{stderr} = [PerlIO::get_layers(tied *STDERR)]
if tied(*STDERR) && (reftype tied *STDERR eq 'GLOB');
# _debug( "# tied object corrected layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
# bypass scalar filehandles and tied handles
# localize scalar STDIN to get a proxy to pick up FD0, then restore later to CT_ORIG_STDIN
my %localize;
$localize{stdin}++, local(*STDIN)
if grep { $_ eq 'scalar' } @{$layers{stdin}};
inc/Capture/Tiny.pm view on Meta::CPAN
if tied *STDIN && $] >= 5.008;
$localize{stdout}++, local(*STDOUT), _open( \*STDOUT, ">&=1")
if $do_stdout && tied *STDOUT && $] >= 5.008;
$localize{stderr}++, local(*STDERR), _open( \*STDERR, ">&=2")
if ($do_stderr || $do_merge) && tied *STDERR && $] >= 5.008;
# _debug( "# localized $_\n" ) for keys %localize;
# proxy any closed/localized handles so we don't use fds 0, 1 or 2
my %proxy_std = _proxy_std();
# _debug( "# proxy std: @{ [%proxy_std] }\n" );
# update layers after any proxying
$layers{stdout} = [PerlIO::get_layers(\*STDOUT, output => 1)] if $proxy_std{stdout};
$layers{stderr} = [PerlIO::get_layers(\*STDERR, output => 1)] if $proxy_std{stderr};
# _debug( "# post-proxy layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
# store old handles and setup handles for capture
$stash->{old} = _copy_std();
$stash->{new} = { %{$stash->{old}} }; # default to originals
for ( keys %do ) {
$stash->{new}{$_} = ($stash->{capture}{$_} ||= File::Temp->new);
seek( $stash->{capture}{$_}, 0, 2 ) or die "Could not seek on capture handle for $_\n";
$stash->{pos}{$_} = tell $stash->{capture}{$_};
# _debug("# will capture $_ on " . fileno($stash->{capture}{$_})."\n" );
_start_tee( $_ => $stash ) if $do_tee; # tees may change $stash->{new}
}
_wait_for_tees( $stash ) if $do_tee;
# finalize redirection
$stash->{new}{stderr} = $stash->{new}{stdout} if $do_merge;
# _debug( "# redirecting in parent ...\n" );
_open_std( $stash->{new} );
# execute user provided code
my ($exit_code, $inner_error, $outer_error, @result);
{
local *STDIN = *CT_ORIG_STDIN if $localize{stdin}; # get original, not proxy STDIN
# _debug( "# finalizing layers ...\n" );
_relayer(\*STDOUT, $layers{stdout}) if $do_stdout;
_relayer(\*STDERR, $layers{stderr}) if $do_stderr;
# _debug( "# running code $code ...\n" );
local $@;
eval { @result = $code->(); $inner_error = $@ };
$exit_code = $?; # save this for later
$outer_error = $@; # save this for later
}
# restore prior filehandles and shut down tees
# _debug( "# restoring filehandles ...\n" );
_open_std( $stash->{old} );
_close( $_ ) for values %{$stash->{old}}; # don't leak fds
# shouldn't need relayering originals, but see rt.perl.org #114404
_relayer(\*STDOUT, $layers{stdout}) if $do_stdout;
_relayer(\*STDERR, $layers{stderr}) if $do_stderr;
_unproxy( %proxy_std );
# _debug( "# killing tee subprocesses ...\n" ) if $do_tee;
_kill_tees( $stash ) if $do_tee;
# return captured output, but shortcut in void context
# unless we have to echo output to tied/scalar handles;
my %got;
if ( defined wantarray or ($do_tee && keys %localize) ) {
for ( keys %do ) {
_relayer($stash->{capture}{$_}, $layers{$_});
$got{$_} = _slurp($_, $stash);
# _debug("# slurped " . length($got{$_}) . " bytes from $_\n");
}
print CT_ORIG_STDOUT $got{stdout}
if $do_stdout && $do_tee && $localize{stdout};
print CT_ORIG_STDERR $got{stderr}
if $do_stderr && $do_tee && $localize{stderr};
}
$? = $exit_code;
$@ = $inner_error if $inner_error;
die $outer_error if $outer_error;
# _debug( "# ending _capture_tee with (@_)...\n" );
return unless defined wantarray;
my @return;
push @return, $got{stdout} if $do_stdout;
push @return, $got{stderr} if $do_stderr && ! $do_merge;
push @return, @result;
Alt-Acme-Math-XS-ModuleBuild
view release on metacpan or search on metacpan
inc/Inline/C.pm view on Meta::CPAN
\"$cmd\" with error code $errcode
The build directory was:
$build_dir
To debug the problem, cd to the build directory, and inspect the output files.
END
if ($cmd =~ /^make >/) {
for (sort keys %ENV) {
$output .= "Environment $_ = '$ENV{$_}'\n" if /^(?:MAKE|PATH)/;
Alt-Acme-Math-XS-ModuleInstall
view release on metacpan or search on metacpan
inc/Inline/C.pm view on Meta::CPAN
\"$cmd\" with error code $errcode
The build directory was:
$build_dir
To debug the problem, cd to the build directory, and inspect the output files.
END
if ($cmd =~ /^make >/) {
for (sort keys %ENV) {
$output .= "Environment $_ = '$ENV{$_}'\n" if /^(?:MAKE|PATH)/;
Alt-App-makepatch
view release on metacpan or search on metacpan
script/applypatch view on Meta::CPAN
my $force = 0; # allow continuation after trunc/corruption
# Development options (not shown with -help).
my $trace = 0; # trace (show process)
my $test = 0; # test (no actual processing)
my $debug = 0; # extensive debugging info
## Misc
my $applypatch = 0; # it's for us
my $timestamp; # create date/time of patch kit
script/applypatch view on Meta::CPAN
sub verify_files ();
################ Program parameters ################
app_options();
$trace ||= $debug;
$verbose ||= $trace;
################ Presets ################
$patch .= " -s" unless $verbose;
script/applypatch view on Meta::CPAN
print STDERR ("+ $patch\n") if $trace;
if ( $applypatch ) {
my $lines = 0;
while ( <$tmpfile> ) {
chomp;
print STDERR ("++ ", $_, "\n") if $debug;
next if $_ eq "#### Patch data follows ####";
last if $_ eq "#### End of Patch data ####";
$p = _open_patch() unless $p;
print $p ($_, "\n");
$lines++;
script/applypatch view on Meta::CPAN
'verbose' => \$verbose,
'quiet' => sub { $verbose = 0; },
'patch=s' => \$patch,
'test' => \$test,
'trace' => \$trace,
'debug' => \$debug,
'help' => \$help);
(!GetOptions (@opts) || $help) && app_usage (2);
}
Alt-CPAN-Uploader-tinyua
view release on metacpan or search on metacpan
lib/CPAN/Uploader.pm view on Meta::CPAN
user - (required) your CPAN / PAUSE id
password - (required) your CPAN / PAUSE password
subdir - the directory (under your home directory) to upload to
http_proxy - uri of the http proxy to use
upload_uri - uri of the upload handler; usually the default (PAUSE) is right
debug - if set to true, spew lots more debugging output
This method attempts to actually upload the named file to the CPAN. It will
raise an exception on error.
=cut
lib/CPAN/Uploader.pm view on Meta::CPAN
} else {
die "request failed with error code ", $response->status,
"\n Message: ", $response->reason, "\n";
}
} else {
$self->log_debug($_) for (
"Looks OK!",
"----- RESPONSE BEGIN -----\n" .
$response->content . "\n" .
"----- RESPONSE END -------\n"
);
lib/CPAN/Uploader.pm view on Meta::CPAN
sub log {
shift;
print "$_[0]\n"
}
=method log_debug
This method behaves like C<L</log>>, but only logs the message if the
CPAN::Uploader is in debug mode.
=cut
sub log_debug {
my $self = shift;
return unless $self->{debug};
$self->log($_[0]);
}
1;
Alt-CWB-CL-ambs
view release on metacpan or search on metacpan
lib/CWB/CL.pm view on Meta::CPAN
set_strict_mode($on_off ? 1 : 0);
}
return $current_mode;
}
# set CL debugging level (0=no, 1=some, 2=all debugging messages)
sub set_debug_level ( $ ) {
my $lvl = shift;
$lvl = 0 if (lc $lvl) eq "none";
$lvl = 1 if (lc $lvl) eq "some";
$lvl = 2 if (lc $lvl) eq "all";
croak "Usage: CWB::CL::set_debug_level('none' | 'some' | 'all');"
unless $lvl =~ /^[012]$/;
CWB::CL::cl_set_debug_level($lvl);
}
# set CL memory limit (used only by makeall so far, so no point in setting it here)
sub set_memory_limit ( $ ) {
my $mb = shift;
lib/CWB/CL.pm view on Meta::CPAN
print "Registry path = ", $CWB::CL::Registry, "\n";
$CWB::CL::Registry .= ":/home/my_registry"; # add your own registry directory
# "strict" mode aborts if any error occurs (convenient in one-off scripts)
CWB::CL::strict(1); # or simply load CWB::CL::Strict module
CWB::CL::set_debug_level('some'); # 'some', 'all' or 'none' (default)
# CWB::CL::Corpus objects
$corpus = new CWB::CL::Corpus "HANSARD-EN"; # name of corpus can be upper or lower case
die "Error: can't access corpus HANSARD-EN" # all error conditions return undef
unless defined $corpus; # (checks are not needed in "strict" mode)
Alt-CWB-ambs
view release on metacpan or search on metacpan
lib/CWB/CQP.pm view on Meta::CPAN
## handling of CQP progress messages
$self->{'progress'} = 0; # whether progress messages are activated
$self->{'progress_handler'} = undef; # optional callback for progress messages
$self->{'progress_info'} = []; # contains last available progress information: [$total_percent, $pass, $n_passes, $message, $percent]
## debugging (prints more or less everything on stdout)
$self->{'debug'} = 0;
## select vectors for CQP output (stdout, stderr, stdout|stderr)
$self->{'select_err'} = new IO::Select($err);
$self->{'select_out'} = new IO::Select($out);
$self->{'select_any'} = new IO::Select($err, $out);
lib/CWB/CQP.pm view on Meta::CPAN
sub run {
croak 'USAGE: $cqp->run($cmd]);'
unless @_ == 2;
my $self = shift;
my $cmd = shift;
my $debug = $self->{'debug'};
$cmd =~ s/\n+/ /g; # make sure there are no newline characters (to be on the safe side)
$cmd =~ s/(;\s*)+$//; # ";" will be added when $cmd is sent to CQP
my $active_cmd = $self->{'command'};
lib/CWB/CQP.pm view on Meta::CPAN
$self->{'buffer'} = "";
$self->{'lines'} = [];
$self->{'error_message'} = [];
print "CQP << $cmd;\n"
if $debug;
$self->{'in'}->print("$cmd;\n .EOL.;\n"); # append .EOL. command to mark end of CQP output
}
=item I<$num_of_lines> = I<$cqp>->B<ready>;
lib/CWB/CQP.pm view on Meta::CPAN
croak 'USAGE: $line = $cqp->getline;'
unless @_ == 1;
my $self = shift;
croak 'CWB::CQP: $cqp->getline called without active CQP command'
unless $self->{'command'};
my $debug = $self->{'debug'};
$self->_update(-1) # fill line buffer if necessary (blocking mode)
unless @{$self->{'lines'}} > 0;
my $line = shift @{$self->{'lines'}};
if ($line eq '-::-EOL-::-') {
## special line printed by ".EOL.;" marks end of CQP output
print "CQP ", "-" x 60, "\n"
if $debug;
$self->_eol;
return undef; # undef return value marks end of output
}
else {
print "CQP >> $line\n"
if $debug;
return $line;
}
}
=item I<@lines> = I<$cqp>->B<getlines>(I<$n>);
lib/CWB/CQP.pm view on Meta::CPAN
sub exec {
croak 'USAGE: $cqp->exec($cmd);'
unless @_ == 2;
my $self = shift;
my $cmd = shift;
my $debug = $self->{'debug'};
$self->run($cmd);
my @result = $self->getlines(-1);
my $eol = pop @result;
if (defined $eol) {
lib/CWB/CQP.pm view on Meta::CPAN
sub _error_handler_ignore {
# do nothing
}
=item I<$cqp>->B<debug>(1);
=item I<$cqp>->B<debug>(0);
Activate/deactivate debugging mode, which logs all executed commands and their complete output on STDOUT. The B<debug> method returns the previous status for convenience.
=cut
sub debug {
croak 'USAGE: $prev_status = $cqp->debug( 1 | 0 ) ;'
unless @_ == 2;
my $self = shift;
my $on = shift;
my $prev = $self->{'debug'};
$self->{'debug'} = $on;
return $prev;
}
=item I<$cqp>->B<progress_on>;
Alt-Crypt-OpenSSL-PKCS12-Broadbean
view release on metacpan or search on metacpan
DEBUG_SBOX32_HASH|5.027001||Viu
DEBUG_SCOPE|5.008001||Viu
DEBUG_s_FLAG|5.007001||Viu
DEBUG_S_FLAG|5.017002||Viu
DEBUG_STACK_r|5.009005||Viu
debug_start_match|5.009004||Viu
DEBUG_STATE_r|5.009004||Viu
DEBUG_s_TEST|5.007001||Viu
DEBUG_S_TEST|5.017002||Viu
DEBUG_t|5.003007||Viu
DEBUG_T|5.007001||Viu
get_cv|5.006000|5.003007|p
get_cvn_flags|5.009005|5.003007|p
get_cvs|5.011000|5.003007|p
getcwd_sv|5.007002|5.007002|
get_db_sub|||iu
get_debug_opts|5.008001||Viu
get_deprecated_property_msg|5.031011||cVniu
getegid|5.005000||Viu
getenv|5.005000||Viu
getenv_len|5.006000||Viu
GETENV_LOCK|5.033005||Viu
ingroup|5.003007||Viu
INIT|5.003007||Viu
init_argv_symbols|5.007003||Viu
init_constants|5.017003||Viu
init_dbargs|||iu
init_debugger|5.005000||Viu
init_i18nl10n|5.006000||cVu
init_i18nl14n|5.006000||dcVu
initialize_invlist_guts|5.029002||Viu
init_ids|5.005000||Viu
init_interp|5.005000||Viu
magic_freemglob|5.033004||Viu
magic_freeovrld|5.007001||Viu
magic_freeutf8|5.033004||Viu
magic_get|5.003007||Viu
magic_getarylen|5.003007||Viu
magic_getdebugvar|5.021005||Viu
magic_getdefelem|5.004000||Viu
magic_getnkeys|5.004005||Viu
magic_getpack|5.003007||Viu
magic_getpos|5.003007||Viu
magic_getsig|5.003007||Viu
magic_set|5.003007||Viu
magic_set_all_env|5.004004||Viu
magic_setarylen|5.003007||Viu
magic_setcollxfrm|5.004000||Viu
magic_setdbline|5.003007||Viu
magic_setdebugvar|5.021005||Viu
magic_setdefelem|5.004000||Viu
magic_setenv|5.003007||Viu
magic_sethint|5.009004||Vi
magic_sethint_feature|5.031007||Viu
magic_setisa|5.003007||Viu
PERL_deBruijnMagic32|5.035003||Viu
PERL_deBruijnMagic64|5.035003||Viu
PERL_deBruijnShift32|5.035003||Viu
PERL_deBruijnShift64|5.035003||Viu
PERL_DEBUG|5.008001||Viu
Perl_debug_log|5.003007||Viu
PERL_DEBUG_PAD|5.007003||Viu
PERL_DEBUG_PAD_ZERO|5.007003||Viu
PERL_DECIMAL_VERSION|5.019008||Viu
PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION|5.009003||Viu
perl_destruct|5.007003|5.007003|n
PERLIOBUF_DEFAULT_BUFSIZ|5.013007||Viu
PerlIO_canset_cnt|5.003007|5.003007|n
PerlIO_clearerr|5.007003|5.007003|
PerlIO_close|5.007003|5.007003|
PerlIO_context_layers|||u
PerlIO_debug|5.007001|5.007001|
PERLIO_DUP_CLONE|5.007003||Viu
PERLIO_DUP_FD|5.007003||Viu
PerlIO_eof|5.007003|5.007003|
PerlIO_error|5.007003|5.007003|
PerlIO_exportFILE|5.003007|5.003007|n
PERL_MAGIC_bm|5.007002|5.003007|p
PERL_MAGIC_checkcall|5.013006|5.013006|
PERL_MAGIC_collxfrm|5.007002|5.003007|p
PERL_MAGIC_dbfile|5.007002|5.003007|p
PERL_MAGIC_dbline|5.007002|5.003007|p
PERL_MAGIC_debugvar|5.021005|5.021005|
PERL_MAGIC_defelem|5.007002|5.003007|p
PERL_MAGIC_env|5.007002|5.003007|p
PERL_MAGIC_envelem|5.007002|5.003007|p
PERL_MAGIC_ext|5.007002|5.003007|p
PERL_MAGIC_fm|5.007002|5.003007|p
PL_DBsingle_iv|5.021005||Viu
PL_DBsub|5.005000||pV
PL_DBtrace|5.005000||pV
PL_DBtrace_iv|5.021005||Viu
PL_debstash|5.005000|5.003007|poVnu
PL_debug|5.005000||Viu
PL_debug_pad|5.007003||Viu
PL_defgv|5.004005|5.003007|p
PL_def_layerlist|5.007003||Viu
PL_defoutgv|5.005000||Viu
PL_defstash|5.005000||Viu
PL_delaymagic|5.005000||Viu
PL_maxsysfd|5.005000|5.005000|
PL_mbrlen_ps|5.031010||Viu
PL_mbrtowc_ps|5.031010||Viu
PL_Mem|5.006000||Viu
PL_mem_log|5.033005||Viu
PL_memory_debug_header|5.009004||Viu
PL_MemParse|5.006000||Viu
PL_MemShared|5.006000||Viu
PL_mess_sv|5.005000|5.004000|poVnu
PL_min_intro_pending|5.005000||Viu
PL_minus_a|5.005000||Viu
PL_vtbl_backref|5.015000||Viu
PL_vtbl_bm|5.015000||Viu
PL_vtbl_checkcall|5.017000||Viu
PL_vtbl_collxfrm|5.015000||Viu
PL_vtbl_dbline|5.015000||Viu
PL_vtbl_debugvar|5.021005||Viu
PL_vtbl_defelem|5.015000||Viu
PL_vtbl_env|5.015000||Viu
PL_vtbl_envelem|5.015000||Viu
PL_vtbl_fm|5.015000||Viu
PL_vtbl_hints|5.015000||Viu
reg_named_buff_nextkey|5.009005||cVu
reg_named_buff_scalar|5.009005||cVu
regnext|5.003007||cVu
reg_node|5.005000||Viu
regnode_guts|5.021005||Viu
regnode_guts_debug|||Viu
REGNODE_MAX|5.009004||Viu
REGNODE_SIMPLE|5.013002||Viu
REGNODE_VARIES|5.013002||Viu
reg_numbered_buff_fetch|5.009005||cViu
reg_numbered_buff_length|5.009005||cViu
RsPARA|5.003007||Viu
RsRECORD|5.005000||Viu
RsSIMPLE|5.003007||Viu
RsSNARF|5.003007||Viu
run_body|5.006000||Viu
runops_debug|5.005000||cVu
RUNOPS_DEFAULT|5.005000||Viu
runops_standard|5.005000||cVu
run_user_filter|5.009003||Viu
rv2cv_op_cv|5.013006|5.013006|
RV2CVOPCV_FLAG_MASK|5.021004||Viu
SETHOSTENT_R_PROTO|5.008000|5.008000|Vn
SETi|5.003007||Viu
setjmp|5.005000||Viu
setlinebuf|5.005000||Viu
setlocale|5.009000||Viu
setlocale_debug_string|5.027002||Vniu
SETLOCALE_LOCK|5.033005||Viu
SETLOCALE_R_PROTO|5.008000|5.008000|Vn
SETLOCALE_UNLOCK|5.033005||Viu
SET_MARK_OFFSET|5.006000||Viu
setmode|5.005000||Viu
unreferenced_to_tmp_stack|5.013002||Viu
unshare_hek|5.004000||Viu
unshare_hek_or_pvn|5.008000||Viu
unsharepvn|5.003007|5.003007|u
unwind_handler_stack|5.009003||Viu
update_debugger_info|5.009005||Viu
upg_version|5.009005|5.009005|
UPG_VERSION|5.019008||Viu
uproot_SV|||Viu
Uquad_t|5.006000|5.006000|Vn
U_S|5.003007||Viu
Alt-Crypt-RSA-BigInt
view release on metacpan or search on metacpan
inc/Devel/CheckLib.pm view on Meta::CPAN
$cfile,
(map { "-I$_" } @incpaths),
"-o", "$exefile"
);
}
warn "# @sys_cmd\n" if $args{debug};
my $rv = $args{debug} ? system(@sys_cmd) : _quiet_system(@sys_cmd);
push @missing, $header if $rv != 0 || ! -x $exefile;
_cleanup_exe($exefile);
unlink $ofile if -e $ofile;
unlink $cfile;
}
inc/Devel/CheckLib.pm view on Meta::CPAN
(map { "-I$_" } @incpaths),
(map { "-L$_" } @libpaths),
"-l$lib",
);
}
warn "# @sys_cmd\n" if $args{debug};
my $rv = $args{debug} ? system(@sys_cmd) : _quiet_system(@sys_cmd);
push @missing, $lib if $rv != 0 || ! -x $exefile;
my $absexefile = File::Spec->rel2abs($exefile);
$absexefile = '"'.$absexefile.'"' if $absexefile =~ m/\s/;
push @wrongresult, $lib if $rv == 0 && -x $exefile && system($absexefile) != 0;
unlink $ofile if -e $ofile;
Alt-Devel-GlobalDestruction-XS-Inline
view release on metacpan or search on metacpan
inc/Inline/C.pm view on Meta::CPAN
\"$cmd\" with error code $errcode
The build directory was:
$build_dir
To debug the problem, cd to the build directory, and inspect the output files.
END
if ($cmd =~ /^make >/) {
for (sort keys %ENV) {
$output .= "Environment $_ = '$ENV{$_}'\n" if /^(?:MAKE|PATH)/;
Alt-ExtUtils-PkgConfig-PLICEASE
view release on metacpan or search on metacpan
6. As an exception to the Sections above, you may also
combine or link a "work that uses the Library" with the
Library to produce a work containing portions of the Library,
and distribute that work under terms of your choice, provided
that the terms permit modification of the work for the
customer's own use and reverse engineering for debugging
such modifications.
You must give prominent notice with each copy of the work
that the Library is used in it and that the Library and its use
are covered by this License. You must supply a copy of this
Alt-IO-All-new
view release on metacpan or search on metacpan
inc/Pegex/Optimizer.pm view on Meta::CPAN
$rule->{action} = $action;
}
elsif (my $gotrule = $self->receiver->can("gotrule")) {
$rule->{action} = $gotrule;
}
if ($self->parser->{debug}) {
$node->{method} = $self->make_trace_wrapper($node->{method});
}
}
elsif ($node->{kind} eq 'rgx') {
# XXX $node;
Alt-Lexical-Var-ButSupportModernPerl
view release on metacpan or search on metacpan
lib/Lexical/Var.pm view on Meta::CPAN
Perls you must use the C<&> sigil, as in "C<&foo(123)>".
Where a scalar name is defined to refer to a constant (read-only) scalar,
references to the constant through the lexical namespace can participate
in compile-time constant folding. This can avoid the need to check
configuration values (such as whether debugging is enabled) at runtime.
A name definition supplied by this module takes effect from the end of the
definition statement up to the end of the immediately enclosing block,
except where it is shadowed within a nested block. This is the same
lexical scoping that the C<my>, C<our>, and C<state> keywords supply.
Alt-Math-Prime-FastSieve-Inline
view release on metacpan or search on metacpan
inc/Capture/Tiny.pm view on Meta::CPAN
##our $DEBUG = $ENV{PERL_CAPTURE_TINY_DEBUG};
##
##my $DEBUGFH;
##open $DEBUGFH, "> DEBUG" if $DEBUG;
##
##*_debug = $DEBUG ? sub(@) { print {$DEBUGFH} @_ } : sub(){0};
our $TIMEOUT = 30;
#--------------------------------------------------------------------------#
# command to tee output -- the argument is a filename that must
inc/Capture/Tiny.pm view on Meta::CPAN
# filehandle manipulation
#--------------------------------------------------------------------------#
sub _relayer {
my ($fh, $layers) = @_;
# _debug("# requested layers (@{$layers}) for @{[fileno $fh]}\n");
my %seen = ( unix => 1, perlio => 1 ); # filter these out
my @unique = grep { !$seen{$_}++ } @$layers;
# _debug("# applying unique layers (@unique) to @{[fileno $fh]}\n");
binmode($fh, join(":", ":raw", @unique));
}
sub _name {
my $glob = shift;
inc/Capture/Tiny.pm view on Meta::CPAN
return *{$glob}{NAME};
}
sub _open {
open $_[0], $_[1] or Carp::confess "Error from open(" . join(q{, }, @_) . "): $!";
# _debug( "# open " . join( ", " , map { defined $_ ? _name($_) : 'undef' } @_ ) . " as " . fileno( $_[0] ) . "\n" );
}
sub _close {
# _debug( "# closing " . ( defined $_[0] ? _name($_[0]) : 'undef' ) . " on " . fileno( $_[0] ) . "\n" );
close $_[0] or Carp::confess "Error from close(" . join(q{, }, @_) . "): $!";
}
my %dup; # cache this so STDIN stays fd0
my %proxy_count;
inc/Capture/Tiny.pm view on Meta::CPAN
my %proxies;
if ( ! defined fileno STDIN ) {
$proxy_count{stdin}++;
if (defined $dup{stdin}) {
_open \*STDIN, "<&=" . fileno($dup{stdin});
# _debug( "# restored proxy STDIN as " . (defined fileno STDIN ? fileno STDIN : 'undef' ) . "\n" );
}
else {
_open \*STDIN, "<" . File::Spec->devnull;
# _debug( "# proxied STDIN as " . (defined fileno STDIN ? fileno STDIN : 'undef' ) . "\n" );
_open $dup{stdin} = IO::Handle->new, "<&=STDIN";
}
$proxies{stdin} = \*STDIN;
binmode(STDIN, ':utf8') if $] >= 5.008;
}
if ( ! defined fileno STDOUT ) {
$proxy_count{stdout}++;
if (defined $dup{stdout}) {
_open \*STDOUT, ">&=" . fileno($dup{stdout});
# _debug( "# restored proxy STDOUT as " . (defined fileno STDOUT ? fileno STDOUT : 'undef' ) . "\n" );
}
else {
_open \*STDOUT, ">" . File::Spec->devnull;
# _debug( "# proxied STDOUT as " . (defined fileno STDOUT ? fileno STDOUT : 'undef' ) . "\n" );
_open $dup{stdout} = IO::Handle->new, ">&=STDOUT";
}
$proxies{stdout} = \*STDOUT;
binmode(STDOUT, ':utf8') if $] >= 5.008;
}
if ( ! defined fileno STDERR ) {
$proxy_count{stderr}++;
if (defined $dup{stderr}) {
_open \*STDERR, ">&=" . fileno($dup{stderr});
# _debug( "# restored proxy STDERR as " . (defined fileno STDERR ? fileno STDERR : 'undef' ) . "\n" );
}
else {
_open \*STDERR, ">" . File::Spec->devnull;
# _debug( "# proxied STDERR as " . (defined fileno STDERR ? fileno STDERR : 'undef' ) . "\n" );
_open $dup{stderr} = IO::Handle->new, ">&=STDERR";
}
$proxies{stderr} = \*STDERR;
binmode(STDERR, ':utf8') if $] >= 5.008;
}
return %proxies;
}
sub _unproxy {
my (%proxies) = @_;
# _debug( "# unproxying: " . join(" ", keys %proxies) . "\n" );
for my $p ( keys %proxies ) {
$proxy_count{$p}--;
# _debug( "# unproxied " . uc($p) . " ($proxy_count{$p} left)\n" );
if ( ! $proxy_count{$p} ) {
_close $proxies{$p};
_close $dup{$p} unless $] < 5.008; # 5.6 will have already closed this as dup
delete $dup{$p};
}
inc/Capture/Tiny.pm view on Meta::CPAN
sub _start_tee {
my ($which, $stash) = @_; # $which is "stdout" or "stderr"
# setup pipes
$stash->{$_}{$which} = IO::Handle->new for qw/tee reader/;
pipe $stash->{reader}{$which}, $stash->{tee}{$which};
# _debug( "# pipe for $which\: " . _name($stash->{tee}{$which}) . " " . fileno( $stash->{tee}{$which} ) . " => " . _name($stash->{reader}{$which}) . " " . fileno( $stash->{reader}{$which}) . "\n" );
select((select($stash->{tee}{$which}), $|=1)[0]); # autoflush
# setup desired redirection for parent and child
$stash->{new}{$which} = $stash->{tee}{$which};
$stash->{child}{$which} = {
stdin => $stash->{reader}{$which},
inc/Capture/Tiny.pm view on Meta::CPAN
$stash->{flag_files}{$which} = scalar tmpnam();
# execute @cmd as a separate process
if ( $IS_WIN32 ) {
local $@;
eval "use Win32API::File qw/CloseHandle GetOsFHandle SetHandleInformation fileLastError HANDLE_FLAG_INHERIT INVALID_HANDLE_VALUE/ ";
# _debug( "# Win32API::File loaded\n") unless $@;
my $os_fhandle = GetOsFHandle( $stash->{tee}{$which} );
# _debug( "# Couldn't get OS handle: " . fileLastError() . "\n") if ! defined $os_fhandle || $os_fhandle == INVALID_HANDLE_VALUE();
my $result = SetHandleInformation( $os_fhandle, HANDLE_FLAG_INHERIT(), 0);
# _debug( $result ? "# set no-inherit flag on $which tee\n" : ("# can't disable tee handle flag inherit: " . fileLastError() . "\n"));
_open_std( $stash->{child}{$which} );
$stash->{pid}{$which} = system(1, @cmd, $stash->{flag_files}{$which});
# not restoring std here as it all gets redirected again shortly anyway
}
else { # use fork
inc/Capture/Tiny.pm view on Meta::CPAN
my $pid = fork;
if ( not defined $pid ) {
Carp::confess "Couldn't fork(): $!";
}
elsif ($pid == 0) { # child
# _debug( "# in child process ...\n" );
untie *STDIN; untie *STDOUT; untie *STDERR;
_close $stash->{tee}{$which};
# _debug( "# redirecting handles in child ...\n" );
_open_std( $stash->{child}{$which} );
# _debug( "# calling exec on command ...\n" );
exec @cmd, $stash->{flag_files}{$which};
}
$stash->{pid}{$which} = $pid
}
inc/Capture/Tiny.pm view on Meta::CPAN
}
sub _kill_tees {
my ($stash) = @_;
if ( $IS_WIN32 ) {
# _debug( "# closing handles with CloseHandle\n");
CloseHandle( GetOsFHandle($_) ) for values %{ $stash->{tee} };
# _debug( "# waiting for subprocesses to finish\n");
my $start = time;
1 until wait == -1 || (time - $start > 30);
}
else {
_close $_ for values %{ $stash->{tee} };
inc/Capture/Tiny.pm view on Meta::CPAN
}
sub _slurp {
my ($name, $stash) = @_;
my ($fh, $pos) = map { $stash->{$_}{$name} } qw/capture pos/;
# _debug( "# slurping captured $name from " . fileno($fh) . " at pos $pos with layers: @{[PerlIO::get_layers($fh)]}\n");
seek( $fh, $pos, 0 ) or die "Couldn't seek on capture handle for $name\n";
my $text = do { local $/; scalar readline $fh };
return defined($text) ? $text : "";
}
#--------------------------------------------------------------------------#
# _capture_tee() -- generic main sub for capturing or teeing
#--------------------------------------------------------------------------#
sub _capture_tee {
# _debug( "# starting _capture_tee with (@_)...\n" );
my ($do_stdout, $do_stderr, $do_merge, $do_tee, $code, @opts) = @_;
my %do = ($do_stdout ? (stdout => 1) : (), $do_stderr ? (stderr => 1) : ());
Carp::confess("Custom capture options must be given as key/value pairs\n")
unless @opts % 2 == 0;
my $stash = { capture => { @opts } };
inc/Capture/Tiny.pm view on Meta::CPAN
my %layers = (
stdin => [PerlIO::get_layers(\*STDIN) ],
stdout => [PerlIO::get_layers(\*STDOUT, output => 1)],
stderr => [PerlIO::get_layers(\*STDERR, output => 1)],
);
# _debug( "# existing layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
# get layers from underlying glob of tied filehandles if we can
# (this only works for things that work like Tie::StdHandle)
$layers{stdout} = [PerlIO::get_layers(tied *STDOUT)]
if tied(*STDOUT) && (reftype tied *STDOUT eq 'GLOB');
$layers{stderr} = [PerlIO::get_layers(tied *STDERR)]
if tied(*STDERR) && (reftype tied *STDERR eq 'GLOB');
# _debug( "# tied object corrected layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
# bypass scalar filehandles and tied handles
# localize scalar STDIN to get a proxy to pick up FD0, then restore later to CT_ORIG_STDIN
my %localize;
$localize{stdin}++, local(*STDIN)
if grep { $_ eq 'scalar' } @{$layers{stdin}};
inc/Capture/Tiny.pm view on Meta::CPAN
if tied *STDIN && $] >= 5.008;
$localize{stdout}++, local(*STDOUT), _open( \*STDOUT, ">&=1")
if $do_stdout && tied *STDOUT && $] >= 5.008;
$localize{stderr}++, local(*STDERR), _open( \*STDERR, ">&=2")
if ($do_stderr || $do_merge) && tied *STDERR && $] >= 5.008;
# _debug( "# localized $_\n" ) for keys %localize;
# proxy any closed/localized handles so we don't use fds 0, 1 or 2
my %proxy_std = _proxy_std();
# _debug( "# proxy std: @{ [%proxy_std] }\n" );
# update layers after any proxying
$layers{stdout} = [PerlIO::get_layers(\*STDOUT, output => 1)] if $proxy_std{stdout};
$layers{stderr} = [PerlIO::get_layers(\*STDERR, output => 1)] if $proxy_std{stderr};
# _debug( "# post-proxy layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
# store old handles and setup handles for capture
$stash->{old} = _copy_std();
$stash->{new} = { %{$stash->{old}} }; # default to originals
for ( keys %do ) {
$stash->{new}{$_} = ($stash->{capture}{$_} ||= File::Temp->new);
seek( $stash->{capture}{$_}, 0, 2 ) or die "Could not seek on capture handle for $_\n";
$stash->{pos}{$_} = tell $stash->{capture}{$_};
# _debug("# will capture $_ on " . fileno($stash->{capture}{$_})."\n" );
_start_tee( $_ => $stash ) if $do_tee; # tees may change $stash->{new}
}
_wait_for_tees( $stash ) if $do_tee;
# finalize redirection
$stash->{new}{stderr} = $stash->{new}{stdout} if $do_merge;
# _debug( "# redirecting in parent ...\n" );
_open_std( $stash->{new} );
# execute user provided code
my ($exit_code, $inner_error, $outer_error, @result);
{
local *STDIN = *CT_ORIG_STDIN if $localize{stdin}; # get original, not proxy STDIN
# _debug( "# finalizing layers ...\n" );
_relayer(\*STDOUT, $layers{stdout}) if $do_stdout;
_relayer(\*STDERR, $layers{stderr}) if $do_stderr;
# _debug( "# running code $code ...\n" );
local $@;
eval { @result = $code->(); $inner_error = $@ };
$exit_code = $?; # save this for later
$outer_error = $@; # save this for later
}
# restore prior filehandles and shut down tees
# _debug( "# restoring filehandles ...\n" );
_open_std( $stash->{old} );
_close( $_ ) for values %{$stash->{old}}; # don't leak fds
# shouldn't need relayering originals, but see rt.perl.org #114404
_relayer(\*STDOUT, $layers{stdout}) if $do_stdout;
_relayer(\*STDERR, $layers{stderr}) if $do_stderr;
_unproxy( %proxy_std );
# _debug( "# killing tee subprocesses ...\n" ) if $do_tee;
_kill_tees( $stash ) if $do_tee;
# return captured output, but shortcut in void context
# unless we have to echo output to tied/scalar handles;
my %got;
if ( defined wantarray or ($do_tee && keys %localize) ) {
for ( keys %do ) {
_relayer($stash->{capture}{$_}, $layers{$_});
$got{$_} = _slurp($_, $stash);
# _debug("# slurped " . length($got{$_}) . " bytes from $_\n");
}
print CT_ORIG_STDOUT $got{stdout}
if $do_stdout && $do_tee && $localize{stdout};
print CT_ORIG_STDERR $got{stderr}
if $do_stderr && $do_tee && $localize{stderr};
}
$? = $exit_code;
$@ = $inner_error if $inner_error;
die $outer_error if $outer_error;
# _debug( "# ending _capture_tee with (@_)...\n" );
return unless defined wantarray;
my @return;
push @return, $got{stdout} if $do_stdout;
push @return, $got{stderr} if $do_stderr && ! $do_merge;
push @return, @result;
Alt-common-sense-TOBYINK
view release on metacpan or search on metacpan
lib/Alt/common/sense/TOBYINK.pm view on Meta::CPAN
use strict qw(vars subs);
use feature qw(say state switch);
use feature qw(unicode_strings current_sub fc evalbytes);
no feature qw(array_base);
no warnings;
use warnings qw(FATAL closed threads internal debugging pack
portable prototype inplace io pipe unpack malloc
deprecated glob digit printf layer
reserved taint closure semicolon);
no warnings qw(exec newline unopened);
Alt
view release on metacpan or search on metacpan
You should add this line to your alternate modules:
use Alt::IO::All::MSTROUT;
That way the Alt:: module gets loaded any time you "use IO::All"
(with the alternate version installed). This gives debugging clues
since the Alt:: module is now in %INC.
Other Concerns
If you have em, I(ngy) would like to know them. Discuss on
#toolchain on irc.perl.org for now.
( run in 1.666 second using v1.01-cache-2.11-cpan-49f99fa48dc )