Acme-Sort-Sleep

 view release on metacpan or  search on metacpan

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

failure.

The convention is that after the initial message string as the first required
argument (intended for display to humans), the second argument is a short
lowercase string that relates in some way to the kind of failure that
occurred. Following this is a list of details about that kind of failure,
whose exact arrangement or structure are determined by the failure category.
For example, L<IO::Async> and L<Net::Async::HTTP> use this convention to
indicate at what stage a given HTTP request has failed:

   ->fail( $message, http => ... )  # an HTTP-level error during protocol
   ->fail( $message, connect => ... )  # a TCP-level failure to connect a
                                       # socket
   ->fail( $message, resolve => ... )  # a resolver (likely DNS) failure
                                       # to resolve a hostname

By following this convention, a module remains consistent with other
C<Future>-based modules, and makes it easy for program logic to gracefully
handle and manage failures by use of the C<catch> method.

=head2 SUBCLASSING

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

   return $self;
}

=head2 cancel

   $future->cancel

Requests that the future be cancelled, immediately marking it as ready. This
will invoke all of the code blocks registered by C<on_cancel>, in the reverse
order. When called on a convergent future, all its component futures are also
cancelled. It is not an error to attempt to cancel a future that is already
complete or cancelled; it simply has no effect.

Returns the C<$future>.

=cut

sub cancel
{
   my $self = shift;

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


In some cases the code should return a future; in some it should return an
immediate result. If a future is returned, the combined future will then wait
for the result of this second one. If the combinined future is cancelled, it
will cancel either the first future or the second, depending whether the first
had completed. If the code block throws an exception instead of returning a
value, the sequence future will fail with that exception as its message and no
further values.

As it is always a mistake to call these sequencing methods in void context and lose the
reference to the returned future (because exception/error handling would be
silently dropped), this method warns in void context.

=cut

sub _sequence
{
   my $f1 = shift;
   my ( $code, $flags ) = @_;

   # For later, we might want to know where we were called from

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


             return 0;
          }
       );

       $stream->write( "An initial line here\n" );

       $loop->add( $stream );
    },

    on_resolve_error => sub { die "Cannot resolve - $_[-1]\n"; },
    on_connect_error => sub { die "Cannot connect - $_[0] failed $_[-1]\n"; },
 );

 $loop->run;

=head1 DESCRIPTION

This collection of modules allows programs to be written that perform
asynchronous filehandle IO operations. A typical program using them would
consist of a single subclass of L<IO::Async::Loop> to act as a container of
other objects, which perform the actual IO work required by the program. As

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

represents an ongoing source of activity, such as a readable filehandle of
bytes or a POSIX signal.

Futures are a recent addition to the C<IO::Async> API and details are still
subject to change and experimentation.

In general, methods that support Futures return a new Future object to
represent the outstanding operation. If callback functions are supplied as
well, these will be fired in addition to the Future object becoming ready. Any
failures that are reported will, in general, use the same conventions for the
Future's C<fail> arguments to relate it to the legacy C<on_error>-style
callbacks.

 $on_NAME_error->( $message, @argmuents )

 $f->fail( $message, NAME, @arguments )

where C<$message> is a message intended for humans to read (so that this is
the message displayed by C<< $f->get >> if the failure is not otherwise
caught), C<NAME> is the name of the failing operation. If the failure is due
to a failed system call, the value of C<$!> will be the final argument. The
message should not end with a linefeed.

=head2 Networking

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

 $loop->spawn_child(
    code => sub {
       do_something; # executes in a child process
       return 1;
    },

    on_exit => sub {
       my ( $pid, $exitcode, $dollarbang, $dollarat ) = @_;
       my $status = ( $exitcode >> 8 );
       print "Child process exited with status $status\n";
       print " OS error was $dollarbang, exception was $dollarat\n";
    },
 );

=head1 DESCRIPTION

This module extends the functionality of the containing L<IO::Async::Loop> to
manage the execution of child processes. It acts as a central point to store
PID values of currently-running children, and to call the appropriate
continuation handler code when the process terminates. It provides useful
wrapper methods that set up filehandles and other child process details, and
to capture the child process's STDOUT and STDERR streams.

=cut

# Writing to variables of $> and $) have tricky ways to obtain error results
sub setuid
{
   my ( $uid ) = @_;

   $> = $uid; my $saved_errno = $!;
   $> == $uid and return 1;

   $! = $saved_errno;
   return undef;
}

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


A reference to the array of arguments to pass to the code.

=back

If the function body returns normally the list of results are provided as the
(successful) result of returned future. If the function throws an exception
this results in a failed future. In the special case that the exception is in
fact an unblessed C<ARRAY> reference, this array is unpacked and used as-is
for the C<fail> result. If the exception is not such a reference, it is used
as the first argument to C<fail>, in the category of C<error>.

   $f->done( @result )

   $f->fail( @{ $exception } )
   $f->fail( $exception, error => )

=head2 call (void)

   $function->call( %params )

When not returning a future, the C<on_result>, C<on_return> and C<on_error>
arguments give continuations to handle successful results or failure.

=over 8

=item on_result => CODE

A continuation that is invoked when the code has been executed. If the code
returned normally, it is called as:

 $on_result->( 'return', @values )

If the code threw an exception, or some other error occured such as a closed
connection or the process died, it is called as:

 $on_result->( 'error', $exception_name )

=item on_return => CODE and on_error => CODE

An alternative to C<on_result>. Two continuations to use in either of the
circumstances given above. They will be called directly, without the leading
'return' or 'error' value.

=back

=cut

sub call
{
   my $self = shift;
   my %params = @_;

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

      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 {

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

      $init->() if defined $init;

      while( my $args = $arg_channel->recv ) {
         my @ret;
         my $ok = eval { @ret = $code->( @$args ); 1 };

         if( $ok ) {
            $ret_channel->send( [ r => @ret ] );
         }
         elsif( ref $@ ) {
            # Presume that $@ is an ARRAYref of error results
            $ret_channel->send( [ e => @{ $@ } ] );
         }
         else {
            chomp( my $e = "$@" );
            $ret_channel->send( [ e => $e, error => ] );
         }
      }
   };

   my $worker = $class->SUPER::new(
      %params,
      channels_in  => [ $arg_channel ],
      channels_out => [ $ret_channel ],
   );

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

}

## Utility function
sub _get_sock_err
{
   my ( $sock ) = @_;

   my $err = $sock->getsockopt( SOL_SOCKET, SO_ERROR );

   if( defined $err ) {
      # 0 means no error, but is still defined
      return undef if !$err;

      $! = $err;
      return $!;
   }

   # It seems we can't call getsockopt to query SO_ERROR. We'll try getpeername
   if( defined getpeername( $sock ) ) {
      return undef;
   }

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

constructor or class.

=head2 on_socket $socket

Similar to C<on_stream>, but constructs an instance of L<IO::Async::Socket>.
This is most useful for C<SOCK_DGRAM> or C<SOCK_RAW> sockets.

This is now vaguely deprecated in favour of using C<on_accept> with a handle
constructor or class.

=head2 on_accept_error $socket, $errno

Optional. Invoked if the C<accept> syscall indicates an error (other than
C<EAGAIN> or C<EWOULDBLOCK>). If not provided, failures of C<accept> will
be passed to the main C<on_error> handler.

=cut

=head1 PARAMETERS

The following named parameters may be passed to C<new> or C<configure>:

=head2 on_accept => CODE

=head2 on_stream => CODE

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

      die "ARG! Missing on_accept,on_stream,on_socket!";
   }

   my $acceptor = $self->acceptor;
   my $f = $self->$acceptor( $socket, %acceptor_params )->on_done( sub {
      my ( $result ) = @_ or return; # false-alarm
      $on_done->( $self, $result );
   })->catch( accept => sub {
      my ( $message, $name, @args ) = @_;
      my ( $socket, $dollarbang ) = @args;
      $self->maybe_invoke_event( on_accept_error => $socket, $dollarbang ) or
         $self->invoke_error( "accept() failed - $dollarbang", accept => $socket, $dollarbang );
   });

   # TODO: Consider if this wants a more fine-grained place to report
   # non-accept() failures (such as SSL) to
   $self->adopt_future( $f );
}

