Acme-Sort-Sleep

 view release on metacpan or  search on metacpan

local/lib/perl5/Future.pm  view on Meta::CPAN

the function or method calls.

 my ( $results, $here ) = future_returning_function( @args )->get;

The F<examples> directory in the distribution contains some examples of how
futures might be integrated with various event systems.

=head2 DEBUGGING

By the time a C<Future> object is destroyed, it ought to have been completed
or cancelled. By enabling debug tracing of objects, this fact can be checked.
If a future object is destroyed without having been completed or cancelled, a
warning message is printed.

 $ PERL_FUTURE_DEBUG=1 perl -MFuture -E 'my $f = Future->new'
 Future=HASH(0xaa61f8) was constructed at -e line 1 and was lost near -e line 0 before it was ready.

Note that due to a limitation of perl's C<caller> function within a C<DESTROY>
destructor method, the exact location of the leak cannot be accurately
determined. Often the leak will occur due to falling out of scope by returning
from a function; in this case the leak location may be reported as being the

local/lib/perl5/Future.pm  view on Meta::CPAN

 sub foo {
    my $f = Future->new;
 }

 foo();
 print "Finished\n";

 Future=HASH(0x14a2220) was constructed at - line 2 and was lost near - line 6 before it was ready.
 Finished

A warning is also printed in debug mode if a C<Future> object is destroyed
that completed with a failure, but the object believes that failure has not
been reported anywhere.

 $ PERL_FUTURE_DEBUG=1 perl -Mblib -MFuture -E 'my $f = Future->fail("Oops")'
 Future=HASH(0xac98f8) was constructed at -e line 1 and was lost near -e line 0 with an unreported failure of: Oops

Such a failure is considered reported if the C<get> or C<failure> methods are
called on it, or it had at least one C<on_ready> or C<on_fail> callback, or
its failure is propagated to another C<Future> instance (by a sequencing or
converging method).

local/lib/perl5/Future.pm  view on Meta::CPAN

         : () ),
      ( $TIMES ?
         ( btime => [ gettimeofday ] )
         : () ),
   }, ( ref $proto || $proto );
}

my $GLOBAL_END;
END { $GLOBAL_END = 1; }

sub DESTROY_debug {
   my $self = shift;
   return if $GLOBAL_END;
   return if $self->{ready} and ( $self->{reported} or !$self->{failure} );

   my $lost_at = join " line ", (caller)[1,2];
   # We can't actually know the real line where the last reference was lost; 
   # a variable set to 'undef' or close of scope, because caller can't see it;
   # the current op has already been updated. The best we can do is indicate
   # 'near'.

   if( $self->{ready} and $self->{failure} ) {
      warn "${\$self->__selfstr} was $self->{constructed_at} and was lost near $lost_at with an unreported failure of: " .
         $self->{failure}[0] . "\n";
   }
   elsif( !$self->{ready} ) {
      warn "${\$self->__selfstr} was $self->{constructed_at} and was lost near $lost_at before it was ready.\n";
   }
}
*DESTROY = \&DESTROY_debug if DEBUG;

=head2 done I<(class method)>

=head2 fail I<(class method)>

   $future = Future->done( @values )

   $future = Future->fail( $exception, @details )

I<Since version 0.26.>

local/lib/perl5/Future.pm  view on Meta::CPAN

=head2 label

   $future = $future->set_label( $label )

   $label = $future->label

I<Since version 0.28.>

Chaining mutator and accessor for the label of the C<Future>. This should be a
plain string value, whose value will be stored by the future instance for use
in debugging messages or other tooling, or similar purposes.

=cut

sub set_label
{
   my $self = shift;
   ( $self->{label} ) = @_;
   return $self;
}

local/lib/perl5/IO/Async/Debug.pm  view on Meta::CPAN

our $VERSION = '0.70';

our $DEBUG = $ENV{IO_ASYNC_DEBUG} || 0;
our $DEBUG_FD   = $ENV{IO_ASYNC_DEBUG_FD};
our $DEBUG_FILE = $ENV{IO_ASYNC_DEBUG_FILE};
our $DEBUG_FH;
our %DEBUG_FLAGS = map { $_ => 1 } split m/,/, $ENV{IO_ASYNC_DEBUG_FLAGS} || "";

