Acme-Sort-Sleep
view release on metacpan or search on metacpan
local/lib/perl5/IO/Async/ChildManager.pm view on Meta::CPAN
my $kid = $loop->fork(
code => sub {
# Child
close( $readpipe );
$self->_spawn_in_child( $writepipe, $code, \@setup );
},
);
# Parent
close( $writepipe );
return $self->_spawn_in_parent( $readpipe, $kid, $on_exit );
}
=head2 C<setup> array
This array gives a list of file descriptor operations to perform in the child
process after it has been C<fork(2)>ed from the parent, before running the code
or command. It consists of name/value pairs which are ordered; the operations
are performed in the order given.
=over 8
=item fdI<n> => ARRAY
Gives an operation on file descriptor I<n>. The first element of the array
defines the operation to be performed:
local/lib/perl5/IO/Async/ChildManager.pm view on Meta::CPAN
else {
croak "Unrecognised setup operation '$key'";
}
push @setup, $key => $value;
}
return @setup;
}
sub _spawn_in_parent
{
my $self = shift;
my ( $readpipe, $kid, $on_exit ) = @_;
my $loop = $self->{loop};
# We need to wait for both the errno pipe to close, and for waitpid
# to give us an exit code. We'll form two closures over these two
# variables so we can cope with those happening in either order
local/lib/perl5/IO/Async/Debug.pm view on Meta::CPAN
C<IO_ASYNC_DEBUG> having a true value.
When debugging is enabled, the C<make_event_cb> and C<invoke_event> methods
on L<IO::Async::Notifier> (and their C<maybe_> variants) are altered such that
when the event is fired, a debugging line is printed, using the C<debug_printf>
method. This identifes the name of the event.
By default, the line is only printed if the caller of one of these methods is
the same package as the object is blessed into, allowing it to print the
events of the most-derived class, without the extra verbosity of the
lower-level events of its parent class used to create it. All calls regardless
of caller can be printed by setting a number greater than 1 as the value of
C<IO_ASYNC_DEBUG>.
By default the debugging log goes to C<STDERR>, but two other environment
variables can redirect it. If C<IO_ASYNC_DEBUG_FILE> is set, it names a file
which will be opened for writing, and logging written into it. Otherwise, if
C<IO_ASYNC_DEBUG_FD> is set, it gives a file descriptor number that logging
should be written to. If opening the named file or file descriptor fails then
the log will be written to C<STDERR> as normal.
local/lib/perl5/IO/Async/Function.pm view on Meta::CPAN
invocation of it. It can be called multiple times, by the C<call> method.
Multiple outstanding invocations can be called; they will be dispatched in
the order they were queued. If only one worker process is used then results
will be returned in the order they were called. If multiple are used, then
each request will be sent in the order called, but timing differences between
each worker may mean results are returned in a different order.
Since the code block will be called multiple times within the same child
process, it must take care not to modify any of its state that might affect
subsequent calls. Since it executes in a child process, it cannot make any
modifications to the state of the parent program. Therefore, all the data
required to perform its task must be represented in the call arguments, and
all of the result must be represented in the return values.
The Function object is implemented using an L<IO::Async::Routine> with two
L<IO::Async::Channel> objects to pass calls into and results out from it.
The L<IO::Async> framework generally provides mechanisms for multiplexing IO
tasks between different handles, so there aren't many occasions when such an
asynchronous function is necessary. Two cases where this does become useful
are:
local/lib/perl5/IO/Async/Function.pm view on Meta::CPAN
exists $params{$_} and $self->{$_} = delete $params{$_} for qw( exit_on_die max_calls );
$self->SUPER::configure( %params );
}
sub stop
{
my $worker = shift;
$worker->{arg_channel}->close;
if( my $function = $worker->parent ) {
delete $function->{workers}{$worker->id};
if( $worker->{busy} ) {
$worker->{remove_on_idle}++;
}
else {
$function->remove_child( $worker );
}
}
}
local/lib/perl5/IO/Async/Function.pm view on Meta::CPAN
my ( $worker ) = @_;
$worker->stop;
return Future->fail( "closed", "closed" );
} )
)->on_ready( $worker->_capture_weakself( sub {
my ( $worker, $f ) = @_;
$worker->{busy} = 0;
my $function = $worker->parent;
$function->_dispatch_pending if $function;
$function->remove_child( $worker ) if $function and $worker->{remove_on_idle};
}));
}
=head1 EXAMPLES
=head2 Extended Error Information on Failure
local/lib/perl5/IO/Async/Handle.pm view on Meta::CPAN
}
sub _closed
{
my $self = shift;
$self->maybe_invoke_event( on_closed => );
if( $self->{close_futures} ) {
$_->done for @{ $self->{close_futures} };
}
$self->remove_from_parent;
}
=head2 close_read
=head2 close_write
$handle->close_read
$handle->close_write
local/lib/perl5/IO/Async/Internals/TimeQueue.pm view on Meta::CPAN
my $self = shift;
return $self->val->{time};
}
sub code
{
my $self = shift;
return $self->val->{code};
}
# This only uses methods so is transparent to HASH or ARRAY
sub cmp
{
my $self = shift;
my $other = shift;
$self->time <=> $other->time;
}
0x55AA;
local/lib/perl5/IO/Async/Loop.pm view on Meta::CPAN
this way, entire sections of a program may be written within a tree of
notifier objects, and added or removed on one piece.
=cut
sub add
{
my $self = shift;
my ( $notifier ) = @_;
if( defined $notifier->parent ) {
croak "Cannot add a child notifier directly - add its parent";
}
if( defined $notifier->loop ) {
croak "Cannot add a notifier that is already a member of a loop";
}
$self->_add_noparentcheck( $notifier );
}
sub _add_noparentcheck
{
my $self = shift;
my ( $notifier ) = @_;
my $nkey = refaddr $notifier;
$self->{notifiers}->{$nkey} = $notifier;
$notifier->__set_loop( $self );
$self->_add_noparentcheck( $_ ) for $notifier->children;
return;
}
=head2 remove
$loop->remove( $notifier )
This method removes a notifier object from the stored collection, and
recursively and children notifiers it contains.
=cut
sub remove
{
my $self = shift;
my ( $notifier ) = @_;
if( defined $notifier->parent ) {
croak "Cannot remove a child notifier directly - remove its parent";
}
$self->_remove_noparentcheck( $notifier );
}
sub _remove_noparentcheck
{
my $self = shift;
my ( $notifier ) = @_;
my $nkey = refaddr $notifier;
exists $self->{notifiers}->{$nkey} or croak "Notifier does not exist in collection";
delete $self->{notifiers}->{$nkey};
$notifier->__set_loop( undef );
$self->_remove_noparentcheck( $_ ) for $notifier->children;
return;
}
=head2 notifiers
@notifiers = $loop->notifiers
Returns a list of all the notifier objects currently stored in the Loop.
local/lib/perl5/IO/Async/Loop.pm view on Meta::CPAN
$self->__new_feature( "IO::Async::ChildManager" );
$childmanager->spawn_child( %params );
}
=head2 open_child
$pid = $loop->open_child( %params )
This creates a new child process to run the given code block or command, and
attaches filehandles to it that the parent will watch. This method is a light
wrapper around constructing a new L<IO::Async::Process> object, provided
largely for backward compatibility. New code ought to construct such an object
directly, as it may provide more features than are available here.
The C<%params> hash takes the following keys:
=over 8
=item command => ARRAY or STRING
local/lib/perl5/IO/Async/LoopTests.pm view on Meta::CPAN
SKIP: {
skip "This OS does not have signals", 1 unless IO::Async::OS->HAVE_SIGNALS;
# We require that SIGTERM perform its default action; i.e. terminate the
# process. Ensure this definitely happens, in case the test harness has it
# ignored or handled elsewhere.
local $SIG{TERM} = "DEFAULT";
$kid = run_in_child {
sleep( 10 );
# Just in case the parent died already and didn't kill us
exit( 0 );
};
$loop->watch_child( $kid => sub { ( undef, $exitcode ) = @_; } );
kill SIGTERM, $kid;
undef $exitcode;
wait_for { defined $exitcode };
local/lib/perl5/IO/Async/Notifier.pm view on Meta::CPAN
=head2 adopt_future
$f = $notifier->adopt_future( $f )
Stores a reference to the L<Future> instance within the notifier itself, so
the reference doesn't get lost. This reference will be dropped when the future
becomes ready (either by success or failure). Additionally, if the future
failed the notifier's C<invoke_error> method will be informed.
This means that if the notifier does not provide an C<on_error> handler, nor
is there one anywhere in the parent chain, this will be fatal to the caller of
C<< $f->fail >>. To avoid this being fatal if the failure is handled
elsewhere, use the C<else_done> method on the future to obtain a sequence one
that never fails.
$notifier->adopt_future( $f->else_done() )
The future itself is returned.
=cut
local/lib/perl5/IO/Async/Notifier.pm view on Meta::CPAN
return $f;
}
=head1 CHILD NOTIFIERS
During the execution of a program, it may be the case that certain IO handles
cause other handles to be created; for example, new sockets that have been
C<accept()>ed from a listening socket. To facilitate these, a notifier may
contain child notifier objects, that are automatically added to or removed
from the L<IO::Async::Loop> that manages their parent.
=cut
=head2 parent
$parent = $notifier->parent
Returns the parent of the notifier, or C<undef> if does not have one.
=cut
sub parent
{
my $self = shift;
return $self->{IO_Async_Notifier__parent};
}
=head2 children
@children = $notifier->children
Returns a list of the child notifiers contained within this one.
=cut
local/lib/perl5/IO/Async/Notifier.pm view on Meta::CPAN
my $self = shift;
return unless $self->{IO_Async_Notifier__children};
return @{ $self->{IO_Async_Notifier__children} };
}
=head2 add_child
$notifier->add_child( $child )
Adds a child notifier. This notifier will be added to the containing loop, if
the parent has one. Only a notifier that does not currently have a parent and
is not currently a member of any loop may be added as a child. If the child
itself has grandchildren, these will be recursively added to the containing
loop.
=cut
sub add_child
{
my $self = shift;
my ( $child ) = @_;
croak "Cannot add a child that already has a parent" if defined $child->{IO_Async_Notifier__parent};
croak "Cannot add a child that is already a member of a loop" if defined $child->loop;
if( defined( my $loop = $self->loop ) ) {
$loop->add( $child );
}
push @{ $self->{IO_Async_Notifier__children} }, $child;
$child->{IO_Async_Notifier__parent} = $self;
weaken( $child->{IO_Async_Notifier__parent} );
return;
}
=head2 remove_child
$notifier->remove_child( $child )
Removes a child notifier. The child will be removed from the containing loop,
if the parent has one. If the child itself has grandchildren, these will be
recurively removed from the loop.
=cut
sub remove_child
{
my $self = shift;
my ( $child ) = @_;
LOOP: {
my $childrenref = $self->{IO_Async_Notifier__children};
for my $i ( 0 .. $#$childrenref ) {
next unless $childrenref->[$i] == $child;
splice @$childrenref, $i, 1, ();
last LOOP;
}
croak "Cannot remove child from a parent that doesn't contain it";
}
undef $child->{IO_Async_Notifier__parent};
if( defined( my $loop = $self->loop ) ) {
$loop->remove( $child );
}
}
=head2 remove_from_parent
$notifier->remove_from_parent
Removes this notifier object from its parent (either another notifier object
or the containing loop) if it has one. If the notifier is not a child of
another notifier nor a member of a loop, this method does nothing.
=cut
sub remove_from_parent
{
my $self = shift;
if( my $parent = $self->parent ) {
$parent->remove_child( $self );
}
elsif( my $loop = $self->loop ) {
$loop->remove( $self );
}
}
=head1 SUBCLASS METHODS
C<IO::Async::Notifier> is a base class provided so that specific subclasses of
it provide more specific behaviour. The base class provides a number of
local/lib/perl5/IO/Async/Notifier.pm view on Meta::CPAN
=cut
=head2 debug_printf
$notifier->debug_printf( $format, @args )
Conditionally print a debugging message to C<STDERR> if debugging is enabled.
If such a message is printed, it will be printed using C<printf> using the
given format and arguments. The message will be prefixed with an string, in
square brackets, to help identify the C<$notifier> instance. This string will
be the class name of the notifier, and any parent notifiers it is contained
by, joined by an arrow C<< <- >>. To ensure this string does not grow too
long, certain prefixes are abbreviated:
IO::Async::Protocol:: => IaP:
IO::Async:: => Ia:
Net::Async:: => Na:
Finally, each notifier that has a name defined using the C<notifier_name>
parameter has that name appended in braces.
local/lib/perl5/IO/Async/Notifier.pm view on Meta::CPAN
my $self = shift;
my ( $format, @args ) = @_;
my @id;
while( $self ) {
push @id, ref $self;
my $name = $self->notifier_name;
$id[-1] .= "{$name}" if defined $name and length $name;
$self = $self->parent;
}
s/^IO::Async::Protocol::/IaP:/,
s/^IO::Async::/Ia:/,
s/^Net::Async::/Na:/ for @id;
IO::Async::Debug::logf "[%s] $format\n", join("<-", @id), @args;
}
sub _debug_printf_event
local/lib/perl5/IO/Async/Notifier.pm view on Meta::CPAN
( $class eq $caller ? $event_name : "${str_caller}::$event_name" )
);
}
}
=head2 invoke_error
$notifier->invoke_error( $message, $name, @details )
Invokes the stored C<on_error> event handler, passing in the given arguments.
If no handler is defined, it will be passed up to the containing parent
notifier, if one exists. If no parent exists, the error message will be thrown
as an exception by using C<die()> and this method will not return.
If a handler is found to handle this error, the method will return as normal.
However, as the expected use-case is to handle "fatal" errors that now render
the notifier unsuitable to continue, code should be careful not to perform any
further work after invoking it. Specifically, sockets may become disconnected,
or the entire notifier may now be removed from its containing loop.
The C<$name> and C<@details> list should follow similar semantics to L<Future>
failures. That is, the C<$name> should be a string giving a category of
local/lib/perl5/IO/Async/Notifier.pm view on Meta::CPAN
sub invoke_error
{
my $self = shift;
my ( $message, $name, @details ) = @_;
if( my $code = $self->{IO_Async_Notifier__on_error} || $self->can( "on_error" ) ) {
return $code->( $self, $message, $name, @details );
}
if( my $parent = $self->parent ) {
return $parent->invoke_error( @_ );
}
die "$message\n";
}
=head1 AUTHOR
Paul Evans <leonerd@leonerd.org.uk>
=cut
local/lib/perl5/IO/Async/OS.pm view on Meta::CPAN
( $rdA, $wrA, $rdB, $wrB ) = IO::Async::OS->pipequad
This method is intended for creating two pairs of filehandles that are linked
together, suitable for passing as the STDIN/STDOUT pair to a child process.
After this function returns, C<$rdA> and C<$wrA> will be a linked pair, as
will C<$rdB> and C<$wrB>.
On platforms that support C<socketpair(2)>, this implementation will be
preferred, in which case C<$rdA> and C<$wrB> will actually be the same
filehandle, as will C<$rdB> and C<$wrA>. This saves a file descriptor in the
parent process.
When creating a L<IO::Async::Stream> or subclass of it, the C<read_handle>
and C<write_handle> parameters should always be used.
my ( $childRd, $myWr, $myRd, $childWr ) = IO::Async::OS->pipequad;
IO::Async::OS->open_child(
stdin => $childRd,
stdout => $childWr,
...
local/lib/perl5/IO/Async/PID.pm view on Meta::CPAN
# on_exit continuation gets passed PID value; need to replace that with
# $self
$self->{cb} ||= $self->_replace_weakself( sub {
my $self = shift or return;
my ( $exitcode ) = @_;
$self->invoke_event( on_exit => $exitcode );
# Since this is a oneshot, we'll have to remove it from the loop or
# parent Notifier
$self->remove_from_parent;
} );
$loop->watch_child( $self->pid, $self->{cb} );
}
sub _remove_from_loop
{
my $self = shift;
my ( $loop ) = @_;
local/lib/perl5/IO/Async/Process.pm view on Meta::CPAN
=item via => STRING
Configures how this file descriptor will be configured for the child process.
Must be given one of the following mode names:
=over 4
=item pipe_read
The child will be given the writing end of a C<pipe(2)>; the parent may read
from the other.
=item pipe_write
The child will be given the reading end of a C<pipe(2)>; the parent may write
to the other. Since an EOF condition of this kind of handle cannot reliably be
detected, C<on_finish> will not wait for this type of pipe to be closed.
=item pipe_rdwr
Only valid on the C<stdio> filehandle. The child will be given the reading end
of one C<pipe(2)> on STDIN and the writing end of another on STDOUT. A single
Stream object will be created in the parent configured for both filehandles.
=item socketpair
The child will be given one end of a C<socketpair(2)>; the parent will be
given the other. The family of this socket may be given by the extra key
called C<family>; defaulting to C<unix>. The socktype of this socket may be
given by the extra key called C<socktype>; defaulting to C<stream>. If the
type is not C<SOCK_STREAM> then a L<IO::Async::Socket> object will be
constructed for the parent side of the handle, rather than
L<IO::Async::Stream>.
=back
Once the filehandle is set up, the C<fd> method (or its shortcuts of C<stdin>,
C<stdout> or C<stderr>) may be used to access the
L<IO::Async::Handle>-subclassed object wrapped around it.
The value of this argument is implied by any of the following alternatives.
local/lib/perl5/IO/Async/Process.pm view on Meta::CPAN
# All the rest are fd\d+
foreach ( keys %setup_params ) {
my ( $fd ) = m/^fd(\d+)$/ or croak "Expected 'fd\\d+'";
$self->configure_fd( $fd, %{ $setup_params{$_} } );
}
$self->SUPER::configure( %params );
}
# These are from the perspective of the parent
use constant FD_VIA_PIPEREAD => 1;
use constant FD_VIA_PIPEWRITE => 2;
use constant FD_VIA_PIPERDWR => 3; # Only valid for stdio pseudo-fd
use constant FD_VIA_SOCKETPAIR => 4;
my %via_names = (
pipe_read => FD_VIA_PIPEREAD,
pipe_write => FD_VIA_PIPEWRITE,
pipe_rdwr => FD_VIA_PIPERDWR,
socketpair => FD_VIA_SOCKETPAIR,
local/lib/perl5/IO/Async/Process.pm view on Meta::CPAN
if( $is_code ? $dollarat eq "" : $dollarbang == 0 ) {
$self->invoke_event( on_finish => $exitcode );
}
else {
$self->maybe_invoke_event( on_exception => $dollarat, $dollarbang, $exitcode ) or
# Don't have a way to report dollarbang/dollarat
$self->invoke_event( on_finish => $exitcode );
}
$self->remove_from_parent;
} ),
);
}
sub DESTROY
{
my $self = shift;
$self->{finish_future}->cancel if $self->{finish_future};
}
local/lib/perl5/IO/Async/Routine.pm view on Meta::CPAN
$self->maybe_invoke_event( on_die => $exception );
}),
);
foreach ( @channels_in ) {
my ( $ch, $wr ) = @$_;
$ch->setup_async_mode( write_handle => $wr );
$self->add_child( $ch ) unless $ch->parent;
}
foreach ( @channels_out ) {
my ( $ch, $rd ) = @$_;
$ch->setup_async_mode( read_handle => $rd );
$self->add_child( $ch ) unless $ch->parent;
}
$self->add_child( $self->{process} = $process );
$self->{id} = "P" . $process->pid;
foreach ( @channels_in, @channels_out ) {
my ( undef, undef, $other ) = @$_;
$other->close;
}
}
local/lib/perl5/IO/Async/Routine.pm view on Meta::CPAN
$self->{tid} = $tid;
$self->{id} = "T" . $tid;
foreach ( @channels_in ) {
my ( $ch, $wr, $rd ) = @$_;
$ch->setup_async_mode( write_handle => $wr );
$rd->close;
$self->add_child( $ch ) unless $ch->parent;
}
foreach ( @channels_out ) {
my ( $ch, $rd, $wr ) = @$_;
$ch->setup_async_mode( read_handle => $rd );
$wr->close;
$self->add_child( $ch ) unless $ch->parent;
}
}
=head1 METHODS
=cut
=head2 id
$id = $routine->id
local/lib/perl5/IO/Async/Timer/Countdown.pm view on Meta::CPAN
CODE reference for the C<on_expire> event.
=head2 delay => NUM
The delay in seconds after starting the timer until it expires. Cannot be
changed if the timer is running. A timer with a zero delay expires
"immediately".
=head2 remove_on_expire => BOOL
Optional. If true, remove this timer object from its parent notifier or
containing loop when it expires. Defaults to false.
Once constructed, the timer object will need to be added to the C<Loop> before
it will work. It will also need to be started by the C<start> method.
=cut
sub configure
{
my $self = shift;
local/lib/perl5/IO/Async/Timer/Countdown.pm view on Meta::CPAN
sub _make_cb
{
my $self = shift;
return $self->_capture_weakself( sub {
my $self = shift or return;
undef $self->{id};
$self->{expired} = 1;
$self->remove_from_parent if $self->{remove_on_expire};
$self->invoke_event( "on_expire" );
} );
}
sub _make_enqueueargs
{
my $self = shift;
undef $self->{expired};
local/lib/perl5/IO/Async/Timer/Countdown.pm view on Meta::CPAN
on_accept => sub {
my ( $newclient ) = @_;
my $watchdog = IO::Async::Timer::Countdown->new(
delay => 30,
on_expire => sub {
my $self = shift;
my $stream = $self->parent;
$stream->close;
},
);
my $stream = IO::Async::Stream->new(
handle => $newclient,
on_read => sub {
my ( $self, $buffref, $eof ) = @_;
$watchdog->reset;
local/lib/perl5/IO/Async/Timer/Countdown.pm view on Meta::CPAN
},
) );
$stream->add_child( $watchdog );
$watchdog->start;
$loop->add( $watchdog );
}
Rather than setting up a lexical variable to store the Stream so that the
Timer's C<on_expire> closure can call C<close> on it, the parent/child
relationship between the two Notifier objects is used. At the time the Timer
C<on_expire> closure is invoked, it will have been added as a child notifier
of the Stream; this means the Timer's C<parent> method will return the Stream
Notifier. This enables it to call C<close> without needing to capture a
lexical variable, which would create a cyclic reference.
=head2 Fixed-Delay Repeating Timer
The C<on_expire> event fires a fixed delay after the C<start> method has begun
the countdown. The C<start> method can be invoked again at some point during
the C<on_expire> handling code, to create a timer that invokes its code
regularly a fixed delay after the previous invocation has finished. This
creates an arrangement similar to an L<IO::Async::Timer::Periodic>, except
local/lib/perl5/Module/Build.pm view on Meta::CPAN
use File::Basename ();
use Perl::OSType ();
use Module::Build::Base;
our @ISA = qw(Module::Build::Base);
our $VERSION = '0.4220';
$VERSION = eval $VERSION;
# Inserts the given module into the @ISA hierarchy between
# Module::Build and its immediate parent
sub _interpose_module {
my ($self, $mod) = @_;
eval "use $mod";
die $@ if $@;
no strict 'refs';
my $top_class = $mod;
while (@{"${top_class}::ISA"}) {
last if ${"${top_class}::ISA"}[0] eq $ISA[0];
$top_class = ${"${top_class}::ISA"}[0];
local/lib/perl5/Module/Build/Authoring.pod view on Meta::CPAN
whatever>.
For information on providing compatibility with
C<ExtUtils::MakeMaker>, see L<Module::Build::Compat> and
L<http://www.makemaker.org/wiki/index.cgi?ModuleBuildConversionGuide>.
=head1 STRUCTURE
Module::Build creates a class hierarchy conducive to customization.
Here is the parent-child class hierarchy in classy ASCII art:
/--------------------\
| Your::Parent | (If you subclass Module::Build)
\--------------------/
|
|
/--------------------\ (Doesn't define any functionality
| Module::Build | of its own - just figures out what
\--------------------/ other modules to load.)
|
local/lib/perl5/Module/Build/Authoring.pod view on Meta::CPAN
$build->create_build_script;
This is relatively straightforward, and is the best way to do things
if your My::Builder class contains lots of code. The
C<create_build_script()> method will ensure that the current value of
C<@INC> (including the C</nonstandard/library/path>) is propagated to
the Build script, so that My::Builder can be found when running build
actions. If you find that you need to C<chdir> into a different directories
in your subclass methods or actions, be sure to always return to the original
directory (available via the C<base_dir()> method) before returning control
to the parent class. This is important to avoid data serialization problems.
For very small additions, Module::Build provides a C<subclass()>
method that lets you subclass Module::Build more conveniently, without
creating a separate file for your module:
------ in Build.PL: ----------
#!/usr/bin/perl
use Module::Build;
my $class = Module::Build->subclass
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
);
}
########################################################################
{ # enclosing these lexicals -- TODO
my %valid_properties = ( __PACKAGE__, {} );
my %additive_properties;
sub _mb_classes {
my $class = ref($_[0]) || $_[0];
return ($class, $class->mb_parents);
}
sub valid_property {
my ($class, $prop) = @_;
return grep exists( $valid_properties{$_}{$prop} ), $class->_mb_classes;
}
sub valid_properties {
return keys %{ shift->valid_properties_defaults() };
}
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
my $c = ref($self) ? $self->{config} : 'Module::Build::Config';
return $c->all_config unless @_;
my $key = shift;
return $c->get($key) unless @_;
my $val = shift;
return $c->set($key => $val);
}
sub mb_parents {
# Code borrowed from Class::ISA.
my @in_stack = (shift);
my %seen = ($in_stack[0] => 1);
my ($current, @out);
while (@in_stack) {
next unless defined($current = shift @in_stack)
&& $current->isa('Module::Build::Base');
push @out, $current;
next if $current eq 'Module::Build::Base';
no strict 'refs';
unshift @in_stack,
map {
my $c = $_; # copy, to avoid being destructive
substr($c,0,2) = "main::" if substr($c,0,2) eq '::';
# Canonize the :: -> main::, ::foo -> main::foo thing.
# Should I ever canonize the Foo'Bar = Foo::Bar thing?
$seen{$c}++ ? () : $c;
} @{"$current\::ISA"};
# I.e., if this class has any parents (at least, ones I've never seen
# before), push them, in order, onto the stack of classes I need to
# explore.
}
shift @out;
return @out;
}
sub extra_linker_flags { shift->_list_accessor('extra_linker_flags', @_) }
sub extra_compiler_flags { shift->_list_accessor('extra_compiler_flags', @_) }
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
die "No 'to' or 'to_dir' parameter given to copy_if_modified";
}
return if $self->up_to_date($file, $to_path); # Already fresh
{
local $self->{properties}{quiet} = 1;
$self->delete_filetree($to_path); # delete destination if exists
}
# Create parent directories
File::Path::mkpath(File::Basename::dirname($to_path), 0, oct(777));
$self->log_verbose("Copying $file -> $to_path\n");
if ($^O eq 'os2') {# copy will not overwrite; 0x1 = overwrite
chmod 0666, $to_path;
File::Copy::syscopy($file, $to_path, 0x1) or die "Can't copy('$file', '$to_path'): $!";
} else {
File::Copy::copy($file, $to_path) or die "Can't copy('$file', '$to_path'): $!";
}
local/lib/perl5/Module/Build/Bundling.pod view on Meta::CPAN
fields):
use Module::Build;
Module::Build->new(
module_name => 'Foo::Bar',
license => 'perl',
)->create_build_script;
A "bundling" Build.PL replaces the initial "use" line with a nearly
transparent replacement:
use inc::latest 'Module::Build';
Module::Build->new(
module_name => 'Foo::Bar',
license => 'perl',
)->create_build_script;
For I<authors>, when "Build dist" is run, Module::Build will be
automatically bundled into C<inc> according to the rules for
local/lib/perl5/Module/Build/Platform/VMS.pm view on Meta::CPAN
=item _detildefy
The home-grown glob() does not currently handle tildes, so provide limited support
here. Expect only UNIX format file specifications for now.
=cut
sub _detildefy {
my ($self, $arg) = @_;
# Apparently double ~ are not translated.
return $arg if ($arg =~ /^~~/);
# Apparently ~ followed by whitespace are not translated.
return $arg if ($arg =~ /^~ /);
if ($arg =~ /^~/) {
my $spec = $arg;
# Remove the tilde
$spec =~ s/^~//;
# Remove any slash following the tilde if present.
$spec =~ s#^/##;
local/lib/perl5/Sub/Uplevel.pm view on Meta::CPAN
package Sub::Uplevel;
use 5.006;
use strict;
# ABSTRACT: apparently run a function in a higher stack frame
our $VERSION = '0.2600';
# Frame check global constant
our $CHECK_FRAMES;
BEGIN {
$CHECK_FRAMES = !! $CHECK_FRAMES;
}
use constant CHECK_FRAMES => $CHECK_FRAMES;
local/lib/perl5/Sub/Uplevel.pm view on Meta::CPAN
#pod
#pod Setting or changing the global after the module has been loaded will have
#pod no effect.
#pod
#pod =cut
# @Up_Frames -- uplevel stack
# $Caller_Proxy -- whatever caller() override was in effect before uplevel
our (@Up_Frames, $Caller_Proxy);
sub _apparent_stack_height {
my $height = 1; # start above this function
while ( 1 ) {
last if ! defined scalar $Caller_Proxy->($height);
$height++;
}
return $height - 1; # subtract 1 for this function
}
sub uplevel {
# Backwards compatible version of "no warnings 'redefine'"
local/lib/perl5/Sub/Uplevel.pm view on Meta::CPAN
$^W = 0;
# Update the caller proxy if the uplevel override isn't in effect
local $Caller_Proxy = *CORE::GLOBAL::caller{CODE}
if *CORE::GLOBAL::caller{CODE} != \&_uplevel_caller;
local *CORE::GLOBAL::caller = \&_uplevel_caller;
# Restore old warnings state
$^W = $old_W;
if ( CHECK_FRAMES and $_[0] >= _apparent_stack_height() ) {
require Carp;
Carp::carp("uplevel $_[0] is more than the caller stack");
}
local @Up_Frames = (shift, @Up_Frames );
my $function = shift;
return $function->(@_);
}
local/lib/perl5/Sub/Uplevel.pm view on Meta::CPAN
1;
__END__
=pod
=encoding UTF-8
=head1 NAME
Sub::Uplevel - apparently run a function in a higher stack frame
=head1 VERSION
version 0.2600
=head1 SYNOPSIS
use Sub::Uplevel;
sub foo {
( run in 0.640 second using v1.01-cache-2.11-cpan-4d50c553e7e )