sub _accept
{
   my $self = shift;

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


Finally, if no other choice has been made by now, the built-in C<Poll> module
is chosen. This should always work, but in case it doesn't, the C<Select>
module will be chosen afterwards as a last-case attempt. If this also fails,
then the magic constructor itself will throw an exception.

=back

If any of the explicitly-requested loop types (C<$ENV{IO_ASYNC_LOOP}> or
C<$IO::Async::Loop::LOOP>) fails to load then a warning is printed detailing
the error.

Implementors of new C<IO::Async::Loop> subclasses should see the notes about
C<API_VERSION> below.

=cut

sub __try_new
{
   my ( $class ) = @_;

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

=item on_finish => CODE

A continuation to be called when the child process exits and has closed all of
the filehandles that were set up for it. It will be invoked in the following
way:

 $on_finish->( $pid, $exitcode )

The second argument is passed the plain perl C<$?> value.

=item on_error => CODE

Optional continuation to be called when the child code block throws an
exception, or the command could not be C<exec(2)>ed. It will be invoked in the
following way (as per C<spawn>)

 $on_error->( $pid, $exitcode, $dollarbang, $dollarat )

If this continuation is not supplied, then C<on_finish> is used instead. The
value of C<$!> and C<$@> will not be reported.

=item setup => ARRAY

Optional reference to an array to pass to the underlying C<spawn> method.

=back

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

   my $self = shift;
   my %params = @_;

   my $on_finish = delete $params{on_finish};
   ref $on_finish or croak "Expected 'on_finish' to be a reference";
   $params{on_finish} = sub {
      my ( $process, $exitcode ) = @_;
      $on_finish->( $process->pid, $exitcode );
   };

   if( my $on_error = delete $params{on_error} ) {
      ref $on_error or croak "Expected 'on_error' to be a reference";

      $params{on_exception} = sub {
         my ( $process, $exception, $errno, $exitcode ) = @_;
         # Swap order
         $on_error->( $process->pid, $exitcode, $errno, $exception );
      };
   }

   $params{on_exit} and croak "Cannot pass 'on_exit' parameter through ChildManager->open";

   require IO::Async::Process;
   my $process = IO::Async::Process->new( %params );

   $self->add( $process );

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

There are two modes of operation. Firstly, a list of addresses can be provided
which will be tried in turn. Alternatively as a convenience, if a host and
service name are provided instead of a list of addresses, these will be
resolved using the underlying loop's C<resolve> method into the list of
addresses.

When attempting to connect to any among a list of addresses, there may be
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

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

=item handle => IO::Async::Handle

Optional. If given a L<IO::Async::Handle> object or a subclass (such as
L<IO::Async::Stream> or L<IO::Async::Socket> its handle will be set to the
newly-connected socket on success, and that handle used as the result of the
future instead.

=item on_fail => CODE

Optional. After an individual C<socket(2)> or C<connect(2)> syscall has failed,
this callback is invoked to inform of the error. It is passed the name of the
syscall that failed, the arguments that were passed to it, and the error it
generated. I.e.

 $on_fail->( "socket", $family, $socktype, $protocol, $! );

 $on_fail->( "bind", $sock, $address, $! );

 $on_fail->( "connect", $sock, $address, $! );

Because of the "try all" nature when given a list of multiple addresses, this
callback may be invoked multiple times, even before an eventual success.

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


 $on_stream->( $stream )

=item on_socket => CODE

Similar to C<on_stream>, but constructs an instance of L<IO::Async::Socket>.
This is most useful for C<SOCK_DGRAM> or C<SOCK_RAW> sockets.

 $on_socket->( $socket )

=item on_connect_error => CODE

A continuation that is invoked after all of the addresses have been tried, and
none of them succeeded. It will be passed the most significant error that
occurred, and the name of the operation it occurred in. Errors from the
C<connect(2)> syscall are considered most significant, then C<bind(2)>, then
finally C<socket(2)>.

 $on_connect_error->( $syscall, $! )

=item on_resolve_error => CODE

A continuation that is invoked when the name resolution attempt fails. This is
invoked in the same way as the C<on_error> continuation for the C<resolve>
method.

=back

=cut

sub connect
{
   my $self = shift;
   my ( %params ) = @_;

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

      defined $handle and croak "Cannot pass 'on_socket' with a handle object as well";

      require IO::Async::Socket;
      $handle = IO::Async::Socket->new;
      $on_done = $on_socket;
   }
   elsif( !defined wantarray ) {
      croak "Expected 'on_connected' or 'on_stream' callback or to return a Future";
   }

   my $on_connect_error;
   if( $on_connect_error = $params{on_connect_error} ) {
      # OK
   }
   elsif( !defined wantarray ) {
      croak "Expected 'on_connect_error' callback";
   }

   my $on_resolve_error;
   if( $on_resolve_error = $params{on_resolve_error} ) {
      # OK
   }
   elsif( !defined wantarray and exists $params{host} || exists $params{local_host} ) {
      croak "Expected 'on_resolve_error' callback or to return a Future";
   }

   my $connector = $self->{connector} ||= $self->__new_feature( "IO::Async::Internals::Connector" );

   my $future = $connector->connect( %params );

   $future = $future->then( sub {
      $handle->set_handle( shift );
      return Future->done( $handle )
   }) if $handle;

   $future->on_done( $on_done ) if $on_done;
   $future->on_fail( sub {
      $on_connect_error->( @_[2,3] ) if $on_connect_error and $_[1] eq "connect";
      $on_resolve_error->( $_[2] )   if $on_resolve_error and $_[1] eq "resolve";
   } );

   return $future if defined wantarray;

   # Caller is not going to keep hold of the Future, so we have to ensure it
   # stays alive somehow
   $future->on_ready( sub { undef $future } ); # intentional cycle
}

=head2 listen

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

=back

In either case, the following keys are also taken:

=over 8

=item on_fail => CODE

Optional. A callback that is invoked if a syscall fails while attempting to
create a listening sockets. It is passed the name of the syscall that failed,
the arguments that were passed to it, and the error generated. I.e.

 $on_fail->( "socket", $family, $socktype, $protocol, $! );

 $on_fail->( "sockopt", $sock, $optname, $optval, $! );

 $on_fail->( "bind", $sock, $address, $! );

 $on_fail->( "listen", $sock, $queuesize, $! );

=item queuesize => INT

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

Listener object directly.

=item on_listen => CODE

Optional. A callback that is invoked when the listening socket is ready.
Typically this would be used in the name resolver case, in order to inspect
the socket's sockname address, or otherwise inspect the filehandle.

 $on_listen->( $socket )

=item on_listen_error => CODE

A continuation this is invoked after all of the addresses have been tried, and
none of them succeeded. It will be passed the most significant error that
occurred, and the name of the operation it occurred in. Errors from the
C<listen(2)> syscall are considered most significant, then C<bind(2)>, then
C<sockopt(2)>, then finally C<socket(2)>.

=item on_resolve_error => CODE

A continuation that is invoked when the name resolution attempt fails. This is
invoked in the same way as the C<on_error> continuation for the C<resolve>
method.

=back

=cut

sub listen
{
   my $self = shift;
   my ( %params ) = @_;

   my $remove_on_error;
   my $listener = $params{listener} ||= do {
      $remove_on_error++;

      require IO::Async::Listener;

      # Our wrappings of these don't want $listener
      my %listenerparams;
      for (qw( on_accept on_stream on_socket )) {
         next unless exists $params{$_};
         croak "Cannot ->listen with '$_' and 'listener'" if $params{listener};

         my $code = delete $params{$_};

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


      my $method = "${ext}_listen";
      # TODO: Try to 'require IO::Async::$ext'

      $self->can( $method ) or croak "Extension method '$method' is not available";

      my $f = $self->$method(
         %params,
         ( @others ? ( extensions => \@others ) : () ),
      );
      $f->on_fail( sub { $self->remove( $listener ) } ) if $remove_on_error;

      return $f;
   }

   my $on_notifier = delete $params{on_notifier}; # optional

   my $on_listen_error  = delete $params{on_listen_error};
   my $on_resolve_error = delete $params{on_resolve_error};

   # Shortcut
   if( $params{addr} and not $params{addrs} ) {
      $params{addrs} = [ delete $params{addr} ];
   }

   my $f;
   if( my $handle = delete $params{handle} ) {
      $f = $self->_listen_handle( $listener, $handle, %params );
   }
   elsif( my $addrs = delete $params{addrs} ) {
      $on_listen_error or defined wantarray or
         croak "Expected 'on_listen_error' or to return a Future";
      $f = $self->_listen_addrs( $listener, $addrs, %params );
   }
   elsif( defined $params{service} ) {
      $on_listen_error or defined wantarray or
         croak "Expected 'on_listen_error' or to return a Future";
      $on_resolve_error or defined wantarray or
         croak "Expected 'on_resolve_error' or to return a Future";
      $f = $self->_listen_hostservice( $listener, delete $params{host}, delete $params{service}, %params );
   }
   else {
      croak "Expected either 'service' or 'addrs' or 'addr' arguments";
   }

   $f->on_done( $on_notifier ) if $on_notifier;
   if( my $on_listen = $params{on_listen} ) {
      $f->on_done( sub { $on_listen->( shift->read_handle ) } );
   }
   $f->on_fail( sub {
      my ( $message, $how, @rest ) = @_;
      $on_listen_error->( @rest )  if $on_listen_error  and $how eq "listen";
      $on_resolve_error->( @rest ) if $on_resolve_error and $how eq "resolve";
   });
   $f->on_fail( sub { $self->remove( $listener ) } ) if $remove_on_error;

   return $f if defined wantarray;

   # Caller is not going to keep hold of the Future, so we have to ensure it
   # stays alive somehow
   $f->on_ready( sub { undef $f } ); # intentional cycle
}

sub _listen_handle
{

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

      }

      return $self->_listen_handle( $listener, $sock, %params );
   }

   my $f = $self->new_future;
   return $f->fail( "Cannot listen() - $listenerr",      listen => listen  => $listenerr  ) if $listenerr;
   return $f->fail( "Cannot bind() - $binderr",          listen => bind    => $binderr    ) if $binderr;
   return $f->fail( "Cannot setsockopt() - $sockopterr", listen => sockopt => $sockopterr ) if $sockopterr;
   return $f->fail( "Cannot socket() - $socketerr",      listen => socket  => $socketerr  ) if $socketerr;
   die 'Oops; $loop->listen failed but no error cause was found';
}

sub _listen_hostservice
{
   my $self = shift;
   my ( $listener, $host, $service, %params ) = @_;

   $host ||= "";
   defined $service or $service = ""; # might be 0

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

=item on_read_ready => BOOL

If true, remove the watch for read-readiness.

=item on_write_ready => BOOL

If true, remove the watch for write-readiness.

=back

Either or both callbacks may be removed at once. It is not an error to attempt
to remove a callback that is not present. If both callbacks were provided to
the C<watch_io> method and only one is removed by this method, the other shall
remain.

=cut

sub __unwatch_io
{
   my $self = shift;
   my %params = @_;

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

}

=head2 loop_once

   $count = $loop->loop_once( $timeout )

This method calls the C<poll> method on the stored C<IO::Poll> object,
passing in the value of C<$timeout>, and then runs the C<post_poll> method
on itself. It returns the total number of callbacks invoked by the 
C<post_poll> method, or C<undef> if the underlying C<poll> method returned
an error.

=cut

sub loop_once
{
   my $self = shift;
   my ( $timeout ) = @_;

   $self->_adjust_timeout( \$timeout );

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

}

=head2 loop_once

   $count = $loop->loop_once( $timeout )

This method calls the C<pre_select> method to prepare the bitvectors for a
C<select> syscall, performs it, then calls C<post_select> to process the
result. It returns the total number of callbacks invoked by the
C<post_select> method, or C<undef> if the underlying C<select(2)> syscall
returned an error.

=cut

sub loop_once
{
   my $self = shift;
   my ( $timeout ) = @_;

   my ( $rvec, $wvec, $evec ) = ('') x 3;

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

   my $self = shift;
   my %params = @_;

   $self->__watch_io( %params );

   my $fileno = $params{handle}->fileno;

   vec( $self->{rvec}, $fileno, 1 ) = 1 if $params{on_read_ready};
   vec( $self->{wvec}, $fileno, 1 ) = 1 if $params{on_write_ready};

   # MSWin32 does not indicate writeready for connect() errors, HUPs, etc
   # but it does indicate exceptional
   vec( $self->{evec}, $fileno, 1 ) = 1 if SELECT_CONNECT_EVEC and $params{on_write_ready};

   vec( $self->{avec}, $fileno, 1 ) = 1 if FAKE_ISREG_READY and stat( $params{handle} ) and -f _;
}

sub unwatch_io
{
   my $self = shift;
   my %params = @_;

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

            $callcount++;
            $loop->unwatch_io( handle => $_, on_write_ready => 1 ) for @handles;
         },
      ) for @handles;

      $loop->loop_once( 0.1 );

      is( $callcount, 1, 'write_ready on crosslinked handles can cancel each other' );
   }

   # Check that error conditions that aren't true read/write-ability are still
   # invoked
   {
      my ( $S1, $S2 ) = IO::Async::OS->socketpair( 'inet', 'dgram' ) or die "Cannot create AF_INET/SOCK_DGRAM connected pair - $!";
      $_->blocking( 0 ) for $S1, $S2;
      $S2->close;

      my $readready = 0;
      $loop->watch_io(
         handle => $S1,
         on_read_ready => sub { $readready = 1 },

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

may wish to use the C<configure> and C<make_event_cb> or C<invoke_event>
methods to implement its own event callbacks.

=cut

=head1 EVENTS

The following events are invoked, either using subclass methods or CODE
references in parameters:

=head2 on_error $message, $name, @details

Invoked by C<invoke_error>.

=cut

=head1 PARAMETERS

A specific subclass of C<IO::Async::Notifier> defines named parameters that
control its behaviour. These may be passed to the C<new> constructor, or to
the C<configure> method. The documentation on each specific subclass will give
details on the parameters that exist, and their uses. Some parameters may only
support being set once at construction time, or only support being changed if
the object is in a particular state.

The following parameters are supported by all Notifiers:

=over 8

=item on_error => CODE

CODE reference for event handler.

=item notifier_name => STRING

Optional string used to identify this particular Notifier. This value will be
returned by the C<notifier_name> method.

=back

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

hash.

=cut

# for subclasses to override and call down to
sub configure
{
   my $self = shift;
   my %params = @_;

   foreach (qw( notifier_name on_error )) {
      $self->{"IO_Async_Notifier__$_"} = delete $params{$_} if exists $params{$_};
   }

   $self->configure_unknown( %params ) if keys %params;
}

sub configure_unknown
{
   my $self = shift;
   my %params = @_;

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

   return $self->{IO_Async_Notifier__notifier_name} || "";
}

=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

   my $fkey = "$f"; # stable stringification

   $self->{IO_Async_Notifier__futures}{$fkey} = $f;

   $f->on_ready( $self->_capture_weakself( sub {
      my $self = shift;
      my ( $f ) = @_;

      delete $self->{IO_Async_Notifier__futures}{$fkey};

      $self->invoke_error( $f->failure ) if $f->is_failed;
   }));

   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

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

      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.
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
failure, and the C<@details> list should contain additional arguments that
relate to that kind of failure.

=cut

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/Process.pm  view on Meta::CPAN

all its file descriptors.

=head2 on_exception $exception, $errno, $exitcode

Invoked when the process exits by an exception from C<code>, or by failing to
C<exec(2)> the given command. C<$errno> will be a dualvar, containing both
number and string values. After a successful C<exec()> call, this condition
can no longer happen.

Note that this has a different name and a different argument order from
C<< Loop->open_child >>'s C<on_error>.

If this is not provided and the process exits with an exception, then
C<on_finish> is invoked instead, being passed just the exit code.

Since this is just the results of the underlying C<< $loop->spawn_child >>
C<on_exit> handler in a different order it is possible that the C<$exception>
field will be an empty string. It will however always be defined. This can be
used to distinguish the two cases:

 on_exception => sub {

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


   $stream = $process->stdin

   $stream = $process->stdout

   $stream = $process->stderr

   $stream = $process->stdio

Shortcuts for calling C<fd> with 0, 1, 2 or C<io> respectively, to obtain the
L<IO::Async::Stream> representing the standard input, output, error, or
combined input/output streams of the child process.

=cut

sub stdin  { shift->fd( 0 ) }
sub stdout { shift->fd( 1 ) }
sub stderr { shift->fd( 2 ) }
sub stdio  { shift->fd( 'io' ) }

=head1 EXAMPLES

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

 }

 sub send_hello
 {
    my $self = shift;
    my ( $name ) = @_;

    $self->write_line( "HELLO $name" );
 }

This small example elides such details as error handling, which a real
protocol implementation would be likely to contain.

=head1 DESCRIPTION

=cut

=head1 EVENTS

The following events are invoked, either using subclass methods or CODE
references in parameters:

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

 }

 sub send_hello
 {
    my $self = shift;
    my ( $name ) = @_;

    $self->write( "HELLO $name\n" );
 }

This small example elides such details as error handling, which a real
protocol implementation would be likely to contain.

=head1 DESCRIPTION

This subclass of L<IO::Async::Protocol> is intended to stand as a base class
for implementing stream-based protocols. It provides an interface similar to
L<IO::Async::Stream>, primarily, a C<write> method and an C<on_read> event
handler.

It contains an instance of an L<IO::Async::Stream> object which it uses for

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


=item timeout => NUMBER

Optional. Timeout in seconds, after which the resolver operation will abort
with a timeout exception. If not supplied, a default of 10 seconds will apply.

=back

On failure, the fail category name is C<resolve>; the details give the
individual resolver function name (e.g. C<getaddrinfo>), followed by other
error details specific to the resolver in question.

 ->fail( $message, resolve => $type => @details )

=head2 resolve (void)

   $resolver->resolve( %params )

When not returning a future, additional parameters can be given containing the
continuations to invoke on success or failure:

=over 8

=item on_resolved => CODE

A continuation that is invoked when the resolver function returns a successful
result. It will be passed the array returned by the resolver function.

 $on_resolved->( @result )

=item on_error => CODE

A continuation that is invoked when the resolver function fails. It will be
passed the exception thrown by the function.

=back

=cut

sub resolve
{

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

   exists $METHODS{$type} or croak "Expected 'type' to be an existing resolver method, got '$type'";

   my $on_resolved;
   if( $on_resolved = $args{on_resolved} ) {
      ref $on_resolved or croak "Expected 'on_resolved' to be a reference";
   }
   elsif( !defined wantarray ) {
      croak "Expected 'on_resolved' or to return a Future";
   }

   my $on_error;
   if( $on_error = $args{on_error} ) {
      ref $on_error or croak "Expected 'on_error' to be a reference";
   }
   elsif( !defined wantarray ) {
      croak "Expected 'on_error' or to return a Future";
   }

   my $timeout = $args{timeout} || 10;

   my $future = $self->call(
      args => [ $type, $timeout, @{$args{data}} ],
   )->else( sub {
      my ( $message, @detail ) = @_;
      Future->fail( $message, resolve => $type => @detail );
   });

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

   return $future if defined wantarray;

   # Caller is not going to keep hold of the Future, so we have to ensure it
   # stays alive somehow
   $self->adopt_future( $future->else( sub { Future->done } ) );
}

=head2 getaddrinfo

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


Time in seconds after which to abort the lookup with a C<Timed out> exception

=back

On success, the future will yield the result as a list of HASH references;
each containing one result. Each result will contain fields called C<family>,
C<socktype>, C<protocol> and C<addr>. If requested by C<AI_CANONNAME> then the
C<canonname> field will also be present.

On failure, the detail field will give the error number, which should match
one of the C<Socket::EAI_*> constants.

 ->fail( $message, resolve => getaddrinfo => $eai_errno )

As a specific optimisation, this method will try to perform a lookup of
numeric values synchronously, rather than asynchronously, if it looks likely
to succeed.

Specifically, if the service name is entirely numeric, and the hostname looks
like an IPv4 or IPv6 string, a synchronous lookup will first be performed
using the C<AI_NUMERICHOST> flag. If this gives an C<EAI_NONAME> error, then
the lookup is performed asynchronously instead.

=head2 getaddrinfo (void)

   $resolver->getaddrinfo( %args )

When not returning a future, additional parameters can be given containing the
continuations to invoke on success or failure:

=over 8

=item on_resolved => CODE

Callback which is invoked after a successful lookup.

 $on_resolved->( @addrs )

=item on_error => CODE

Callback which is invoked after a failed lookup, including for a timeout.

 $on_error->( $exception )

=back

=cut

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

   $args{on_resolved} or defined wantarray or
      croak "Expected 'on_resolved' or to return a Future";

   $args{on_error} or defined wantarray or
      croak "Expected 'on_error' or to return a Future";

   my $host    = $args{host}    || "";
   my $service = $args{service}; defined $service or $service = "";
   my $flags   = $args{flags}   || 0;

   $flags |= AI_PASSIVE if $args{passive};

   $args{family}   = IO::Async::OS->getfamilybyname( $args{family} )     if defined $args{family};
   $args{socktype} = IO::Async::OS->getsocktypebyname( $args{socktype} ) if defined $args{socktype};

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

       if( !$err ) {
          my $future = $self->loop->new_future->done( @results );
          $future->on_done( $args{on_resolved} ) if $args{on_resolved};
          return $future;
       }
       elsif( $err == EAI_NONAME ) {
          # fallthrough to async case
       }
       else {
          my $future = $self->loop->new_future->fail( $err, resolve => getaddrinfo => $err+0 );
          $future->on_fail( $args{on_error} ) if $args{on_error};
          return $future;
       }
   }

   my $future = $self->resolve(
      type    => "getaddrinfo",
      data    => [
         host    => $host,
         service => $service,
         flags   => $flags,
         map { exists $args{$_} ? ( $_ => $args{$_} ) : () } qw( family socktype protocol ),
      ],
      timeout => $args{timeout},
   );

   $future->on_done( $args{on_resolved} ) if $args{on_resolved};
   $future->on_fail( $args{on_error}    ) if $args{on_error};

   return $future if defined wantarray;

   # Caller is not going to keep hold of the Future, so we have to ensure it
   # stays alive somehow
   $self->adopt_future( $future->else( sub { Future->done } ) );
}