=head1 NAME

C<IO::Async::Debug> - debugging control and support for L<IO::Async>

=head1 DESCRIPTION

The following methods and behaviours are still experimental and may change or
even be removed in future.

Debugging support is enabled by an environment variable called
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.

Extra debugging flags can be set in a comma-separated list in an environment
variable called C<IO_ASYNC_DEBUG_FLAGS>. The presence of these flags can cause
extra information to be written to the log. Full details on these flags will
be documented by the implementing classes. Typically these flags take the form
of one or more capital letters indicating the class, followed by one or more
lowercase letters enabling some particular feature within that class.

=cut

sub logf
{

local/lib/perl5/IO/Async/FileStream.pm  view on Meta::CPAN

   my ( $want ) = @_;

   croak "Cannot _watch_write in " . ref($self) if $want;
}

sub on_devino_changed
{
   my $self = shift or return;

   $self->{renamed} = 1;
   $self->debug_printf( "read tail of old file" );
   $self->read_more;
}

sub on_size_changed
{
   my $self = shift or return;
   my ( $size ) = @_;

   if( $size < $self->{last_size} ) {
      $self->maybe_invoke_event( on_truncated => );
      $self->{last_pos} = 0;
   }

   $self->{last_size} = $size;

   $self->debug_printf( "read_more" );
   $self->read_more;
}

