Acme-Sort-Sleep
view release on metacpan or search on metacpan
lib/Acme/Sort/Sleep.pm view on Meta::CPAN
remove_on_expire => 1,
on_expire => sub {
push @sorted, $num;
# no more timers/numbers left to sort
$loop->stop unless $loop->notifiers;
},
);
$timer->start;
$loop->add( $timer );
}
$loop->run;
return @sorted;
}
1;
local/lib/perl5/Future/Mutex.pm view on Meta::CPAN
...
return $f;
});
}
=head1 DESCRIPTION
Most L<Future>-using code expects to run with some level of concurrency, using
future instances to represent still-pending operations that will complete at
some later time. There are occasions however, when this concurrency needs to
be restricted - some operations that, once started, must not be interrupted
until they are complete. Subsequent requests to perform the same operation
while one is still outstanding must therefore be queued to wait until the
first is finished. These situations call for a mutual-exclusion lock, or
"mutex".
A C<Future::Mutex> instance provides one basic operation, which will execute a
given block of code which returns a future, and itself returns a future to
represent that. The mutex can be in one of two states; either unlocked or
locked. While it is unlocked, requests to execute code are handled
immediately. Once a block of code is invoked, the mutex is now considered to
local/lib/perl5/Future/Phrasebook.pod view on Meta::CPAN
Again, the C<needs_all> version allows more convenient access to the list of
results.
my $f = Future->needs_all( map { F_FUNC( $_ ) } @ITEMS )
->then( sub {
my @RESULT = @_;
F_PROCESS( @RESULT )
} );
This form of the code starts every item's future concurrently, then waits for
all of them. If the list of C<@ITEMS> is potentially large, this may cause a
problem due to too many items running at once. Instead, the
C<Future::Utils::fmap> family of functions can be used to bound the
concurrency, keeping at most some given number of items running, starting new
ones as existing ones complete.
my $f = fmap {
my $item = shift;
F_FUNC( $item )
} foreach => \@ITEMS;
By itself, this will not actually act concurrently as it will only keep one
Future outstanding at a time. The C<concurrent> flag lets it keep a larger
number "in flight" at any one time:
local/lib/perl5/Future/Utils.pm view on Meta::CPAN
The C<fmap> family of functions provide a way to call a block of code that
returns a L<Future> (called here an "item future") once per item in a given
list, or returned by a generator function. The C<fmap*> functions themselves
return a C<Future> to represent the ongoing operation, which completes when
every item's future has completed.
While this behaviour can also be implemented using C<repeat>, the main reason
to use an C<fmap> function is that the individual item operations are
considered as independent, and thus more than one can be outstanding
concurrently. An argument can be passed to the function to indicate how many
items to start initially, and thereafter it will keep that many of them
running concurrently until all of the items are done, or until any of them
fail. If an individual item future fails, the overall result future will be
marked as failing with the same failure, and any other pending item futures
that are outstanding at the time will be cancelled.
The following named arguments are common to each C<fmap*> function:
=over 8
=item foreach => ARRAY
local/lib/perl5/Future/Utils.pm view on Meta::CPAN
( $item ) = $generate->()
This function will be invoked each time any previous item future has completed
and may be called again even after it has returned empty.
=item concurrent => INT
Gives the number of item futures to keep outstanding. By default this value
will be 1 (i.e. no concurrency); larger values indicate that multiple item
futures will be started at once.
=item return => Future
Normally, a new instance is returned by cloning the first non-immediate future
returned as an item future. By passing a new instance as the C<return>
argument, the result will be put into the given instance. This can be used to
return subclasses, or specific instances.
=back
local/lib/perl5/IO/Async.pm view on Meta::CPAN
which facilitates the use of C<listen(2)>-mode sockets. When a new connection
is available on the socket it will C<accept(2)> it and pass the new client
socket to its callback function.
=head2 Timers
An L<IO::Async::Timer::Absolute> object represents a timer that expires at a
given absolute time in the future.
An L<IO::Async::Timer::Countdown> object represents a count time timer, which
will invoke a callback after a given delay. It can be stopped and restarted.
An L<IO::Async::Timer::Periodic> object invokes a callback at regular intervals
from its initial start time. It is reliable and will not drift due to the time
taken to run the callback.
The L<IO::Async::Loop> also supports methods for managing timed events on a
lower level. Events may be absolute, or relative in time to the time they are
installed.
=head2 Signals
An L<IO::Async::Signal> object represents a POSIX signal, which will invoke a
callback when the given signal is received by the process. Multiple objects
watching the same signal can be used; they will all invoke in no particular
order.
=head2 Processes Management
An L<IO::Async::PID> object invokes its event when a given child process
exits. An L<IO::Async::Process> object can start a new child process running
either a given block of code, or executing a given command, set up pipes on
its filehandles, write to or read from these pipes, and invoke its event when
the child process exits.
=head2 Loops
The L<IO::Async::Loop> object class represents an abstract collection of
L<IO::Async::Notifier> objects, and manages the actual filehandle IO
watchers, timers, signal handlers, and other functionality. It performs all
of the abstract collection management tasks, and leaves the actual OS
local/lib/perl5/IO/Async.pm view on Meta::CPAN
L</SEE ALSO> section below for more detail.
As well as these general-purpose classes, the L<IO::Async::Loop> constructor
also supports looking for OS-specific subclasses, in case a more efficient
implementation exists for the specific OS it runs on.
=head2 Child Processes
The L<IO::Async::Loop> object provides a number of methods to facilitate the
running of child processes. C<spawn_child> is primarily a wrapper around the
typical C<fork(2)>/C<exec(2)> style of starting child processes, and
C<run_child> provide a method similar to perl's C<readpipe> (which is used
to implement backticks C<``>).
=head2 File Change Watches
The L<IO::Async::File> object observes changes to C<stat(2)> properties of a
file, directory, or other filesystem object. It invokes callbacks when
properties change. This is used by L<IO::Async::FileStream> which presents
the same events as a L<IO::Async::Stream> but operates on a regular file on
the filesystem, observing it for updates.
local/lib/perl5/IO/Async/ChildManager.pm view on Meta::CPAN
exception).
Case | ($exitcode >> 8) | $dollarbang | $dollarat
--------------+------------------------+-------------+----------
exec succeeds | exit code from program | 0 | ""
exec fails | 255 | $! | ""
$code returns | return value | $! | ""
$code dies | 255 | $! | $@
It is usually more convenient to use the C<open_child> method in simple cases
where an external program is being started in order to interact with it via
file IO, or even C<run_child> when only the final result is required, rather
than interaction while it is running.
=cut
sub spawn_child
{
my $self = shift;
my %params = @_;
local/lib/perl5/IO/Async/File.pm view on Meta::CPAN
sub _init
{
my $self = shift;
my ( $params ) = @_;
$params->{interval} ||= 2;
$self->SUPER::_init( $params );
$self->start;
}
sub configure
{
my $self = shift;
my %params = @_;
if( exists $params{filename} ) {
my $filename = delete $params{filename};
$self->{filename} = $filename;
local/lib/perl5/IO/Async/FileStream.pm view on Meta::CPAN
Invoked when more data is available in the internal receiving buffer.
Note that C<$eof> only indicates that all the data currently available in the
file has now been read; in contrast to a regular L<IO::Async::Stream>, this
object will not stop watching after this condition. Instead, it will continue
watching the file for updates.
=head2 on_truncated
Invoked when the file size shrinks. If this happens, it is presumed that the
file content has been replaced. Reading will then commence from the start of
the file.
=head2 on_initial $size
Invoked the first time the file is looked at. It is passed the initial size of
the file. The code implementing this method can use the C<seek> or
C<seek_to_last> methods to set the initial read position in the file to skip
over some initial content.
This method may be useful to skip initial content in the file, if the object
local/lib/perl5/IO/Async/FileStream.pm view on Meta::CPAN
=cut
# Replace IO::Async::Handle's implementation
sub _watch_read
{
my $self = shift;
my ( $want ) = @_;
if( $want ) {
$self->{file}->start if !$self->{file}->is_running;
}
else {
$self->{file}->stop;
}
}
sub _watch_write
{
my $self = shift;
my ( $want ) = @_;
local/lib/perl5/IO/Async/Function.pm view on Meta::CPAN
=head2 max_workers => INT
The lower and upper bounds of worker processes to try to keep running. The
actual number running at any time will be kept somewhere between these bounds
according to load.
=head2 max_worker_calls => INT
Optional. If provided, stop a worker process after it has processed this
number of calls. (New workers may be started to replace stopped ones, within
the bounds given above).
=head2 idle_timeout => NUM
Optional. If provided, idle worker processes will be shut down after this
amount of time, if there are more than C<min_workers> of them.
=head2 exit_on_die => BOOL
Optional boolean, controls what happens after the C<code> throws an
local/lib/perl5/IO/Async/Function.pm view on Meta::CPAN
elsif( my $idle_timer = $self->{idle_timer} ) {
$idle_timer->configure( delay => $timeout );
}
else {
$self->{idle_timer} = IO::Async::Timer::Countdown->new(
delay => $timeout,
on_expire => $self->_capture_weakself( sub {
my $self = shift or return;
my $workers = $self->{workers};
# Shut down atmost one idle worker, starting from the highest
# ID. Since we search from lowest to assign work, this tries
# to ensure we'll shut down the least useful ones first,
# keeping more useful ones in memory (page/cache warmth, etc..)
foreach my $id ( reverse sort keys %$workers ) {
next if $workers->{$id}{busy};
$workers->{$id}->stop;
last;
}
# Still more?
$self->{idle_timer}->start if $self->workers_idle > $self->{min_workers};
} ),
);
$self->add_child( $self->{idle_timer} );
}
}
foreach (qw( min_workers max_workers )) {
$self->{$_} = delete $params{$_} if exists $params{$_};
# TODO: something about retuning
}
my $need_restart;
foreach (qw( init_code code setup )) {
$need_restart++, $self->{$_} = delete $params{$_} if exists $params{$_};
}
$self->SUPER::configure( %params );
if( $need_restart and $self->loop ) {
$self->stop;
$self->start;
}
}
sub _add_to_loop
{
my $self = shift;
$self->SUPER::_add_to_loop( @_ );
$self->start;
}
sub _remove_from_loop
{
my $self = shift;
$self->stop;
$self->SUPER::_remove_from_loop( @_ );
}
=head1 METHODS
The following methods documented with a trailing call to C<< ->get >> return
L<Future> instances.
=cut
=head2 start
$function->start
Start the worker processes
=cut
sub start
{
my $self = shift;
$self->_new_worker for 1 .. $self->{min_workers};
}
=head2 stop
$function->stop
local/lib/perl5/IO/Async/Function.pm view on Meta::CPAN
my $self = shift;
$self->{stopping} = 1;
foreach my $worker ( $self->_worker_objects ) {
$worker->stop;
}
}
=head2 restar
$function->restart
Gracefully stop and restart all the worker processes.
=cut
sub restart
{
my $self = shift;
$self->stop;
$self->start;
}
=head2 call
@result = $function->call( %params )->get
Schedules an invocation of the contained function to be executed on one of the
worker processes. If a non-busy worker is available now, it will be called
immediately. If not, it will be queued and sent to the next free worker that
becomes available.
local/lib/perl5/IO/Async/Function.pm view on Meta::CPAN
my $worker = $self->_get_worker or return;
next if $next->is_cancelled;
$self->debug_printf( "UNQUEUE" );
$next->done( $self, $worker );
return;
}
if( $self->workers_idle > $self->{min_workers} ) {
$self->{idle_timer}->start if $self->{idle_timer} and !$self->{idle_timer}->is_running;
}
}
package # hide from indexer
IO::Async::Function::Worker;
use base qw( IO::Async::Routine );
use IO::Async::Channel;
local/lib/perl5/IO/Async/Loop.pm view on Meta::CPAN
use IO::Async::Stream;
use IO::Async::Timer::Countdown;
use IO::Async::Loop;
my $loop = IO::Async::Loop->new;
$loop->add( IO::Async::Timer::Countdown->new(
delay => 10,
on_expire => sub { print "10 seconds have passed\n" },
)->start );
$loop->add( IO::Async::Stream->new_for_stdin(
on_read => sub {
my ( $self, $buffref, $eof ) = @_;
while( $$buffref =~ s/^(.*)\n// ) {
print "You typed a line $1\n";
}
return 0;
local/lib/perl5/IO/Async/Loop.pm view on Meta::CPAN
=head2 post_fork
$loop->post_fork
The base implementation of this method does nothing. It is provided in case
some Loop subclasses should take special measures after a C<fork()> system
call if the main body of the program should survive in both running processes.
This may be required, for example, in a long-running server daemon that forks
multiple copies on startup after opening initial listening sockets. A loop
implementation that uses some in-kernel resource that becomes shared after
forking (for example, a Linux C<epoll> or a BSD C<kqueue> filehandle) would
need recreating in the new child process before the program can continue.
=cut
sub post_fork
{
# empty
}
local/lib/perl5/IO/Async/LoopTests.pm view on Meta::CPAN
# Override prototype - I know what I'm doing
&IO::Async::Test::wait_for( @_ );
IO::Async::Test::testing_loop( undef );
}
sub time_between(&$$$)
{
my ( $code, $lower, $upper, $name ) = @_;
my $start = time;
$code->();
my $took = ( time - $start ) / AUT;
cmp_ok( $took, '>=', $lower, "$name took at least $lower seconds" ) if defined $lower;
cmp_ok( $took, '<=', $upper * 3, "$name took no more than $upper seconds" ) if defined $upper;
if( $took > $upper and $took <= $upper * 3 ) {
diag( "$name took longer than $upper seconds - this may just be an indication of a busy testing machine rather than a bug" );
}
}
=head1 TEST SUITES
local/lib/perl5/IO/Async/LoopTests.pm view on Meta::CPAN
}
} 1.5, 2.5, 'loop_once(5) while waiting for timer';
SKIP: {
skip "Unable to handle sub-second timers accurately", 3 unless $loop->_CAN_SUBSECOND_ACCURATELY;
# Check that short delays are achievable in one ->loop_once call
foreach my $delay ( 0.001, 0.01, 0.1 ) {
my $done;
my $count = 0;
my $start = time;
$loop->enqueue_timer( delay => $delay, code => sub { $done++ } );
while( !$done ) {
$loop->loop_once( 1 );
$count++;
last if time - $start > 5; # bailout
}
is( $count, 1, "One ->loop_once(1) sufficient for a single $delay second timer" );
}
}
$cancelled_fired = 0;
$id = $loop->enqueue_timer( delay => 1 * AUT, code => sub { $cancelled_fired = 1 } );
$loop->cancel_timer( $id );
undef $id;
local/lib/perl5/IO/Async/Notifier.pm view on Meta::CPAN
=item *
L<IO::Async::Signal> - event callback on receipt of a POSIX signal
=item *
L<IO::Async::PID> - event callback on exit of a child process
=item *
L<IO::Async::Process> - start and manage a child process
=back
For more detail, see the SYNOPSIS section in one of the above.
One case where this object class would be used, is when a library wishes to
provide a sub-component which consists of multiple other C<Notifier>
subclasses, such as C<Handle>s and C<Timers>, but no particular object is
suitable to be the root of a tree. In this case, a plain C<Notifier> object
can be used as the tree root, and all the other notifiers added as children of
local/lib/perl5/IO/Async/Notifier.pm view on Meta::CPAN
=cut
=head2 _add_to_loop
$notifier->_add_to_loop( $loop )
This method is called when the Notifier has been added to a Loop; either
directly, or indirectly through being a child of a Notifer already in a loop.
This method may be used to perform any initial startup activity required for
the Notifier to be fully functional but which requires a Loop to do so.
=cut
sub _add_to_loop
{
# empty default
}
=head2 _remove_from_loop
local/lib/perl5/IO/Async/PID.pm view on Meta::CPAN
my $kid = $loop->fork(
code => sub {
print "Child sleeping..\n";
sleep 10;
print "Child exiting\n";
return 20;
},
);
print "Child process $kid started\n";
my $pid = IO::Async::PID->new(
pid => $kid,
on_exit => sub {
my ( $self, $exitcode ) = @_;
printf "Child process %d exited with status %d\n",
$self->pid, WEXITSTATUS($exitcode);
},
);
local/lib/perl5/IO/Async/Process.pm view on Meta::CPAN
use Carp;
use Socket qw( SOCK_STREAM );
use Future;
use IO::Async::OS;
=head1 NAME
C<IO::Async::Process> - start and manage a child process
=head1 SYNOPSIS
use IO::Async::Process;
use IO::Async::Loop;
my $loop = IO::Async::Loop->new;
my $process = IO::Async::Process->new(
command => [ "tr", "a-z", "n-za-m" ],
local/lib/perl5/IO/Async/Process.pm view on Meta::CPAN
$loop->stop;
},
);
$loop->add( $process );
$loop->run;
=head1 DESCRIPTION
This subclass of L<IO::Async::Notifier> starts a child process, and invokes a
callback when it exits. The child process can either execute a given block of
code (via C<fork(2)>), or a command.
=cut
=head1 EVENTS
The following events are invoked, either using subclass methods or CODE
references in parameters:
local/lib/perl5/IO/Async/Process.pm view on Meta::CPAN
=cut
=head2 new
$process = IO::Async::Process->new( %args )
Constructs a new C<IO::Async::Process> object and returns it.
Once constructed, the C<Process> will need to be added to the C<Loop> before
the child process is started.
=cut
sub _init
{
my $self = shift;
$self->SUPER::_init( @_ );
$self->{to_close} = {};
$self->{finish_futures} = [];
local/lib/perl5/IO/Async/Process.pm view on Meta::CPAN
=head2 on_finish => CODE
=head2 on_exception => CODE
CODE reference for the event handlers.
Once the C<on_finish> continuation has been invoked, the C<IO::Async::Process>
object is removed from the containing L<IO::Async::Loop> object.
The following parameters may be passed to C<new>, or to C<configure> before
the process has been started (i.e. before it has been added to the C<Loop>).
Once the process is running these cannot be changed.
=head2 command => ARRAY or STRING
Either a reference to an array containing the command and its arguments, or a
plain string containing the command. This value is passed into perl's
C<exec(2)> function.
=head2 code => CODE
local/lib/perl5/IO/Async/Process.pm view on Meta::CPAN
}
=head1 METHODS
=cut
=head2 pid
$pid = $process->pid
Returns the process ID of the process, if it has been started, or C<undef> if
not. Its value is preserved after the process exits, so it may be inspected
during the C<on_finish> or C<on_exception> events.
=cut
sub pid
{
my $self = shift;
return $self->{pid};
}
local/lib/perl5/IO/Async/Process.pm view on Meta::CPAN
my $self = shift;
my ( $signal ) = @_;
kill $signal, $self->pid or croak "Cannot kill() - $!";
}
=head2 is_running
$running = $process->is_running
Returns true if the Process has been started, and has not yet finished.
=cut
sub is_running
{
my $self = shift;
return $self->{running};
}
=head2 is_exited
local/lib/perl5/IO/Async/Process.pm view on Meta::CPAN
print "The process has finished\n";
}
);
$loop->add( $process );
The data in this scalar will be written until it is all consumed, then the
handle will be closed. This may be useful if the program waits for EOF on
C<STDIN> before it exits.
To have the ability to write more data into the process once it has started.
the C<write> method on the C<stdin> stream can be used, when it is configured
using the C<pipe_write> value for C<via>:
my $process = IO::Async::Process->new(
command => [ "reading-program", "arguments" ],
stdin => { via => "pipe_write" },
on_finish => sub {
print "The process has finished\n";
}
);
local/lib/perl5/IO/Async/Resolver.pm view on Meta::CPAN
# Try to use HiRes alarm, but we don't strictly need it.
# MSWin32 doesn't implement it
BEGIN {
require Time::HiRes;
eval { Time::HiRes::alarm(0) } and Time::HiRes->import( qw( alarm ) );
}
use Carp;
my $started = 0;
my %METHODS;
=head1 NAME
C<IO::Async::Resolver> - performing name resolutions asynchronously
=head1 SYNOPSIS
This object is used indirectly via an L<IO::Async::Loop>:
local/lib/perl5/IO/Async/Resolver.pm view on Meta::CPAN
return @ret;
}
else {
die "Unrecognised resolver request '$type'";
}
};
$params->{idle_timeout} = 30;
$params->{min_workers} = 0;
$started = 1;
}
=head1 METHODS
The following methods documented with a trailing call to C<< ->get >> return
L<Future> instances.
=cut
=head2 resolve
local/lib/perl5/IO/Async/Resolver.pm view on Meta::CPAN
=back
=cut
# Plain function, not a method
sub register_resolver
{
my ( $name, $code ) = @_;
croak "Cannot register new resolver methods once the resolver has been started" if $started;
croak "Already have a resolver method called '$name'" if exists $METHODS{$name};
$METHODS{$name} = $code;
}
=head1 BUILT-IN RESOLVERS
The following resolver names are implemented by the same-named perl function,
taking and returning a list of values exactly as the perl function does:
local/lib/perl5/IO/Async/Stream.pm view on Meta::CPAN
for more detail.
The second argument is a scalar indicating whether the stream has reported an
end-of-file (EOF) condition. A reference to the buffer is passed to the
handler in the usual way, so it may inspect data contained in it. Once the
handler returns a false value, it will not be called again, as the handle is
now at EOF and no more data can arrive.
The C<on_read> code may also dynamically replace itself with a new callback
by returning a CODE reference instead of C<0> or C<1>. The original callback
or method that the object first started with may be restored by returning
C<undef>. Whenever the callback is changed in this way, the new code is called
again; even if the read buffer is currently empty. See the examples at the end
of this documentation for more detail.
The C<push_on_read> method can be used to insert new, temporary handlers that
take precedence over the global C<on_read> handler. This event is only used if
there are no further pending handlers created by C<push_on_read>.
=head2 on_read_eof
local/lib/perl5/IO/Async/Stream.pm view on Meta::CPAN
and re-enable notifications again once something has read enough to cause it to
drop. If these events are overridden, the overriding code will have to perform
this behaviour if required, by using
$self->want_readready_for_read(...)
=head2 on_outgoing_empty
Optional. Invoked when the writing data buffer becomes empty.
=head2 on_writeable_start
=head2 on_writeable_stop
Optional. These two events inform when the filehandle becomes writeable, and
when it stops being writeable. C<on_writeable_start> is invoked by the
C<on_write_ready> event if previously it was known to be not writeable.
C<on_writeable_stop> is invoked after a C<syswrite> operation fails with
C<EAGAIN> or C<EWOULDBLOCK>. These two events track the writeability state,
and ensure that only state change cause events to be invoked. A stream starts
off being presumed writeable, so the first of these events to be observed will
be C<on_writeable_stop>.
=cut
sub _init
{
my $self = shift;
$self->{writequeue} = []; # Queue of Writers
local/lib/perl5/IO/Async/Stream.pm view on Meta::CPAN
Shortcut to specifying the same IO handle for both of the above.
=head2 on_read => CODE
=head2 on_read_error => CODE
=head2 on_outgoing_empty => CODE
=head2 on_write_error => CODE
=head2 on_writeable_start => CODE
=head2 on_writeable_stop => CODE
CODE references for event handlers.
=head2 autoflush => BOOL
Optional. If true, the C<write> method will attempt to write data to the
operating system immediately, without waiting for the loop to indicate the
filehandle is write-ready. This is useful, for example, on streams that should
local/lib/perl5/IO/Async/Stream.pm view on Meta::CPAN
a child of another Notifier already in a Loop, or added to one.
=cut
sub configure
{
my $self = shift;
my %params = @_;
for (qw( on_read on_outgoing_empty on_read_eof on_write_eof on_read_error
on_write_error on_writeable_start on_writeable_stop autoflush
read_len read_all write_len write_all on_read_high_watermark
on_read_low_watermark reader writer close_on_read_eof )) {
$self->{$_} = delete $params{$_} if exists $params{$_};
}
if( exists $params{read_high_watermark} or exists $params{read_low_watermark} ) {
my $high = delete $params{read_high_watermark};
defined $high or $high = $self->{read_high_watermark};
my $low = delete $params{read_low_watermark};
local/lib/perl5/IO/Async/Stream.pm view on Meta::CPAN
$self->want_writeready_for_write( 1 );
return $f;
}
sub on_write_ready
{
my $self = shift;
if( !$self->{writeable} ) {
$self->maybe_invoke_event( on_writeable_start => );
$self->{writeable} = 1;
}
$self->_do_write if $self->{want} & WANT_WRITE_FOR_WRITE;
$self->_do_read if $self->{want} & WANT_WRITE_FOR_READ;
}
sub _do_write
{
my $self = shift;
local/lib/perl5/IO/Async/Timer.pm view on Meta::CPAN
=over 8
=item mode => STRING
The type of timer to create. Currently the only allowed mode is C<countdown>
but more types may be added in the future.
=back
Once constructed, the C<Timer> 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 new
{
my $class = shift;
my %args = @_;
if( my $mode = delete $args{mode} ) {
# Might define some other modes later
local/lib/perl5/IO/Async/Timer.pm view on Meta::CPAN
require IO::Async::Timer::Countdown;
return IO::Async::Timer::Countdown->new( %args );
}
return $class->SUPER::new( %args );
}
sub _add_to_loop
{
my $self = shift;
$self->start if delete $self->{pending};
}
sub _remove_from_loop
{
my $self = shift;
$self->stop;
}
=head1 METHODS
=cut
=head2 is_running
$running = $timer->is_running
Returns true if the Timer has been started, and has not yet expired, or been
stopped.
=cut
sub is_running
{
my $self = shift;
defined $self->{id};
}
=head2 start
$timer->start
Starts the Timer. Throws an error if it was already running.
If the Timer is not yet in a Loop, the actual start will be deferred until it
is added. Once added, it will be running, and will expire at the given
duration after the time it was added.
As a convenience, C<$timer> is returned. This may be useful for starting
timers at construction time:
$loop->add( IO::Async::Timer->new( ... )->start );
=cut
sub start
{
my $self = shift;
my $loop = $self->loop;
if( !defined $loop ) {
$self->{pending} = 1;
return $self;
}
defined $self->{id} and croak "Cannot start a Timer that is already running";
if( !$self->{cb} ) {
$self->{cb} = $self->_make_cb;
}
$self->{id} = $loop->watch_time(
$self->_make_enqueueargs,
code => $self->{cb},
);
return $self;
}
=head2 stop
$timer->stop
Stops the Timer if it is running. If it has not yet been added to the C<Loop>
but there is a start pending, this will cancel it.
=cut
sub stop
{
my $self = shift;
if( $self->{pending} ) {
delete $self->{pending};
return;
local/lib/perl5/IO/Async/Timer/Absolute.pm view on Meta::CPAN
$loop->run;
=head1 DESCRIPTION
This subclass of L<IO::Async::Timer> implements one-shot events at a fixed
time in the future. The object waits for a given timestamp, and invokes its
callback at that point in the future.
For a C<Timer> object that waits for a delay relative to the time it is
started, see instead L<IO::Async::Timer::Countdown>.
=cut
=head1 EVENTS
The following events are invoked, either using subclass methods or CODE
references in parameters:
=head2 on_expire
local/lib/perl5/IO/Async/Timer/Absolute.pm view on Meta::CPAN
CODE reference for the C<on_expire> event.
=head2 time => NUM
The epoch time at which the timer will expire.
Once constructed, the timer object will need to be added to the C<Loop> before
it will work.
Unlike other timers, it does not make sense to C<start> this object, because
its expiry time is absolute, and not relative to the time it is started.
=cut
sub configure
{
my $self = shift;
my %params = @_;
if( exists $params{on_expire} ) {
my $on_expire = delete $params{on_expire};
local/lib/perl5/IO/Async/Timer/Absolute.pm view on Meta::CPAN
undef $self->{cb}; # Will be lazily constructed when needed
}
if( exists $params{time} ) {
my $time = delete $params{time};
$self->stop if $self->is_running;
$self->{time} = $time;
$self->start if !$self->is_running;
}
unless( $self->can_event( 'on_expire' ) ) {
croak 'Expected either a on_expire callback or an ->on_expire method';
}
$self->SUPER::configure( %params );
}
sub _make_cb
local/lib/perl5/IO/Async/Timer/Countdown.pm view on Meta::CPAN
my $timer = IO::Async::Timer::Countdown->new(
delay => 10,
on_expire => sub {
print "Sorry, your time's up\n";
$loop->stop;
},
);
$timer->start;
$loop->add( $timer );
$loop->run;
=head1 DESCRIPTION
This subclass of L<IO::Async::Timer> implements one-shot fixed delays.
The object implements a countdown timer, which invokes its callback after the
given period from when it was started. After it has expired the Timer may be
started again, when it will wait the same period then invoke the callback
again. A timer that is currently running may be stopped or reset.
For a C<Timer> object that repeatedly runs a callback at regular intervals,
see instead L<IO::Async::Timer::Periodic>. For a C<Timer> that invokes its
callback at a fixed time in the future, see L<IO::Async::Timer::Absolute>.
=cut
=head1 EVENTS
local/lib/perl5/IO/Async/Timer/Countdown.pm view on Meta::CPAN
=head1 PARAMETERS
The following named parameters may be passed to C<new> or C<configure>:
=head2 on_expire => CODE
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;
my %params = @_;
foreach (qw( remove_on_expire )) {
$self->{$_} = delete $params{$_} if exists $params{$_};
local/lib/perl5/IO/Async/Timer/Countdown.pm view on Meta::CPAN
my $self = shift;
undef $self->{expired};
return after => $self->{delay};
}
=head2 reset
$timer->reset
If the timer is running, restart the countdown period from now. If the timer
is not running, this method has no effect.
=cut
sub reset
{
my $self = shift;
my $loop = $self->loop or croak "Cannot reset a Timer that is not in a Loop";
return if !$self->is_running;
$self->stop;
$self->start;
}
=head1 EXAMPLES
=head2 Watchdog Timer
Because the C<reset> method restarts a running countdown timer back to its
full period, it can be used to implement a watchdog timer. This is a timer
which will not expire provided the method is called at least as often as it
is configured. If the method fails to be called, the timer will eventually
expire and run its callback.
For example, to expire an accepted connection after 30 seconds of inactivity:
...
on_accept => sub {
local/lib/perl5/IO/Async/Timer/Countdown.pm view on Meta::CPAN
...
},
on_closed => sub {
$watchdog->stop;
},
) );
$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
that it will wait until the previous invocation has indicated it is finished,
before starting the countdown for the next call.
my $timer = IO::Async::Timer::Countdown->new(
delay => 60,
on_expire => sub {
my $self = shift;
start_some_operation(
on_complete => sub { $self->start },
);
},
);
$timer->start;
$loop->add( $timer );
This example invokes the C<start_some_operation> function 60 seconds after the
previous iteration has indicated it has finished.
=head1 AUTHOR
Paul Evans <leonerd@leonerd.org.uk>
=cut
0x55AA;
local/lib/perl5/IO/Async/Timer/Periodic.pm view on Meta::CPAN
my $loop = IO::Async::Loop->new;
my $timer = IO::Async::Timer::Periodic->new(
interval => 60,
on_tick => sub {
print "You've had a minute\n";
},
);
$timer->start;
$loop->add( $timer );
$loop->run;
=head1 DESCRIPTION
This subclass of L<IO::Async::Timer> implements repeating events at regular
clock intervals. The timing may or may not be subject to how long it takes the
callback to execute. Iterations may be rescheduled runs at fixed regular
intervals beginning at the time the timer was started, or by a fixed delay
after the previous code has finished executing.
For a C<Timer> object that only runs a callback once, after a given delay, see
instead L<IO::Async::Timer::Countdown>. A Countdown timer can also be used to
create repeating events that fire at a fixed delay after the previous event
has finished processing. See als the examples in
C<IO::Async::Timer::Countdown>.
=cut
local/lib/perl5/IO/Async/Timer/Periodic.pm view on Meta::CPAN
CODE reference for the C<on_tick> event.
=head2 interval => NUM
The interval in seconds between invocations of the callback or method. Cannot
be changed if the timer is running.
=head2 first_interval => NUM
Optional. If defined, the interval in seconds after calling the C<start>
method before the first invocation of the callback or method. Thereafter, the
regular C<interval> will be used. If not supplied, the first interval will be
the same as the others.
Even if this value is zero, the first invocation will be made asynchronously,
by the containing C<Loop> object, and not synchronously by the C<start> method
itself.
=head2 reschedule => STRING
Optional. Must be one of C<hard>, C<skip> or C<drift>. Defines the algorithm
used to reschedule the next invocation.
C<hard> schedules each iteration at the fixed interval from the previous
iteration's schedule time, ensuring a regular repeating event.
local/lib/perl5/IO/Async/Timer/Periodic.pm view on Meta::CPAN
passed. This matters if the duration is particularly short and there's a
possibility that times may be missed, or if the entire process is stopped and
resumed by C<SIGSTOP> or similar.
C<drift> schedules each iteration at the fixed interval from the time that the
previous iteration's event handler returns. This allows it to slowly drift over
time and become desynchronised with other events of the same interval or
multiples/fractions of it.
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 _init
{
my $self = shift;
$self->SUPER::_init( @_ );
$self->{reschedule} = "hard";
}
local/lib/perl5/IO/Async/Timer/Periodic.pm view on Meta::CPAN
elsif( $resched eq "skip" ) {
# How many ticks are needed?
my $ticks = POSIX::ceil( $now - $self->{next_time} );
# $self->{last_ticks} = $ticks;
$self->{next_time} += $next_interval * $ticks;
}
elsif( $resched eq "drift" ) {
$self->{next_time} = $now + $next_interval;
}
$self->SUPER::start;
}
sub start
{
my $self = shift;
$self->{is_first} = 1;
# Only actually define a time if we've got a loop; otherwise it'll just
# become start-pending. We'll calculate it properly when it gets added to
# the Loop
if( $self->loop ) {
$self->_reschedule;
}
else {
$self->SUPER::start;
}
}
sub stop
{
my $self = shift;
$self->SUPER::stop;
undef $self->{next_time};
}
local/lib/perl5/Module/Build.pm view on Meta::CPAN
This is an action intended for use by module authors, not people
installing modules. It will bring the F<MANIFEST> up to date with the
files currently present in the distribution. You may use a
F<MANIFEST.SKIP> file to exclude certain files or directories from
inclusion in the F<MANIFEST>. F<MANIFEST.SKIP> should contain a bunch
of regular expressions, one per line. If a file in the distribution
directory matches any of the regular expressions, it won't be included
in the F<MANIFEST>.
The following is a reasonable F<MANIFEST.SKIP> starting point, you can
add your own stuff to it:
^_build
^Build$
^blib
~$
\.bak$
^MANIFEST\.SKIP$
CVS
local/lib/perl5/Module/Build.pm view on Meta::CPAN
This action prints out a list of all prerequisites, the versions required, and
the versions actually installed. This can be useful for reviewing the
configuration of your system prior to a build, or when compiling data to send
for a bug report.
=item pure_install
[version 0.28]
This action is identical to the C<install> action. In the future,
though, when C<install> starts writing to the file
F<$(INSTALLARCHLIB)/perllocal.pod>, C<pure_install> won't, and that
will be the only difference between them.
=item realclean
[version 0.01]
This action is just like the C<clean> action, but also removes the
C<_build> directory and the C<Build> script. If you run the
C<realclean> action, you are essentially starting over, so you will
have to re-create the C<Build> script again.
=item retest
[version 0.2806]
This is just like the C<test> action, but doesn't actually build the
distribution first, and doesn't add F<blib/> to the load path, and
therefore will test against a I<previously> installed version of the
distribution. This can be used to verify that a certain installed
local/lib/perl5/Module/Build.pm view on Meta::CPAN
Sets the C<cpan_client> command for use with the C<installdeps> action.
See C<installdeps> for more details.
=item use_rcfile
Load the F<~/.modulebuildrc> option file. This option can be set to
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
in the F<.modulebuildrc> file in the directories referred to by
the environment variables C<HOMEDRIVE> + C<HOMEDIR>, C<USERPROFILE>,
C<APPDATA>, C<WINDIR>, C<SYS$LOGIN>. If the file exists, the options
specified there will be used as defaults, as if they were typed on the
command line. The defaults can be overridden by specifying new values
on the command line.
The action name must come at the beginning of the line, followed by any
amount of whitespace and then the options. Options are given the same
local/lib/perl5/Module/Build.pm view on Meta::CPAN
If you're installing an updated version of a module that was included
with perl itself (i.e. a "core module"), then you may set
C<installdirs> to "core" to overwrite the module in its present
location.
(Note that the 'script' line is different from C<MakeMaker> -
unfortunately there's no such thing as "installsitescript" or
"installvendorscript" entry in C<Config.pm>, so we use the
"installsitebin" and "installvendorbin" entries to at least get the
general location right. In the future, if C<Config.pm> adds some more
appropriate entries, we'll start using those.)
=item install_path
Once the defaults have been set, you can override them.
On the command line, that would look like this:
perl Build.PL --install_path lib=/foo/lib --install_path arch=/foo/lib/arch
or this:
local/lib/perl5/Module/Build.pm view on Meta::CPAN
Because of the complex nature of the prefixification logic, the
behavior of PREFIX in C<MakeMaker> has changed subtly over time.
Module::Build's --prefix logic is equivalent to the PREFIX logic found
in C<ExtUtils::MakeMaker> 6.30.
The maintainers of C<MakeMaker> do understand the troubles with the
PREFIX mechanism, and added INSTALL_BASE support in version 6.31 of
C<MakeMaker>, which was released in 2006.
If you don't need to retain compatibility with old versions (pre-6.31) of C<ExtUtils::MakeMaker> or
are starting a fresh Perl installation we recommend you use
C<install_base> instead (and C<INSTALL_BASE> in C<ExtUtils::MakeMaker>).
See L<Module::Build::Cookbook/Installing in the same location as
ExtUtils::MakeMaker> for further information.
=back
=head1 MOTIVATIONS
There are several reasons I wanted to start over, and not just fix
what I didn't like about C<MakeMaker>:
=over 4
=item *
I don't like the core idea of C<MakeMaker>, namely that C<make> should be
involved in the build process. Here are my reasons:
=over 4
local/lib/perl5/Module/Build/API.pod view on Meta::CPAN
An optional C<autosplit> argument specifies a file which should be run
through the L<AutoSplit::autosplit()|AutoSplit/autosplit> function.
If multiple files should be split, the argument may be given as an
array of the files to split.
In general I don't consider autosplitting a great idea, because it's
not always clear that autosplitting achieves its intended performance
benefits. It may even harm performance in environments like mod_perl,
where as much as possible of a module's code should be loaded during
startup.
=item build_class
[version 0.28]
The Module::Build class or subclass to use in the build script.
Defaults to "Module::Build" or the class name passed to or created by
a call to L</subclass()>. This property is useful if you're
writing a custom Module::Build subclass and have a bootstrapping
problem--that is, your subclass requires modules that may not be
local/lib/perl5/Module/Build/Authoring.pod view on Meta::CPAN
access to the data saved by these methods, and a way to update the
values. There is also a utility script called C<config_data>
distributed with Module::Build that provides a command line interface
to this same functionality. See also the generated
C<Foo::Bar::ConfigData> documentation, and the C<config_data>
script's documentation, for more information.
=head1 STARTING MODULE DEVELOPMENT
When starting development on a new module, it's rarely worth your time
to create a tree of all the files by hand. Some automatic
module-creators are available: the oldest is C<h2xs>, which has
shipped with perl itself for a long time. Its name reflects the fact
that modules were originally conceived of as a way to wrap up a C
library (thus the C<h> part) into perl extensions (thus the C<xs>
part).
These days, C<h2xs> has largely been superseded by modules like
C<ExtUtils::ModuleMaker>, and C<Module::Starter>. They have varying
degrees of support for C<Module::Build>.
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
my $cmd = $self->_quote_args(@cmd);
return `$cmd`;
}
}
# Tells us whether the construct open($fh, '-|', @command) is
# supported. It would probably be better to dynamically sense this.
sub have_forkpipe { 1 }
# Determine whether a given binary is the same as the perl
# (configuration) that started this process.
sub _perl_is_same {
my ($self, $perl) = @_;
my @cmd = ($perl);
# When run from the perl core, @INC will include the directories
# where perl is yet to be installed. We need to reference the
# absolute path within the source distribution where it can find
# it's Config.pm This also prevents us from picking up a Config.pm
# from a different configuration that happens to be already
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
}
}
sub is_executable {
# We assume this does the right thing on generic platforms, though
# we do some other more specific stuff on Unixish platforms.
my ($self, $file) = @_;
return -x $file;
}
sub _startperl { shift()->config('startperl') }
# Return any directories in @INC which are not in the default @INC for
# this perl. For example, stuff passed in with -I or loaded with "use lib".
sub _added_to_INC {
my $self = shift;
my %seen;
$seen{$_}++ foreach $self->_default_INC;
return grep !$seen{$_}++, @INC;
}
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
$q{magic_numfile} = $self->config_file('magicnum');
my @myINC = $self->_added_to_INC;
for (@myINC, values %q) {
$_ = File::Spec->canonpath( $_ ) unless $self->is_vmsish;
s/([\\\'])/\\$1/g;
}
my $quoted_INC = join ",\n", map " '$_'", @myINC;
my $shebang = $self->_startperl;
my $magic_number = $self->magic_number;
print $fh <<EOF;
$shebang
use strict;
use Cwd;
use File::Basename;
use File::Spec;
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
unless (Module::Metadata->find_module_by_name('Devel::Cover')) {
warn("Cannot run testcover action unless Devel::Cover is installed.\n");
return;
}
$self->add_to_cleanup('coverage', 'cover_db');
$self->depends_on('code');
# See whether any of the *.pm files have changed since last time
# testcover was run. If so, start over.
if (-e 'cover_db') {
my $pm_files = $self->rscan_dir
(File::Spec->catdir($self->blib, 'lib'), $self->file_qr('\.pm$') );
my $cover_files = $self->rscan_dir('cover_db', sub {-f $_ and not /\.html$/});
$self->do_system(qw(cover -delete))
unless $self->up_to_date($pm_files, $cover_files)
&& $self->up_to_date($self->test_files, $cover_files);
}
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
sub ACTION_pure_install {
shift()->depends_on('install');
}
sub ACTION_install {
my ($self) = @_;
require ExtUtils::Install;
$self->depends_on('build');
# RT#63003 suggest that odd circumstances that we might wind up
# in a different directory than we started, so wrap with _do_in_dir to
# ensure we get back to where we started; hope this fixes it!
$self->_do_in_dir( ".", sub {
ExtUtils::Install::install(
$self->install_map, $self->verbose, 0, $self->{args}{uninst}||0
);
});
if ($self->_is_ActivePerl && $self->{_completed_actions}{html}) {
$self->log_info("Building ActivePerl Table of Contents\n");
eval { ActivePerl::DocTools::WriteTOC(verbose => $self->verbose ? 1 : 0); 1; }
or $self->log_warn("AP::DT:: WriteTOC() failed: $@");
}
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
}
# Would be nice if Module::Signature took a directory argument.
$self->_do_in_dir($dir, sub {local $Module::Signature::Quiet = 1; Module::Signature::sign()});
}
sub _do_in_dir {
my ($self, $dir, $do) = @_;
my $start_dir = File::Spec->rel2abs($self->cwd);
chdir $dir or die "Can't chdir() to $dir: $!";
eval {$do->()};
my @err = $@ ? ($@) : ();
chdir $start_dir or push @err, "Can't chdir() back to $start_dir: $!";
die join "\n", @err if @err;
}
sub ACTION_distsign {
my ($self) = @_;
{
local $self->{properties}{sign} = 0; # We'll sign it ourselves
$self->depends_on('distdir') unless -d $self->dist_dir;
}
$self->_sign_dir($self->dist_dir);
local/lib/perl5/Module/Build/Cookbook.pm view on Meta::CPAN
The behavior of C<prefix> is complicated and depends on
how your Perl is configured. The resulting installation locations
will vary from machine to machine and even different installations of
Perl on the same machine. Because of this, it's difficult to document
where C<prefix> will place your modules.
In contrast, C<install_base> has predictable, easy to explain
installation locations. Now that C<Module::Build> and C<MakeMaker> both
have C<install_base> there is little reason to use C<prefix> other
than to preserve your existing installation locations. If you are
starting a fresh Perl installation we encourage you to use
C<install_base>. If you have an existing installation installed via
C<prefix>, consider moving it to an installation structure matching
C<install_base> and using that instead.
=head2 Running a single test file
C<Module::Build> supports running a single test, which enables you to
track down errors more quickly. Use the following format:
local/lib/perl5/Module/Build/Platform/MacOS.pm view on Meta::CPAN
sub new {
my $class = shift;
my $self = $class->SUPER::new(@_);
# $Config{sitelib} and $Config{sitearch} are, unfortunately, missing.
foreach ('sitelib', 'sitearch') {
$self->config($_ => $self->config("install$_"))
unless $self->config($_);
}
# For some reason $Config{startperl} is filled with a bunch of crap.
(my $sp = $self->config('startperl')) =~ s/.*Exit \{Status\}\s//;
$self->config(startperl => $sp);
return $self;
}
sub make_executable {
my $self = shift;
require MacPerl;
foreach (@_) {
MacPerl::SetFileInfo('McPL', 'TEXT', $_);
}
local/lib/perl5/Module/Build/Platform/Unix.pm view on Meta::CPAN
# We consider the owner bit to be authoritative on a file, because
# -x will always return true if the user is root and *any*
# executable bit is set. The -x test seems to try to answer the
# question "can I execute this file", but I think we want "is this
# file executable".
my ($self, $file) = @_;
return +(stat $file)[2] & 0100;
}
sub _startperl { "#! " . shift()->perl }
sub _construct {
my $self = shift()->SUPER::_construct(@_);
# perl 5.8.1-RC[1-3] had some broken %Config entries, and
# unfortunately Red Hat 9 shipped it like that. Fix 'em up here.
my $c = $self->{config};
for (qw(siteman1 siteman3 vendorman1 vendorman3)) {
$c->{"install${_}dir"} ||= $c->{"install${_}"};
}
local/lib/perl5/Module/Build/Platform/Windows.pm view on Meta::CPAN
if ( lc $basename eq lc $self->build_script ) {
if ( $self->build_bat ) {
$self->log_verbose("Deleting $basename.bat\n");
my $full_progname = $0;
$full_progname =~ s/(?:\.bat)?$/.bat/i;
# Voodoo required to have a batch file delete itself without error;
# Syntax differs between 9x & NT: the later requires a null arg (???)
require Win32;
my $null_arg = (Win32::IsWinNT()) ? '""' : '';
my $cmd = qq(start $null_arg /min "\%comspec\%" /c del "$full_progname");
open(my $fh, '>>', "$basename.bat")
or die "Can't create $basename.bat: $!";
print $fh $cmd;
close $fh ;
} else {
$self->delete_filetree($self->build_script . '.bat');
}
}
}
local/lib/perl5/Module/Build/Platform/Windows.pm view on Meta::CPAN
$head =~ s/^\s+//gm;
my $headlines = 2 + ($head =~ tr/\n/\n/);
my $tail = "\n__END__\n:endofperl\n";
my $linedone = 0;
my $taildone = 0;
my $linenum = 0;
my $skiplines = 0;
my $start = $Config{startperl};
$start = "#!perl" unless $start =~ /^#!.*perl/;
open(my $in, '<', "$opts{in}") or die "Can't open $opts{in}: $!";
my @file = <$in>;
close($in);
foreach my $line ( @file ) {
$linenum++;
if ( $line =~ /^:endofperl\b/ ) {
if (!exists $opts{update}) {
warn "$opts{in} has already been converted to a batch file!\n";
local/lib/perl5/Module/Build/Platform/Windows.pm view on Meta::CPAN
}
$linedone++;
}
if ( $line =~ /^#\s*line\b/ and $linenum == 2 + $skiplines ) {
$line = "";
}
}
open(my $out, '>', "$opts{out}") or die "Can't open $opts{out}: $!";
print $out $head;
print $out $start, ( $opts{usewarnings} ? " -w" : "" ),
"\n#line ", ($headlines+1), "\n" unless $linedone;
print $out @file[$skiplines..$#file];
print $out $tail unless $taildone;
close($out);
return $opts{out};
}
sub _quote_args {
local/lib/perl5/Sub/Uplevel.pm view on Meta::CPAN
#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'"
my $old_W = $^W;
( run in 0.857 second using v1.01-cache-2.11-cpan-0d8aa00de5b )