=head2 getnameinfo

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

=item numeric => BOOL

If true, sets both C<NI_NUMERICHOST> and C<NI_NUMERICSERV> flags.

=item timeout => NUMBER

Time in seconds after which to abort the lookup with a C<Timed out> exception

=back

On failure, the detail field will give the error number, which should match
one of the C<Socket::EAI_*> constants.

 ->fail( $message, resolve => getnameinfo => $eai_errno )

As a specific optimisation, this method will try to perform a lookup of
numeric values synchronously, rather than asynchronously, if both the
C<NI_NUMERICHOST> and C<NI_NUMERICSERV> flags are given.

=head2 getnameinfo (void)

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

continuations to invoke on success or failure:

=over 8

=item on_resolved => CODE

Callback which is invoked after a successful lookup.

 $on_resolved->( $host, $service )

=item on_error => CODE

Callback which is invoked after a failed lookup, including for a timeout.

 $on_error->( $exception )

=back

=cut

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

   $args{on_resolved} or defined wantarray or
      croak "Expected 'on_resolved' or to return a Future";

   $args{on_error} or defined wantarray or
      croak "Expected 'on_error' or to return a Future";

   my $flags = $args{flags} || 0;

   $flags |= NI_NUMERICHOST if $args{numerichost};
   $flags |= NI_NUMERICSERV if $args{numericserv};
   $flags |= NI_DGRAM       if $args{dgram};

   $flags |= NI_NUMERICHOST|NI_NUMERICSERV if $args{numeric};

   if( $flags & (NI_NUMERICHOST|NI_NUMERICSERV) ) {
      # This is a numeric-only lookup that can be done synchronously
      my ( $err, $host, $service ) = Socket::getnameinfo( $args{addr}, $flags );

      if( $err ) {
         my $future = $self->loop->new_future->fail( $err, resolve => getnameinfo => $err+0 );
         $future->on_fail( $args{on_error} ) if $args{on_error};
         return $future;
      }
      else {
         my $future = $self->loop->new_future->done( $host, $service );
         $future->on_done( $args{on_resolved} ) if $args{on_resolved};
         return $future;
      }
   }

   my $future = $self->resolve(
      type    => "getnameinfo",
      data    => [ $args{addr}, $flags ],
      timeout => $args{timeout},
   )->transform(
      done => sub { @{ $_[0] } }, # unpack the ARRAY ref
   );

   $future->on_done( $args{on_resolved} ) if $args{on_resolved};
   $future->on_fail( $args{on_error}    ) if $args{on_error};

   return $future if defined wantarray;

   # Caller is not going to keep hold of the Future, so we have to ensure it
   # stays alive somehow
   $self->adopt_future( $future->else( sub { Future->done } ) );
}