sub read_more
{
   my $self = shift;

   sysseek( $self->read_handle, $self->{last_pos}, SEEK_SET ) if defined $self->{last_pos};

   $self->on_read_ready;

   $self->{last_pos} = sysseek( $self->read_handle, 0, SEEK_CUR ); # == systell

   if( $self->{last_pos} < $self->{last_size} ) {
      $self->loop->later( sub { $self->read_more } );
   }
   elsif( $self->{renamed} ) {
      $self->debug_printf( "reopening for rename" );

      $self->{last_size} = 0;

      if( $self->{last_pos} ) {
         $self->maybe_invoke_event( on_truncated => );
         $self->{last_pos} = 0;
         $self->loop->later( sub { $self->read_more } );
      }

      $self->configure( read_handle => $self->{file}->handle );

local/lib/perl5/IO/Async/Function.pm  view on Meta::CPAN

   my $args = delete $params{args};
   ref $args eq "ARRAY" or croak "Expected 'args' to be an array";

   my ( $on_done, $on_fail );
   if( defined $params{on_result} ) {
      my $on_result = delete $params{on_result};
      ref $on_result or croak "Expected 'on_result' to be a reference";

      $on_done = $self->_capture_weakself( sub {
         my $self = shift or return;
         $self->debug_printf( "CONT on_result return" );
         $on_result->( return => @_ );
      } );
      $on_fail = $self->_capture_weakself( sub {
         my $self = shift or return;
         my ( $err, @values ) = @_;
         $self->debug_printf( "CONT on_result error" );
         $on_result->( error => @values );
      } );
   }
   elsif( defined $params{on_return} and defined $params{on_error} ) {
      my $on_return = delete $params{on_return};
      ref $on_return or croak "Expected 'on_return' to be a reference";
      my $on_error  = delete $params{on_error};
      ref $on_error or croak "Expected 'on_error' to be a reference";

      $on_done = $self->_capture_weakself( sub {
         my $self = shift or return;
         $self->debug_printf( "CONT on_return" );
         $on_return->( @_ );
      } );
      $on_fail = $self->_capture_weakself( sub {
         my $self = shift or return;
         $self->debug_printf( "CONT on_error" );
         $on_error->( @_ );
      } );
   }
   elsif( !defined wantarray ) {
      croak "Expected either 'on_result' or 'on_return' and 'on_error' keys, or to return a Future";
   }

   my $request = IO::Async::Channel->encode( $args );

   my $future;
   if( my $worker = $self->_get_worker ) {
      $self->debug_printf( "CALL" );
      $future = $self->_call_worker( $worker, $request );
   }
   else {
      $self->debug_printf( "QUEUE" );
      push @{ $self->{pending_queue} }, my $wait_f = $self->loop->new_future;

      $future = $wait_f->then( sub {
         my ( $self, $worker ) = @_;
         $self->_call_worker( $worker, $request );
      });
   }

   $future->on_done( $on_done ) if $on_done;
   $future->on_fail( $on_fail ) if $on_fail;

local/lib/perl5/IO/Async/Function.pm  view on Meta::CPAN

sub _dispatch_pending
{
   my $self = shift;

   while( my $next = shift @{ $self->{pending_queue} } ) {
      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

local/lib/perl5/IO/Async/Handle.pm  view on Meta::CPAN

=cut

sub connect
{
   my $self = shift;
   my %args = @_;

   my $loop = $self->loop or croak "Cannot ->connect a Handle that is not in a Loop";

   $self->debug_printf( "CONNECT " . join( ", ",
      # These args should be stringy
      ( map { defined $args{$_} ? "$_=$args{$_}" : () } qw( host service family socktype protocol local_host local_service ) )
   ) );

   return $self->loop->connect( %args, handle => $self );
}

=head1 SEE ALSO

=over 4

local/lib/perl5/IO/Async/Loop.pm  view on Meta::CPAN

failures among the first attempts, before a valid connection is made. For
example, the resolver may have returned some IPv6 addresses, but only IPv4
routes are valid on the system. In this case, the first C<connect(2)> syscall
will fail. This isn't yet a fatal error, if there are more addresses to try,
perhaps some IPv4 ones.

For this reason, it is possible that the operation eventually succeeds even
though some system calls initially fail. To be aware of individual failures,
the optional C<on_fail> callback can be used. This will be invoked on each
individual C<socket(2)> or C<connect(2)> failure, which may be useful for
debugging or logging.

Because this module simply uses the C<getaddrinfo> resolver, it will be fully
IPv6-aware if the underlying platform's resolver is. This allows programs to
be fully IPv6-capable.

In plain address mode, the C<%params> hash takes the following keys:

=over 8

=item addrs => ARRAY

local/lib/perl5/IO/Async/Loop.pm  view on Meta::CPAN

parameter even if one was not provided to the original C<< $loop->listen >>
call, and it will not receive any of the C<on_*> event callbacks. It should
use the C<acceptor> parameter on the C<listener> object.

=cut

=head1 STALL WATCHDOG

A well-behaved L<IO::Async> program should spend almost all of its time
blocked on input using the underlying C<IO::Async::Loop> instance. The stall
watchdog is an optional debugging feature to help detect CPU spinlocks and
other bugs, where control is not returned to the loop every so often.

If the watchdog is enabled and an event handler consumes more than a given
amount of real time before returning to the event loop, it will be interrupted
by printing a stack trace and terminating the program. The watchdog is only in
effect while the loop itself is not blocking; it won't fail simply because the
loop instance is waiting for input or timers.

It is implemented using C<SIGALRM>, so if enabled, this signal will no longer
be available to user code. (Though in any case, most uses of C<alarm()> and

local/lib/perl5/IO/Async/Loop.pm  view on Meta::CPAN

Enables the stall watchdog if set to a non-zero value.

=item IO_ASYNC_WATCHDOG_INTERVAL => INT

Watchdog interval, in seconds, to pass to the C<alarm(2)> call. Defaults to 10
seconds.

=item IO_ASYNC_WATCHDOG_SIGABRT => BOOL

If enabled, the watchdog signal handler will raise a C<SIGABRT>, which usually
has the effect of breaking out of a running program in debuggers such as
F<gdb>. If not set then the process is terminated by throwing an exception with
C<die>.

=back

=cut

=head1 AUTHOR

Paul Evans <leonerd@leonerd.org.uk>

local/lib/perl5/IO/Async/Notifier.pm  view on Meta::CPAN

   my ( $event_name ) = @_;

   my $code = $self->can_event( $event_name )
      or croak "$self cannot handle $event_name event";

   my $caller = caller;

   return $self->_capture_weakself( 
      !$IO::Async::Debug::DEBUG ? $code : sub {
         my $self = $_[0];
         $self->_debug_printf_event( $caller, $event_name );
         goto &$code;
      }
   );
}

=head2 maybe_make_event_cb

   $callback = $notifier->maybe_make_event_cb( $event_name )

Similar to C<make_event_cb> but will return C<undef> if the object cannot

local/lib/perl5/IO/Async/Notifier.pm  view on Meta::CPAN

   my ( $event_name ) = @_;

   my $code = $self->can_event( $event_name )
      or return undef;

   my $caller = caller;

   return $self->_capture_weakself(
      !$IO::Async::Debug::DEBUG ? $code : sub {
         my $self = $_[0];
         $self->_debug_printf_event( $caller, $event_name );
         goto &$code;
      }
   );
}

=head2 invoke_event

   @ret = $notifier->invoke_event( $event_name, @args )

Invokes the given event handler, passing in the given arguments. Event

local/lib/perl5/IO/Async/Notifier.pm  view on Meta::CPAN

=cut

sub invoke_event
{
   my $self = shift;
   my ( $event_name, @args ) = @_;

   my $code = $self->can_event( $event_name )
      or croak "$self cannot handle $event_name event";

   $self->_debug_printf_event( scalar caller, $event_name ) if $IO::Async::Debug::DEBUG;
   return $code->( $self, @args );
}

=head2 maybe_invoke_event

   $retref = $notifier->maybe_invoke_event( $event_name, @args )

Similar to C<invoke_event> but will return C<undef> if the object cannot
handle the name event, rather than throwing an exception. In order to
distinguish this from an event-handling function that simply returned

local/lib/perl5/IO/Async/Notifier.pm  view on Meta::CPAN

=cut

sub maybe_invoke_event
{
   my $self = shift;
   my ( $event_name, @args ) = @_;

   my $code = $self->can_event( $event_name )
      or return undef;

   $self->_debug_printf_event( scalar caller, $event_name ) if $IO::Async::Debug::DEBUG;
   return [ $code->( $self, @args ) ];
}

=head1 DEBUGGING SUPPORT

=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.

For example, invoking

 $stream->debug_printf( "EVENT on_read" )

On an L<IO::Async::Stream> instance reading and writing a file descriptor
whose C<fileno> is 4, which is a child of an L<IO::Async::Protocol::Stream>,
will produce a line of output:

 [Ia:Stream{rw=4}<-IaP:Stream] EVENT on_read

=cut

sub debug_printf
{
   $IO::Async::Debug::DEBUG or return;

   my $self = shift;
   my ( $format, @args ) = @_;

   my @id;
   while( $self ) {
      push @id, ref $self;

local/lib/perl5/IO/Async/Notifier.pm  view on Meta::CPAN

      $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
{
   my $self = shift;
   my ( $caller, $event_name ) = @_;

   my $class = ref $self;

   if( $IO::Async::Debug::DEBUG > 1 or $class eq $caller ) {
      s/^IO::Async::Protocol::/IaP:/,
      s/^IO::Async::/Ia:/,
      s/^Net::Async::/Na:/ for my $str_caller = $caller;

      $self->debug_printf( "EVENT %s",
         ( $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.

local/lib/perl5/IO/Async/Process.pm  view on Meta::CPAN

   $self->{pid} = $loop->spawn_child(
      code    => $self->{code},
      command => $self->{command},

      setup => \@setup,

      on_exit => $self->_capture_weakself( sub {
         ( my $self, undef, $exitcode, $dollarbang, $dollarat ) = @_;

         $self->debug_printf( "EXIT status=0x%04x", $exitcode ) if $self;
         $exit_future->done unless $exit_future->is_cancelled;
      } ),
   );
   $self->{running} = 1;

   $self->SUPER::_add_to_loop( @_ );

   $_->close for values %{ delete $self->{to_close} };

   my $is_code = defined $self->{code};

local/lib/perl5/IO/Async/Stream.pm  view on Meta::CPAN

      $head->data .= $second->data;
      $head->on_write = $second->on_write;
      $head->on_flush = $second->on_flush;
      splice @$writequeue, 1, 1, ();
   }

   die "TODO: head data does not contain a plain string" if ref $head->data;

   if( $IO::Async::Debug::DEBUG > 1 ) {
      my $data = substr $head->data, 0, $head->writelen;
      $self->debug_printf( "WRITE len=%d", length $data );
      IO::Async::Debug::log_hexdump( $data ) if $IO::Async::Debug::DEBUG_FLAGS{Sw};
   }

   my $writer = $self->{writer};
   my $len = $self->$writer( $self->write_handle, $head->data, $head->writelen );

   if( !defined $len ) {
      my $errno = $!;

      if( $errno == EAGAIN or $errno == EWOULDBLOCK ) {

local/lib/perl5/IO/Async/Stream.pm  view on Meta::CPAN

         foreach ( @{ $self->{readqueue} } ) {
            $_->future->fail( "read failed: $errno", sysread => $errno ) if $_->future;
         }
         undef @{ $self->{readqueue} };

         return;
      }

      if( $IO::Async::Debug::DEBUG > 1 ) {
         $self->debug_printf( "READ len=%d", $len );
         IO::Async::Debug::log_hexdump( $data ) if $IO::Async::Debug::DEBUG_FLAGS{Sr};
      }

      my $eof = $self->{read_eof} = ( $len == 0 );

      if( my $encoding = $self->{encoding} ) {
         my $bytes = defined $self->{bytes_remaining} ? $self->{bytes_remaining} . $data : $data;
         $data = $encoding->decode( $bytes, STOP_AT_PARTIAL );
         $self->{bytes_remaining} = $bytes;
      }

local/lib/perl5/Module/Build.pm  view on Meta::CPAN

[version 0.01]

This will use C<Test::Harness> or C<TAP::Harness> to run any regression
tests and report their results. Tests can be defined in the standard
places: a file called C<test.pl> in the top-level directory, or several
files ending with C<.t> in a C<t/> directory.

If you want tests to be 'verbose', i.e. show details of test execution
rather than just summary information, pass the argument C<verbose=1>.

If you want to run tests under the perl debugger, pass the argument
C<debugger=1>.

If you want to have Module::Build find test files with different file
name extensions, pass the C<test_file_exts> argument with an array
of extensions, such as C<[qw( .t .s .z )]>.

If you want test to be run by C<TAP::Harness>, rather than C<Test::Harness>,
pass the argument C<tap_harness_args> as an array reference of arguments to
pass to the TAP::Harness constructor.

In addition, if a file called C<visual.pl> exists in the top-level

local/lib/perl5/Module/Build.pm  view on Meta::CPAN

To pass options to C<Devel::Cover>, set the C<$DEVEL_COVER_OPTIONS>
environment variable:

  DEVEL_COVER_OPTIONS=-ignore,Build ./Build testcover

=item testdb

[version 0.05]

This is a synonym for the 'test' action with the C<debugger=1>
argument.

=item testpod

[version 0.25]

This checks all the files described in the C<docs> action and
produces C<Test::Harness>-style output.  If you are a module author,
this is useful to run before creating a new release.

local/lib/perl5/Module/Build.pm  view on Meta::CPAN

false to prevent the custom resource file from being loaded.

=item allow_mb_mismatch

Suppresses the check upon startup that the version of Module::Build
we're now running under is the same version that was initially invoked
when building the distribution (i.e. when the C<Build.PL> script was
first run).  As of 0.3601, a mismatch results in a warning instead of
a fatal error, so this option effectively just suppresses the warning.

=item debug

Prints Module::Build debugging information to STDOUT, such as a trace of
executed build actions.

=back

=head2 Default Options File (F<.modulebuildrc>)

[version 0.28]

When Module::Build starts up, it will look first for a file,
F<$ENV{HOME}/.modulebuildrc>.  If it's not found there, it will look

local/lib/perl5/Module/Build/API.pod  view on Meta::CPAN

=item cpan_client()

=item create_license()

=item create_makefile_pl()

=item create_packlist()

=item create_readme()

=item debug()

=item debugger()

=item destdir()

=item dynamic_config()

=item extra_manify_args()

=item get_options()

=item html_css()

local/lib/perl5/Module/Build/Base.pm  view on Meta::CPAN

################## End constructors #########################

sub log_info {
  my $self = shift;
  print @_ if ref($self) && ( $self->verbose || ! $self->quiet );
}
sub log_verbose {
  my $self = shift;
  print @_ if ref($self) && $self->verbose;
}
sub log_debug {
  my $self = shift;
  print @_ if ref($self) && $self->debug;
}

sub log_warn {
  # Try to make our call stack invisible
  shift;
  if (@_ and $_[-1] !~ /\n$/) {
    my (undef, $file, $line) = caller();
    warn @_, " at $file line $line.\n";
  } else {
    warn @_;

local/lib/perl5/Module/Build/Base.pm  view on Meta::CPAN

__PACKAGE__->add_property($_) for qw(
  PL_files
  autosplit
  base_dir
  bindoc_dirs
  c_source
  cover
  create_license
  create_makefile_pl
  create_readme
  debugger
  destdir
  dist_abstract
  dist_author
  dist_name
  dist_suffix
  dist_version
  dist_version_from
  extra_compiler_flags
  extra_linker_flags
  has_config_data

local/lib/perl5/Module/Build/Base.pm  view on Meta::CPAN

  program_name
  quiet
  recursive_test_files
  release_status
  script_files
  scripts
  share_dir
  sign
  test_files
  verbose
  debug
  xs_files
  extra_manify_args
);

sub config {
  my $self = shift;
  my $c = ref($self) ? $self->{config} : 'Module::Build::Config';
  return $c->all_config unless @_;

  my $key = shift;

local/lib/perl5/Module/Build/Base.pm  view on Meta::CPAN

}

sub _call_action {
  my ($self, $action) = @_;

  return if $self->{_completed_actions}{$action}++;

  local $self->{action} = $action;
  my $method = $self->can_action( $action );
  die "No action '$action' defined, try running the 'help' action.\n" unless $method;
  $self->log_debug("Starting ACTION_$action\n");
  my $rc = $self->$method();
  $self->log_debug("Finished ACTION_$action\n");
  return $rc;
}

sub can_action {
  my ($self, $action) = @_;
  return $self->can( "ACTION_$action" );
}

# cuts the user-specified options out of the command-line args
sub cull_options {

local/lib/perl5/Module/Build/Base.pm  view on Meta::CPAN

    use_tap_harness
    tap_harness_args
    cpan_client
    pureperl_only
    allow_pureperl
  ); # normalize only selected option names

  return $opt;
}

my %singular_argument = map { ($_ => 1) } qw/install_base prefix destdir installdirs verbose quiet uninst debug sign/;

sub _read_arg {
  my ($self, $args, $key, $val) = @_;

  $key = $self->_translate_option($key);

  if ( exists $args->{$key} and not $singular_argument{$key} ) {
    $args->{$key} = [ $args->{$key} ] unless ref $args->{$key};
    push @{$args->{$key}}, $val;
  } else {

local/lib/perl5/Module/Build/Base.pm  view on Meta::CPAN

  my @bool_opts = qw(
    build_bat
    create_license
    create_readme
    pollute
    quiet
    uninst
    use_rcfile
    verbose
    debug
    sign
    use_tap_harness
    pureperl_only
    allow_pureperl
  );

  # inverted boolean options; eg --noverbose or --no-verbose
  # converted to proper name & returned with false value (verbose, 0)
  if ( grep $opt =~ /^no[-_]?$_$/, @bool_opts ) {
    $opt =~ s/^no-?//;

local/lib/perl5/Module/Build/Base.pm  view on Meta::CPAN

    my $self = shift;
    # This will get run and the user will see the output.  It doesn't
    # emit Test::Harness-style output.
    $self->run_perl_script('visual.pl', '-Mblib='.$self->blib)
        if -e 'visual.pl';
}

sub harness_switches {
    my $self = shift;
    my @res;
    push @res, qw(-w -d) if $self->{properties}{debugger};
    push @res, '-MDevel::Cover' if $self->{properties}{cover};
    return @res;
}

sub test_files {
  my $self = shift;
  my $p = $self->{properties};
  if (@_) {
    return $p->{test_files} = (@_ == 1 ? shift : [@_]);
  }

local/lib/perl5/Module/Build/Base.pm  view on Meta::CPAN

  my $exts = $self->{properties}{test_file_exts};

  return sort map { @{$self->rscan_dir($dir, qr{^[^.].*\Q$_\E$})} } @$exts
    if $self->recursive_test_files;

  return sort map { glob File::Spec->catfile($dir, "*$_") } @$exts;
}

sub ACTION_testdb {
  my ($self) = @_;
  local $self->{properties}{debugger} = 1;
  $self->depends_on('test');
}

sub ACTION_testcover {
  my ($self) = @_;

  unless (Module::Metadata->find_module_by_name('Devel::Cover')) {
    warn("Cannot run testcover action unless Devel::Cover is installed.\n");
    return;
  }

local/lib/perl5/Module/Build/Base.pm  view on Meta::CPAN

  my( %prime, %alt );
  foreach my $file (@{$file_list}) {
    my $mapped_filename = $filename_map->{$file};
    my @path = split( /\//, $mapped_filename );
    (my $prime_package = join( '::', @path[1..$#path] )) =~ s/\.pm$//;

    my $pm_info = Module::Metadata->new_from_file( $file );

    foreach my $package ( $pm_info->packages_inside ) {
      next if $package eq 'main';  # main can appear numerous times, ignore
      next if $package eq 'DB';    # special debugging package, ignore
      next if grep /^_/, split( /::/, $package ); # private package, ignore

      my $version = $pm_info->version( $package );

      if ( $package eq $prime_package ) {
        if ( exists( $prime{$package} ) ) {
          # Module::Metadata will handle this conflict
          die "Unexpected conflict in '$package'; multiple versions found.\n";
        } else {
          $prime{$package}{file} = $mapped_filename;

local/lib/perl5/Sub/Uplevel.pm  view on Meta::CPAN

#pod         print "Before\n";
#pod         my @out = uplevel 1, &some_func;
#pod         print "After\n";
#pod         return @out;
#pod     }
#pod
#pod C<uplevel> has the ability to issue a warning if C<$num_frames> is more than
#pod the current call stack depth, although this warning is disabled and compiled
#pod out by default as the check is relatively expensive.
#pod
#pod To enable the check for debugging or testing, you should set the global
#pod C<$Sub::Uplevel::CHECK_FRAMES> to true before loading Sub::Uplevel for the
#pod first time as follows:
#pod
#pod     #!/usr/bin/perl
#pod     
#pod     BEGIN {
#pod         $Sub::Uplevel::CHECK_FRAMES = 1;
#pod     }
#pod     use Sub::Uplevel;
#pod

local/lib/perl5/Sub/Uplevel.pm  view on Meta::CPAN

        print "Before\n";
        my @out = uplevel 1, &some_func;
        print "After\n";
        return @out;
    }

C<uplevel> has the ability to issue a warning if C<$num_frames> is more than
the current call stack depth, although this warning is disabled and compiled
out by default as the check is relatively expensive.

To enable the check for debugging or testing, you should set the global
C<$Sub::Uplevel::CHECK_FRAMES> to true before loading Sub::Uplevel for the
first time as follows:

    #!/usr/bin/perl
    
    BEGIN {
        $Sub::Uplevel::CHECK_FRAMES = 1;
    }
    use Sub::Uplevel;

local/lib/perl5/Test/Future.pm  view on Meta::CPAN

constructed while doing so. After the code has returned, each of these
instances are inspected to check that they are not still pending. If they are
all either ready (by success or failure) or cancelled, the test will pass. If
any are still pending then the test fails.

If L<Devel::MAT> is installed, it will be used to write a memory state dump
after a failure. It will create a F<.pmat> file named the same as the unit
test, but with the trailing F<.t> suffix replaced with F<-TEST.pmat> where
C<TEST> is the number of the test that failed (in case there was more than
one). A list of addresses of C<Future> instances that are still pending is
also printed to assist in debugging the issue.

It is not an error if the code does not construct any C<Future> instances at
all. The block of code may contain other testing assertions; they will be run
before the assertion by C<no_pending_futures> itself.

=cut

sub no_pending_futures(&@)
{
   my ( $code, $name ) = @_;