=head1 FUNCTIONS

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


The name of the resolver function; must be a plain string. This name will be
used by the C<type> argument to the C<resolve> method, to identify it.

=item $code

A CODE reference to the resolver function body. It will be called in list
context, being passed the list of arguments given in the C<data> argument to
the C<resolve> method. The returned list will be passed to the
C<on_resolved> callback. If the code throws an exception at call time, it will
be passed to the C<on_error> continuation. If it returns normally, the list of
values it returns will be passed to C<on_resolved>.

=back

=cut

# Plain function, not a method
sub register_resolver
{
   my ( $name, $code ) = @_;

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

 use IO::Async::Loop;
 my $loop = IO::Async::Loop->new;

 my $socket = IO::Async::Socket->new(
    on_recv => sub {
       my ( $self, $dgram, $addr ) = @_;

       print "Received reply: $dgram\n",
       $loop->stop;
    },
    on_recv_error => sub {
       my ( $self, $errno ) = @_;
       die "Cannot recv - $errno\n";
    },
 );
 $loop->add( $socket );

 $socket->connect(
    host     => "some.host.here",
    service  => "echo",
    socktype => 'dgram',

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

references in parameters:

=head2 on_recv $data, $addr

Invoke on receipt of a packet, datagram, or stream segment.

The C<on_recv> handler is invoked once for each packet, datagram, or stream
segment that is received. It is passed the data itself, and the sender's
address.

=head2 on_recv_error $errno

Optional. Invoked when the C<recv> method on the receiving handle fails.

=head2 on_send_error $errno

Optional. Invoked when the C<send> method on the sending handle fails.

The C<on_recv_error> and C<on_send_error> handlers are passed the value of
C<$!> at the time the error occured. (The C<$!> variable itself, by its
nature, may have changed from the original error by the time this handler
runs so it should always use the value passed in).

If an error occurs when the corresponding error callback is not supplied, and
there is not a subclass method for it, then the C<close> method is
called instead.

=head2 on_outgoing_empty

Optional. Invoked when the sending data buffer becomes empty.

=cut

sub _init

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

=head2 write_handle => IO

The IO handle to send to. Must implement C<fileno> and C<send> methods.

=head2 handle => IO

Shortcut to specifying the same IO handle for both of the above.

=head2 on_recv => CODE

=head2 on_recv_error => CODE

=head2 on_outgoing_empty => CODE

=head2 on_send_error => CODE

=head2 autoflush => BOOL

Optional. If true, the C<send> method will atempt to send data to the
operating system immediately, without waiting for the loop to indicate the
filehandle is write-ready.

=head2 recv_len => INT

Optional. Sets the buffer size for C<recv> calls. Defaults to 64 KiB.

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

containing Loop, either directly or by being a child of another Notifier
already in a Loop, or added to one.

=cut

sub configure
{
   my $self = shift;
   my %params = @_;

   for (qw( on_recv on_outgoing_empty on_recv_error on_send_error
            recv_len recv_all send_all autoflush )) {
      $self->{$_} = delete $params{$_} if exists $params{$_};
   }

   $self->SUPER::configure( %params );

   if( $self->loop and defined $self->read_handle ) {
      $self->can_event( "on_recv" ) or
         croak 'Expected either an on_recv callback or to be able to ->on_recv';
   }

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

   croak "Cannot send data to a Socket with no write_handle" unless my $handle = $self->write_handle;

   my $sendqueue = $self->{sendqueue} ||= [];
   push @$sendqueue, [ $data, $flags, $addr ];

   if( $self->{autoflush} ) {
      while( @$sendqueue ) {
         my ( $data, $flags, $addr ) = @{ $sendqueue->[0] };
         my $len = $handle->send( $data, $flags, $addr );

         last if !$len; # stop on any errors and defer back to the non-autoflush path

         shift @$sendqueue;
      }

      if( !@$sendqueue ) {
         $self->want_writeready( 0 );
         return;
      }
   }

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

   my $handle = $self->read_handle;

   while(1) {
      my $addr = $handle->recv( my $data, $self->{recv_len} );

      if( !defined $addr ) {
         return if $! == EAGAIN || $! == EWOULDBLOCK || $! == EINTR;

         my $errno = $!;

         $self->maybe_invoke_event( on_recv_error => $errno )
            or $self->close;

         return;
      }

      if( !length $data ) {
         $self->close;
         return;
      }

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


   while( $sendqueue and @$sendqueue ) {
      my ( $data, $flags, $addr ) = @{ shift @$sendqueue };
      my $len = $handle->send( $data, $flags, $addr );

      if( !defined $len ) {
         return if $! == EAGAIN || $! == EWOULDBLOCK || $! == EINTR;

         my $errno = $!;

         $self->maybe_invoke_event( on_send_error => $errno )
            or $self->close;

         return;
      }

      if( $len == 0 ) {
         $self->close;
         return;
      }

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

use IO::Async::Debug;

# Tuneable from outside
# Not yet documented
our $READLEN  = 8192;
our $WRITELEN = 8192;

use Struct::Dumb;

# Element of the writequeue
struct Writer => [qw( data writelen on_write on_flush on_error watching )];

# Element of the readqueue
struct Reader => [qw( on_read future )];

# Bitfields in the want flags
use constant WANT_READ_FOR_READ   => 0x01;
use constant WANT_READ_FOR_WRITE  => 0x02;
use constant WANT_WRITE_FOR_READ  => 0x04;
use constant WANT_WRITE_FOR_WRITE => 0x08;
use constant WANT_ANY_READ  => WANT_READ_FOR_READ |WANT_READ_FOR_WRITE;

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

=head2 on_read_eof

Optional. Invoked when the read handle indicates an end-of-file (EOF)
condition. If there is any data in the buffer still to be processed, the
C<on_read> event will be invoked first, before this one.

=head2 on_write_eof

Optional. Invoked when the write handle indicates an end-of-file (EOF)
condition. Note that this condition can only be detected after a C<write>
syscall returns the C<EPIPE> error. If there is no data pending to be written
then it will not be detected yet.

=head2 on_read_error $errno

Optional. Invoked when the C<sysread> method on the read handle fails.

=head2 on_write_error $errno

Optional. Invoked when the C<syswrite> method on the write handle fails.

The C<on_read_error> and C<on_write_error> handlers are passed the value of
C<$!> at the time the error occured. (The C<$!> variable itself, by its
nature, may have changed from the original error by the time this handler
runs so it should always use the value passed in).

If an error occurs when the corresponding error callback is not supplied, and
there is not a handler for it, then the C<close> method is called instead.

=head2 on_read_high_watermark $length

=head2 on_read_low_watermark $length

Optional. Invoked when the read buffer grows larger than the high watermark
or smaller than the low watermark respectively. These are edge-triggered
events; they will only be triggered once per crossing, not continuously while
the buffer remains above or below the given limit.

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

=head2 write_handle => IO

The IO handle to write to. Must implement C<fileno> and C<syswrite> methods.

=head2 handle => IO

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

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


Optional. If defined, gives the name of a method or a CODE reference to use
to implement the actual reading from or writing to the filehandle. These will
be invoked as

 $stream->reader( $read_handle, $buffer, $len )
 $stream->writer( $write_handle, $buffer, $len )

Each is expected to modify the passed buffer; C<reader> by appending to it,
C<writer> by removing a prefix from it. Each is expected to return a true
value on success, zero on EOF, or C<undef> with C<$!> set for errors. If not
provided, they will be substituted by implenentations using C<sysread> and
C<syswrite> on the underlying handle, respectively.

=head2 close_on_read_eof => BOOL

Optional. Usually true, but if set to a false value then the stream will not
be C<close>d when an EOF condition occurs on read. This is normally not useful
as at that point the underlying stream filehandle is no longer useable, but it
may be useful for reading regular files, or interacting with TTY devices.

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

before the stream is added to its containing Loop, either directly or by being
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

sub want_writeready_for_read
{
   my $self = shift;
   my ( $set ) = @_;
   $set ? ( $self->{want} |= WANT_WRITE_FOR_READ ) : ( $self->{want} &= ~WANT_WRITE_FOR_READ );

   $self->want_writeready( $self->{want} & WANT_ANY_WRITE ) if $self->write_handle;
}

# FUNCTION not method
sub _nonfatal_error
{
   my ( $errno ) = @_;

   return $errno == EAGAIN ||
          $errno == EWOULDBLOCK ||
          $errno == EINTR;
}

sub _is_empty
{

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

   $stream->close_when_empty

If the write buffer is empty, this method calls C<close> on the underlying IO
handles, and removes the stream from its containing loop. If the write buffer
still contains data, then this is deferred until the buffer is empty. This is
intended for "write-then-close" one-shot streams.

 $stream->write( "Here is my final data\n" );
 $stream->close_when_empty;

Because of this deferred nature, it may not be suitable for error handling.
See instead the C<close_now> method.

=cut

sub close_when_empty
{
   my $self = shift;

   return $self->SUPER::close if $self->_is_empty;

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

stream from the containing loop. It will not wait to flush the remaining data
in the write buffer.

=cut

sub close_now
{
   my $self = shift;

   foreach ( @{ $self->{writequeue} } ) {
       $_->on_error->( "stream closing" ) if $_->on_error;
   }

   undef @{ $self->{writequeue} };
   undef $self->{stream_closing};

   $self->SUPER::close;
}

=head2 is_read_eof

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

 $on_write->( $stream, $len )

=item on_flush => CODE

A CODE reference which will be invoked once the data queued by this C<write>
call has been flushed. This will be invoked even if the buffer itself is not
yet empty; if more data has been queued since the call.

 $on_flush->( $stream )

=item on_error => CODE

A CODE reference which will be invoked if a C<syswrite> error happens while
performing this write. Invoked as for the C<Stream>'s C<on_write_error> event.

 $on_error->( $stream, $errno )

=back

If the object is not yet a member of a loop and doesn't yet have a
C<write_handle>, then calls to the C<write> method will simply queue the data
and return. It will be flushed when the object is added to the loop.

If C<$data> is a defined but empty string, the write is still queued, and the
C<on_flush> continuation will be invoked, if supplied. This can be used to
obtain a marker, to invoke some code once the output queue has been flushed up

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

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

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

      if( $errno == EAGAIN or $errno == EWOULDBLOCK ) {
         $self->maybe_invoke_event( on_writeable_stop => ) if $self->{writeable};
         $self->{writeable} = 0;
      }

      return 0 if _nonfatal_error( $errno );

      if( $errno == EPIPE ) {
         $self->{write_eof} = 1;
         $self->maybe_invoke_event( on_write_eof => );
      }

      $head->on_error->( $self, $errno ) if $head->on_error;
      $self->maybe_invoke_event( on_write_error => $errno )
         or $self->close_now;

      return 0;
   }

   if( my $on_write = $head->on_write ) {
      $on_write->( $self, $len );
   }

   if( !length $head->data ) {

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

   my $handle = $self->write_handle;

   croak "Cannot write data to a Stream with no write_handle" if !$handle and $self->loop;

   if( !ref $data and my $encoding = $self->{encoding} ) {
      $data = $encoding->encode( $data );
   }

   my $on_write = delete $params{on_write};
   my $on_flush = delete $params{on_flush};
   my $on_error = delete $params{on_error};

   my $f;
   if( defined wantarray ) {
      my $orig_on_flush = $on_flush;
      my $orig_on_error = $on_error;

      my $loop = $self->loop or
         croak "Cannot ->write data returning a Future to a Stream not in a Loop";
      $f = $loop->new_future;
      $on_flush = sub {
         $f->done;
         $orig_on_flush->( @_ ) if $orig_on_flush;
      };
      $on_error = sub {
         my $self = shift;
         my ( $errno ) = @_;

         $f->fail( "write failed: $errno", syswrite => $errno ) unless $f->is_ready;

         $orig_on_error->( $self, @_ ) if $orig_on_error;
      };
   }

   my $write_len = $params{write_len};
   defined $write_len or $write_len = $self->{write_len};

   push @{ $self->{writequeue} }, Writer(
      $data, $write_len, $on_write, $on_flush, $on_error, 0
   );

   keys %params and croak "Unrecognised keys for ->write - " . join( ", ", keys %params );

   return $f unless $handle;

   if( $self->{autoflush} ) {
      1 while !$self->_is_empty and $self->_flush_one_write;

      if( $self->_is_empty ) {

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

   my $handle = $self->read_handle;
   my $reader = $self->{reader};

   while(1) {
      my $data;
      my $len = $self->$reader( $handle, $data, $self->{read_len} );

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

         return if _nonfatal_error( $errno );

         $self->maybe_invoke_event( on_read_error => $errno )
            or $self->close_now;

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

         return;
      }

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

Since it is possible to use a readable C<Stream> entirely using these
C<Future>-returning methods instead of the C<on_read> event, it may be useful
to configure a trivial return-false event handler to keep it from consuming
any input, and to allow it to be added to a C<Loop> in the first place.

 my $stream = IO::Async::Stream->new( on_read => sub { 0 }, ... );
 $loop->add( $stream );

 my $f = $stream->read_...

If a read EOF or error condition happens while there are read C<Future>s
pending, they are all completed. In the case of a read EOF, they are done with
C<undef>; in the case of a read error they are failed using the C<$!> error
value as the failure.

 $f->fail( $message, sysread => $! )

If a read EOF condition happens to the currently-processing read C<Future>, it
will return a partial result. The calling code can detect this by the fact
that the returned data is not complete according to the specification (too
short in C<read_exactly>'s case, or lacking the ending pattern in
C<read_until>'s case). Additionally, each C<Future> will yield the C<$eof>
value in its results.

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


=head2 wait_for

   wait_for { COND }

Repeatedly call the C<loop_once> method on the underlying loop (given to the
C<testing_loop> function), until the given condition function callback
returns true.

To guard against stalled scripts, if the loop indicates a timeout for 10
consequentive seconds, then an error is thrown.

=cut

sub wait_for(&)
{
   my ( $cond ) = @_;

   my ( undef, $callerfile, $callerline ) = caller;

   my $timedout = 0;

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

{
   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 );

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


   if( $self->{pending} ) {
      delete $self->{pending};
      return;
   }

   return if !$self->is_running;

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

   defined $self->{id} or return; # nothing to do but no error

   $loop->unwatch_time( $self->{id} );

   undef $self->{id};
}

=head1 AUTHOR

Paul Evans <leonerd@leonerd.org.uk>

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


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>)

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


The CPAN Meta Spec version 2 adds C<release_status> to allow authors
to specify how a distribution should be indexed.  Consistent with the
spec, this parameter can only have one three values: 'stable',
'testing' or 'unstable'.

Unless explicitly set by the author, C<release_status> will default
to 'stable' unless C<dist_version> contains an underscore, in which
case it will default to 'testing'.

It is an error to specify a C<release_status> of 'stable' when
C<dist_version> contains an underscore character.

=item requires

[version 0.07]

An optional C<requires> argument specifies any module prerequisites
that the current module depends on.

One note: currently C<Module::Build> doesn't actually I<require> the

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


  package 'My::Build';
  use base 'Module::Build';
  __PACKAGE__->add_property( 'pedantic' );
  __PACKAGE__->add_property( answer => 42 );
  __PACKAGE__->add_property(
     'epoch',
      default => sub { time },
      check   => sub {
          return 1 if /^\d+$/;
          shift->property_error( "'$_' is not an epoch time" );
          return 0;
      },
  );

Adds a property to a Module::Build class. Properties are those attributes of a
Module::Build object which can be passed to the constructor and which have
accessors to get and set them. All of the core properties, such as
C<module_name> and C<license>, are defined using this class method.

The first argument to C<add_property()> is always the name of the property.

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

If you need the default to be a code reference, just use a code reference to
return it, e.g.:

      default => sub { sub { ... } },

=item C<check>

A code reference that checks that a value specified for the property is valid.
During the execution of the code reference, the new value will be included in
the C<$_> variable. If the value is correct, the C<check> code reference
should return true. If the value is not correct, it sends an error message to
C<property_error()> and returns false.

=back

When this method is called, a new property will be installed in the
Module::Build class, and an accessor will be built to allow the property to be
get or set on the build object.

  print $build->pedantic, $/;
  $build->pedantic(0);

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

Of course, you can still set the entire hash reference at once, as well:

  $build->stuff( { foo => 'bar', baz => 'yo' } );

In either case, if a C<check> has been specified for the property, it will be
applied to the entire hash. So the check code reference should look something
like:

      check => sub {
            return 1 if defined $_ && exists $_->{foo};
            shift->property_error(qq{Property "stuff" needs "foo"});
            return 0;
      },

=item property_error

[version 0.31]

=back


=head2 METHODS

=over 4

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

is given as a string like C<"Data::Dumper"> or C<"perl">, and the
C<$version> argument can take any of the forms described in L</requires>
above.  This allows very fine-grained version checking.

The returned hash reference has the following structure:

  {
   ok => $whether_the_dependency_is_satisfied,
   have => $version_already_installed,
   need => $version_requested, # Same as incoming $version argument
   message => $informative_error_message,
  }

If no version of C<$module> is currently installed, the C<have> value
will be the string C<< "<none>" >>.  Otherwise the C<have> value will
simply be the version of the installed module.  Note that this means
that if C<$module> is installed but doesn't define a version number,
the C<have> value will be C<undef> - this is why we don't use C<undef>
for the case when C<$module> isn't installed at all.

This method may be called either as an object method

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

following:

  my $installed = $build->check_installed_version('DBI', '1.15');
  if ($installed) {
    print "Congratulations, version $installed of DBI is installed.\n";
  } else {
    die "Sorry, you must install DBI.\n";
  }

If the check fails, we return false and set C<$@> to an informative
error message.

If C<$version> is any non-true value (notably zero) and any version of
C<$module> is installed, we return true.  In this case, if C<$module>
doesn't define a version, or if its version is zero, we return the
special value "0 but true", which is numerically zero, but logically
true.

In general you might prefer to use C<check_installed_status> if you
need detailed information, or this method if you just need a yes/no
answer.

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

    return $data;
  }

Valid arguments include:

=over

=item *

C<fatal> -- indicates whether missing required
metadata fields should be a fatal error or not.  For META creation, it
generally should, but for MYMETA creation for end-users, it should not be
fatal.

=item *

C<auto> -- indicates whether any necessary configure_requires should be
automatically added.  This is used in META creation.

=back

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


[version 0.36]

[Deprecated] As of 0.36, authors should use C<get_metadata> instead.  This
method is preserved for backwards compatibility only.

It takes three positional arguments: a hashref (to which metadata will be
added), an optional arrayref (to which metadata keys will be added in order if
the arrayref exists), and a hashref of arguments (as provided to get_metadata).
The latter argument is new as of 0.36.  Earlier versions are always fatal on
errors.

Prior to version 0.36, this method took a YAML::Node as an argument to hold
assembled metadata.

=item prereq_failures()

[version 0.11]

Returns a data structure containing information about any failed
prerequisites (of any of the types described above), or C<undef> if

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


If C<prompt()> detects that it is not running interactively and there
is nothing on STDIN or if the PERL_MM_USE_DEFAULT environment variable
is set to true, the $default will be used without prompting.

To prevent automated processes from blocking, the user must either set
PERL_MM_USE_DEFAULT or attach something to STDIN (this can be a
pipe/file containing a scripted set of answers or /dev/null.)

If no $default is provided an empty string will be used instead.  In
non-interactive mode, the absence of $default is an error (though
explicitly passing C<undef()> as the default is valid as of 0.27.)

This method may be called as a class or object method.

=item recommends()

[version 0.21]

Returns a hash reference indicating the C<recommends> prerequisites
that were passed to the C<new()> method.

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

One advantage of Module::Build is that since it's implemented as Perl
methods, you can invoke these methods directly if you want to install
a module non-interactively.  For instance, the following Perl script
will invoke the entire build/install procedure:

  my $build = Module::Build->new(module_name => 'MyModule');
  $build->dispatch('build');
  $build->dispatch('test');
  $build->dispatch('install');

If any of these steps encounters an error, it will throw a fatal
exception.

You can also pass arguments as part of the build process:

  my $build = Module::Build->new(module_name => 'MyModule');
  $build->dispatch('build');
  $build->dispatch('test', verbose => 1);
  $build->dispatch('install', sitelib => '/my/secret/place/');

Building and installing modules in this way skips creating the

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

  }

  $self->cull_args(@ARGV);

  unless ($self->allow_mb_mismatch) {
    my $mb_version = $Module::Build::VERSION;
    if ( $mb_version ne $self->{properties}{mb_version} ) {
      $self->log_warn(<<"MISMATCH");
* WARNING: Configuration was initially created with Module::Build
  version '$self->{properties}{mb_version}' but we are now using version '$mb_version'.
  If errors occur, you must re-run the Build.PL or Makefile.PL script.
MISMATCH
    }
  }

  $self->{invoked_action} = $self->{action} ||= 'build';

  return $self;
}

sub new_from_context {

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

    return $known_perl = $self->_discover_perl_interpreter;
  }
}

# Returns the absolute path of the perl interpreter used to invoke
# this process. The path is derived from $^X or $Config{perlpath}. On
# some platforms $^X contains the complete absolute path of the
# interpreter, on other it may contain a relative path, or simply
# 'perl'. This can also vary depending on whether a path was supplied
# when perl was invoked. Additionally, the value in $^X may omit the
# executable extension on platforms that use one. It's a fatal error
# if the interpreter can't be found because it can result in undefined
# behavior by routines that depend on it (generating errors or
# invoking the wrong perl.)
sub _discover_perl_interpreter {
  my $proto = shift;
  my $c     = ref($proto) ? $proto->{config} : 'Module::Build::Config';

  my $perl  = $^X;
  my $perl_basename = File::Basename::basename($perl);

  my @potential_perls;

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

      my $sub = $type eq 'HASH'
        ? _make_hash_accessor($property, \%p)
        : _make_accessor($property, \%p);
      no strict 'refs';
      *{"$class\::$property"} = $sub;
    }

    return $class;
  }

  sub property_error {
    my $self = shift;
    die 'ERROR: ', @_;
  }

  sub _set_defaults {
    my $self = shift;

    # Set the build class.
    $self->{properties}{build_class} ||= ref $self;

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

__PACKAGE__->add_property(use_tap_harness => 0);
__PACKAGE__->add_property(cpan_client => 'cpan');
__PACKAGE__->add_property(tap_harness_args => {});
__PACKAGE__->add_property(pureperl_only => 0);
__PACKAGE__->add_property(allow_pureperl => 0);
__PACKAGE__->add_property(
  'installdirs',
  default => 'site',
  check   => sub {
    return 1 if /^(core|site|vendor)$/;
    return shift->property_error(
      $_ eq 'perl'
      ? 'Perhaps you meant installdirs to be "core" rather than "perl"?'
      : 'installdirs must be one of "core", "site", or "vendor"'
    );
    return shift->property_error("Perhaps you meant 'core'?") if $_ eq 'perl';
    return 0;
  },
);

{
  __PACKAGE__->add_property(html_css => '');
}

{
  my @prereq_action_types = qw(requires build_requires test_requires conflicts recommends);

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

    my $bundle_inc = $self->{properties}{bundle_inc};
    my $bundle_inc_preload = $self->{properties}{bundle_inc_preload};
    # We're in author mode if inc::latest is loaded, but not from cwd
    return unless inc::latest->can('loaded_modules');
    require ExtUtils::Installed;
    # ExtUtils::Installed is buggy about finding additions to default @INC
    my $inst = eval { ExtUtils::Installed->new(extra_libs => [@INC]) };
    if ($@) {
      $self->log_warn( << "EUI_ERROR" );
Bundling in inc/ is disabled because ExtUtils::Installed could not
create a list of your installed modules.  Here is the error:
$@
EUI_ERROR
      return;
    }
    my @bundle_list = map { [ $_, 0 ] } inc::latest->loaded_modules;

    # XXX TODO: Need to get ordering of prerequisites correct so they are
    # are loaded in the right order. Use an actual tree?!

    while( @bundle_list ) {
      my ($mod, $prereq) = @{ shift @bundle_list };

      # XXX TODO: Append prereqs to list
      # skip if core or already in bundle or preload lists
      # push @bundle_list, [$_, 1] for prereqs()

      # Locate packlist for bundling
      my $lookup = $self->_find_packlist($inst,$mod);
      if ( ! $lookup ) {
        # XXX Really needs a more helpful error message here
        die << "NO_PACKLIST";
Could not find a packlist for '$mod'.  If it's a core module, try
force installing it from CPAN.
NO_PACKLIST
      }
      else {
        push @{ $prereq ? $bundle_inc_preload : $bundle_inc }, $lookup;
      }
    }
  } # sub check_bundling

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

}

sub compare_versions {
  my $self = shift;
  my ($v1, $op, $v2) = @_;
  $v1 = version->new($v1)
    unless eval { $v1->isa('version') };

  my $eval_str = "\$v1 $op \$v2";
  my $result   = eval $eval_str;
  $self->log_warn("error comparing versions: '$eval_str' $@") if $@;

  return $result;
}

# I wish I could set $! to a string, but I can't, so I use $@
sub check_installed_version {
  my ($self, $modname, $spec) = @_;

  my $status = $self->check_installed_status($modname, $spec);

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

    require Getopt::Long;
    # XXX Should we let Getopt::Long handle M::B's options? That would
    # be easy-ish to add to @specs right here, but wouldn't handle options
    # passed without "--" as M::B currently allows. We might be able to
    # get around this by setting the "prefix_pattern" Configure option.
    my @specs;
    my $args = {};
    # Construct the specifications for GetOptions.
    foreach my $k (sort keys %$specs) {
        my $v = $specs->{$k};
        # Throw an error if specs conflict with our own.
        die "Option specification '$k' conflicts with a " . ref $self
          . " option of the same name"
          if $self->valid_property($k);
        push @specs, $k . (defined $v->{type} ? $v->{type} : '');
        push @specs, $v->{store} if exists $v->{store};
        $args->{$k} = $v->{default} if exists $v->{default};
    }

    local @ARGV = @argv; # No other way to dupe Getopt::Long

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

  my $self = shift;

  my $tests = $self->find_test_files;

  local $ENV{PERL_DL_NONLAZY} = 1;

  if(@$tests) {
    my $args = $self->tap_harness_args;
    if($self->use_tap_harness or ($args and %$args)) {
      my $aggregate = $self->run_tap_harness($tests);
      if ( $aggregate->has_errors ) {
        die "Errors in testing.  Cannot continue.\n";
      }
    }
    else {
      $self->run_test_harness($tests);
    }
  }
  else {
    $self->log_info("No tests defined.\n");
  }

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

    $htmltool = "ActiveState::DocTools::Pod";
    $htmltool .= " $tool_v" if $tool_v && length $tool_v;
  }
  else {
      require Module::Build::PodParser;
      require Pod::Html;
    $htmltool = "Pod::Html " .  Pod::Html->VERSION;
  }
  $self->log_verbose("Converting Pod to HTML with $htmltool\n");

  my $errors = 0;

  POD:
  foreach my $pod ( sort keys %$pods ) {

    my ($name, $path) = File::Basename::fileparse($pods->{$pod},
      $self->file_qr('\.(?:pm|plx?|pod)$')
    );
    my @dirs = File::Spec->splitdir( File::Spec->canonpath( $path ) );
    pop( @dirs ) if scalar(@dirs) && $dirs[-1] eq File::Spec->curdir;

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

      {
        my $orig = Cwd::getcwd();
        eval { Pod::Html::pod2html(@opts); 1 }
          or $self->log_warn("[$htmltool] pod2html( " .
          join(", ", map { "q{$_}" } @opts) . ") failed: $@");
        chdir($orig);
      }
    }
    # We now have to cleanup the resulting html file
    if ( ! -r $tmpfile ) {
      $errors++;
      next POD;
    }
    open(my $fh, '<', $tmpfile) or die "Can't read $tmpfile: $!";
    my $html = join('',<$fh>);
    close $fh;
    if (!$self->_is_ActivePerl) {
      # These fixups are already done by AP::DT:P:pod2html
      # The output from pod2html is NOT XHTML!
      # IE6+ will display content that is not valid for DOCTYPE
      $html =~ s#^<!DOCTYPE .*?>#<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">#im;

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

    }
    # Fixup links that point to our temp blib
    $html =~ s/\Q$blibdir\E//g;

    open($fh, '>', $outfile) or die "Can't write $outfile: $!";
    print $fh $html;
    close $fh;
    unlink($tmpfile);
  }

  return ! $errors;

}

# Adapted from ExtUtils::MM_Unix
sub man1page_name {
  my $self = shift;
  return File::Basename::basename( shift );
}

# Adapted from ExtUtils::MM_Unix and Pod::Man

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

  # Then we iterate over all the packages found above, identifying conflicts
  # and selecting the "best" candidate for recording the file & version
  # for each package.
  foreach my $package ( sort keys( %alt ) ) {
    my $result = $self->_resolve_module_versions( $alt{$package} );

    if ( exists( $prime{$package} ) ) { # primary package selected

      if ( $result->{err} ) {
        # Use the selected primary package, but there are conflicting
        # errors among multiple alternative packages that need to be
        # reported
        $self->log_warn(
          "Found conflicting versions for package '$package'\n" .
          "  $prime{$package}{file} ($prime{$package}{version})\n" .
          $result->{err}
        );

      } elsif ( defined( $result->{version} ) ) {
        # There is a primary package selected, and exactly one
        # alternative package

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

You don't want to use this style if during the C<perl Build.PL> stage
you ask the user questions, or do some auto-sensing about the user's
environment, or if you subclass C<Module::Build> to do some
customization, because the vanilla F<Makefile.PL> won't do any of that.

=item small

A small F<Makefile.PL> will be created that passes all functionality
through to the F<Build.PL> script in the same directory.  The user must
already have C<Module::Build> installed in order to use this, or else
they'll get a module-not-found error.

=item passthrough (DEPRECATED)

This is just like the C<small> option above, but if C<Module::Build> is
not already installed on the user's system, the script will offer to
use C<CPAN.pm> to download it and install it before continuing with
the build.

This option has been deprecated and may be removed in a future version
of Module::Build.  Modern CPAN.pm and CPANPLUS will recognize the

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

  Build install

On the old Mac OS (version 9 or lower) using MacPerl, you can
double-click on the F<Build.PL> script to create the F<Build> script,
then double-click on the F<Build> script to run its C<build>, C<test>,
and C<install> actions.

The F<Build> script knows what perl was used to run F<Build.PL>, so
you don't need to re-invoke the F<Build> script with the complete perl
path each time.  If you invoke it with the I<wrong> perl path, you'll
get a warning or a fatal error.

=head2 Modifying Config.pm values

C<Module::Build> relies heavily on various values from perl's
C<Config.pm> to do its work.  For example, default installation paths
are given by C<installsitelib> and C<installvendorman3dir> and
friends, C linker & compiler settings are given by C<ld>,
C<lddlflags>, C<cc>, C<ccflags>, and so on.  I<If you're pretty sure
you know what you're doing>, you can tell C<Module::Build> to pretend
there are different values in F<Config.pm> than what's really there,

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

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:

  ./Build test --test_files t/mytest.t

In addition, you may want to run the test in verbose mode to get more
informative output:

  ./Build test --test_files t/mytest.t --verbose 1

I run this so frequently that I define the following shell alias:

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

Or you can call the C<install_path()> method later:

  $build->install_path(conf => $installation_path);

The user may also specify the path on the command line:

  perl Build.PL --install_path conf=/foo/path/etc

The important part, though, is that I<somehow> the install path needs
to be set, or else nothing in the F<blib/conf/> directory will get
installed, and a runtime error during the C<install> action will
result.

See also L<"Adding new file types to the build process"> for how to
create the stuff in F<blib/conf/> in the first place.


=head1 EXAMPLES ON CPAN

Several distributions on CPAN are making good use of various features
of Module::Build.  They can serve as real-world examples for others.

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


  my $basename = basename($0);
  $basename =~ s/(?:\.bat)?$//i;

  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 {

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


  my $head = <<EOT;
    \@rem = '--*-Perl-*--
    \@echo off
    if "%OS%" == "Windows_NT" goto WinNT
    perl $opts{otherargs}
    goto endofperl
    :WinNT
    perl $opts{ntargs}
    if NOT "%COMSPEC%" == "%SystemRoot%\\system32\\cmd.exe" goto endofperl
    if %errorlevel% == 9009 echo You do not have Perl in your PATH.
    if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
    goto endofperl
    \@rem ';
EOT

  $head =~ s/^\s+//gm;
  my $headlines = 2 + ($head =~ tr/\n/\n/);
  my $tail = "\n__END__\n:endofperl\n";

  my $linedone  = 0;
  my $taildone  = 0;

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

    # always add +1 to CORE::caller (proxy caller function)
    # to skip this function's caller
    return $Caller_Proxy->( $height + 1 ) if ! @Up_Frames;

#pod =begin _private
#pod
#pod So it has to work like this:
#pod
#pod     Call stack               Actual     uplevel 1
#pod CORE::GLOBAL::caller
#pod Carp::short_error_loc           0
#pod Carp::shortmess_heavy           1           0
#pod Carp::croak                     2           1
#pod try_croak                       3           2
#pod uplevel                         4            
#pod function_that_called_uplevel    5            
#pod caller_we_want_to_see           6           3
#pod its_caller                      7           4
#pod
#pod So when caller(X) winds up below uplevel(), it only has to use  
#pod CORE::caller(X+1) (to skip CORE::GLOBAL::caller).  But when caller(X)

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


Setting or changing the global after the module has been loaded will have
no effect.

=begin _private

So it has to work like this:

    Call stack               Actual     uplevel 1
CORE::GLOBAL::caller
Carp::short_error_loc           0
Carp::shortmess_heavy           1           0
Carp::croak                     2           1
try_croak                       3           2
uplevel                         4            
function_that_called_uplevel    5            
caller_we_want_to_see           6           3
its_caller                      7           4

So when caller(X) winds up below uplevel(), it only has to use  
CORE::caller(X+1) (to skip CORE::GLOBAL::caller).  But when caller(X)

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

  # or if you don't need Test::More

  use Test::Exception tests => 5;

  # then...

  # Check that the stringified exception matches given regex
  throws_ok { $foo->method } qr/division by zero/, 'zero caught okay';

  # Check an exception of the given class (or subclass) is thrown
  throws_ok { $foo->method } 'Error::Simple', 'simple error thrown';
  
  # all Test::Exceptions subroutines are guaranteed to preserve the state 
  # of $@ so you can do things like this after throws_ok and dies_ok
  like $@, 'what the stringified exception should look like';

  # Check that something died - we do not care why
  dies_ok { $foo->method } 'expecting to die';

  # Check that something did not die
  lives_ok { $foo->method } 'expecting to live';

  # Check that a test runs without an exception
  lives_and { is $foo->method, 42 } 'method is 42';
  
  # or if you don't like prototyped functions
  
  throws_ok( sub { $foo->method }, qr/division by zero/,
      'zero caught okay' );
  throws_ok( sub { $foo->method }, 'Error::Simple', 
      'simple error thrown' );
  dies_ok( sub { $foo->method }, 'expecting to die' );
  lives_ok( sub { $foo->method }, 'expecting to live' );
  lives_and( sub { is $foo->method, 42 }, 'method is 42' );


=head1 DESCRIPTION

This module provides a few convenience methods for testing exception based code. It is built with 
L<Test::Builder> and plays happily with L<Test::More> and friends.

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

In the first form the test passes if the stringified exception matches the give regular expression. For example:

    throws_ok { read_file( 'unreadable' ) } qr/No file/, 'no file';

If your perl does not support C<qr//> you can also pass a regex-like string, for example:

    throws_ok { read_file( 'unreadable' ) } '/No file/', 'no file';

The second form of throws_ok() test passes if the exception is of the same class as the one supplied, or a subclass of that class. For example:

    throws_ok { $foo->bar } "Error::Simple", 'simple error';

Will only pass if the C<bar> method throws an Error::Simple exception, or a subclass of an Error::Simple exception.

You can get the same effect by passing an instance of the exception you want to look for. The following is equivalent to the previous example:

    my $SIMPLE = Error::Simple->new;
    throws_ok { $foo->bar } $SIMPLE, 'simple error';

Should a throws_ok() test fail it produces appropriate diagnostic messages. For example:

    not ok 3 - simple error
    #     Failed test (test.t at line 48)
    # expecting: Error::Simple exception
    # found: normal exit

Like all other Test::Exception functions you can avoid prototypes by passing a subroutine explicitly:

    throws_ok( sub {$foo->bar}, "Error::Simple", 'simple error' );

A true value is returned if the test succeeds, false otherwise. On exit $@ is guaranteed to be the cause of death (if any).

A description of the exception being checked is used if no optional test description is passed.

NOTE: Remember when you C<die $string_without_a_trailing_newline> perl will 
automatically add the current script line number, input line number and a newline. This will
form part of the string that throws_ok regular expressions match against.


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

You can use lives_and() like this:

  lives_and { is read_file('answer.txt'), "42" } 'answer is 42';
  # or if you don't like prototypes
  lives_and(sub {is read_file('answer.txt'), "42"}, 'answer is 42');

Which is the same as doing

  is read_file('answer.txt'), "42\n", 'answer is 42';

unless C<read_file('answer.txt')> dies, in which case you get the same kind of error as lives_ok()

  not ok 1 - answer is 42
  #     Failed test (test.t at line 15)
  # died: open failed (No such file or directory)

A true value is returned if the test succeeds, false otherwise. On exit $@ is guaranteed to be the cause of death (if any).

The test description is optional, but recommended.

=cut

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

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 ) = @_;

   my @futures;

t/invalid.t  view on Meta::CPAN

#!/usr/bin/env perl

use strict;
use warnings;

use Acme::Sort::Sleep qw( sleepsort );
use Test::More;
use Test::Exception;

my $error = qr/Only positive numbers accepted./;

my @undefined   = ( undef );
my @negative    = ( -1 );
my @non_numeric = ( 'z' );

throws_ok { sleepsort( @undefined    ) } $error, 'undef';
throws_ok { sleepsort( @negative     ) } $error, 'negative number';
throws_ok { sleepsort( @non_numeric  ) } $error, 'non-numeric value';
    
done_testing;



( run in 0.520 second using v1.01-cache-2.11-cpan-65fba6d93b7 )