Acme-Sort-Sleep

 view release on metacpan or  search on metacpan

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

as ready by any of the C<done>, C<fail>, or C<cancel> methods. It can be
called either as a class method, or as an instance method. Called on an
instance it will construct another in the same class, and is useful for
subclassing.

This constructor would primarily be used by implementations of asynchronous
interfaces.

=cut

# Callback flags
use constant {
   CB_DONE   => 1<<0, # Execute callback on done
   CB_FAIL   => 1<<1, # Execute callback on fail
   CB_CANCEL => 1<<2, # Execute callback on cancellation

   CB_SELF   => 1<<3, # Pass $self as first argument
   CB_RESULT => 1<<4, # Pass result/failure as a list

   CB_SEQ_ONDONE => 1<<5, # Sequencing on success (->then)
   CB_SEQ_ONFAIL => 1<<6, # Sequencing on failure (->else)

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


   my $cancelled = $self->{cancelled};
   my $fail      = defined $self->{failure};
   my $done      = !$fail && !$cancelled;

   my @result  = $done ? $self->get :
                 $fail ? $self->failure :
                         ();

   foreach my $cb ( @$callbacks ) {
      my ( $flags, $code ) = @$cb;
      my $is_future = blessed( $code ) && $code->isa( "Future" );

      next if $done      and not( $flags & CB_DONE );
      next if $fail      and not( $flags & CB_FAIL );
      next if $cancelled and not( $flags & CB_CANCEL );

      $self->{reported} = 1 if $fail;

      if( $is_future ) {
         $done ? $code->done( @result ) :
         $fail ? $code->fail( @result ) :
                 $code->cancel;
      }
      elsif( $flags & (CB_SEQ_ONDONE|CB_SEQ_ONFAIL) ) {
         my ( undef, undef, $fseq ) = @$cb;
         if( !$fseq ) { # weaken()ed; it might be gone now
            # This warning should always be printed, even not in DEBUG mode.
            # It's always an indication of a bug
            Carp::carp +(DEBUG ? "${\$self->__selfstr} ($self->{constructed_at})"
                               : "${\$self->__selfstr} $self" ) .
               " lost a sequence Future";
            next;
         }

         my $f2;
         if( $done and $flags & CB_SEQ_ONDONE or
             $fail and $flags & CB_SEQ_ONFAIL ) {

            if( $flags & CB_SEQ_IMDONE ) {
               $fseq->done( @$code );
               next;
            }
            elsif( $flags & CB_SEQ_IMFAIL ) {
               $fseq->fail( @$code );
               next;
            }

            my @args = (
               ( $flags & CB_SELF   ? $self : () ),
               ( $flags & CB_RESULT ? @result : () ),
            );

            unless( eval { $f2 = $code->( @args ); 1 } ) {
               $fseq->fail( $@ );
               next;
            }

            unless( blessed $f2 and $f2->isa( "Future" ) ) {
               $fseq->fail( "Expected " . CvNAME_FILE_LINE($code) . " to return a Future" );
               next;

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

         if( $f2->is_ready ) {
            $f2->on_ready( $fseq ) if !$f2->{cancelled};
         }
         else {
            push @{ $f2->{callbacks} }, [ CB_DONE|CB_FAIL, $fseq ];
            weaken( $f2->{callbacks}[-1][1] );
         }
      }
      else {
         $code->(
            ( $flags & CB_SELF   ? $self : () ),
            ( $flags & CB_RESULT ? @result : () ),
         );
      }
   }
}

sub _state
{
   my $self = shift;
   return !$self->{ready}     ? "pending" :
           DEBUG              ? $self->{ready_at} :

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


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
   my $func = (caller 1)[3];
   $func =~ s/^.*:://;

   $flags & (CB_SEQ_IMDONE|CB_SEQ_IMFAIL) or _callable( $code ) or
      Carp::croak "Expected \$code to be callable in ->$func";

   if( !defined wantarray ) {
      Carp::carp "Calling ->$func in void context";
   }

   if( $f1->is_ready ) {
      # Take a shortcut
      return $f1 if $f1->is_done and not( $flags & CB_SEQ_ONDONE ) or
                    $f1->failure and not( $flags & CB_SEQ_ONFAIL );

      if( $flags & CB_SEQ_IMDONE ) {
         return Future->done( @$code );
      }
      elsif( $flags & CB_SEQ_IMFAIL ) {
         return Future->fail( @$code );
      }

      my @args = (
         ( $flags & CB_SELF ? $f1 : () ),
         ( $flags & CB_RESULT ? $f1->is_done ? $f1->get :
                                $f1->failure ? $f1->failure :
                                               () : () ),
      );

      my $fseq;
      unless( eval { $fseq = $code->( @args ); 1 } ) {
         return Future->fail( $@ );
      }

      unless( blessed $fseq and $fseq->isa( "Future" ) ) {
         return Future->fail( "Expected " . CvNAME_FILE_LINE($code) . " to return a Future" );
      }

      return $fseq;
   }

   my $fseq = $f1->new;
   $fseq->on_cancel( $f1 );

   # TODO: if anyone cares about the op name, we might have to synthesize it
   # from $flags
   $code = $f1->wrap_cb( sequence => $code ) unless $flags & (CB_SEQ_IMDONE|CB_SEQ_IMFAIL);

   push @{ $f1->{callbacks} }, [ CB_DONE|CB_FAIL|$flags, $code, $fseq ];
   weaken( $f1->{callbacks}[-1][2] );

   return $fseq;
}

=head2 then

   $future = $f1->then( \&done_code )

I<Since version 0.13.>

local/lib/perl5/Future/Phrasebook.pod  view on Meta::CPAN

C<Future::Utils::fmap> family of functions can be used to bound the
concurrency, keeping at most some given number of items running, starting new
ones as existing ones complete.

 my $f = fmap {
    my $item = shift;
    F_FUNC( $item )
 } foreach => \@ITEMS;

By itself, this will not actually act concurrently as it will only keep one
Future outstanding at a time. The C<concurrent> flag lets it keep a larger
number "in flight" at any one time:

 my $f = fmap {
    my $item = shift;
    F_FUNC( $item )
 } foreach => \@ITEMS, concurrent => 10;

The C<fmap> and C<fmap_scalar> functions return a Future that will eventually
give the collected results of the individual item futures, thus making them
similar to perl's C<map> operator.

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

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
{
   my ( $fmt, @args ) = @_;

   $DEBUG_FH ||= do {

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

   my ( $family, $socktype, $protocol ) = IO::Async::OS->extract_addrinfo( $ai );

   my $sock = IO::Async::OS->socket( $family, $socktype, $protocol );
   $self->set_handle( $sock );
}

=head2 bind

   $handle = $handle->bind( %args )->get

Performs a C<getaddrinfo> resolver operation with the C<passive> flag set,
and then attempts to bind a socket handle of any of the return values.

=head2 bind (1 argument)

   $handle = $handle->bind( $ai )->get

When invoked with a single argument, this method is a convenient shortcut to
creating a socket handle and C<bind()>ing it to the address as given by an
addrinfo structure, and setting it as the read and write handle for the
object.

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

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

   my $loop = $self->{loop};

   my $on_fail = $params{on_fail};

   my %gai_hints;
   exists $params{$_} and $gai_hints{$_} = $params{$_} for qw( family socktype protocol flags );

   if( exists $params{host} or exists $params{local_host} or exists $params{local_port} ) {
      # We'll be making a ->getaddrinfo call
      defined $gai_hints{socktype} or defined $gai_hints{protocol} or
         carp "Attempting to ->connect without either 'socktype' or 'protocol' hint is not portable";
   }

   my $peeraddrfuture;
   if( exists $params{host} and exists $params{service} ) {
      my $host    = $params{host}    or croak "Expected 'host'";

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


Optional. The hostname and/or service name to C<bind(2)> the socket to locally
before connecting to the peer.

=item family => INT

=item socktype => INT

=item protocol => INT

=item flags => INT

Optional. Other arguments to pass along with C<host> and C<service> to the
C<getaddrinfo> call.

=item socktype => STRING

Optionally may instead be one of the values C<'stream'>, C<'dgram'> or
C<'raw'> to stand for C<SOCK_STREAM>, C<SOCK_DGRAM> or C<SOCK_RAW>. This
utility is provided to allow the caller to avoid a separate C<use Socket> only
for importing these constants.

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


The hostname to listen on. Optional. Will listen on all addresses if not
supplied.

=item family => INT

=item socktype => INT

=item protocol => INT

=item flags => INT

Optional. Other arguments to pass along with C<host> and C<service> to the
C<getaddrinfo> call.

=item socktype => STRING

Optionally may instead be one of the values C<'stream'>, C<'dgram'> or
C<'raw'> to stand for C<SOCK_STREAM>, C<SOCK_DGRAM> or C<SOCK_RAW>. This
utility is provided to allow the caller to avoid a separate C<use Socket> only
for importing these constants.

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


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

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

   my %gai_hints;
   exists $params{$_} and $gai_hints{$_} = $params{$_} for qw( family socktype protocol flags );

   defined $gai_hints{socktype} or defined $gai_hints{protocol} or
      carp "Attempting to ->listen without either 'socktype' or 'protocol' hint is not portable";

   $self->resolver->getaddrinfo(
      host    => $host,
      service => $service,
      passive => 1,
      %gai_hints,
   )->then( sub {

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

=back

There can only be one filehandle of any given fileno registered at any one
time. For any one filehandle, there can only be one read-readiness and/or one
write-readiness callback at any one time. Registering a new one will remove an
existing one of that type. It is not required that both are provided.

Applications should use a L<IO::Async::Handle> or L<IO::Async::Stream> instead
of using this method.

If the filehandle does not yet have the C<O_NONBLOCK> flag set, it will be
enabled by this method. This will ensure that any subsequent C<sysread>,
C<syswrite>, or similar will not block on the filehandle.

=cut

# This class specifically does NOT implement this method, so that subclasses
# are forced to. The constructor will be checking....
sub __watch_io
{
   my $self = shift;

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

The host and service names to look up. At least one must be provided.

=item family => INT or STRING

=item socktype => INT or STRING

=item protocol => INT

Hint values used to filter the results.

=item flags => INT

Flags to control the C<getaddrinfo(3)> function. See the C<AI_*> constants in
L<Socket>'s C<getaddrinfo> function for more detail.

=item passive => BOOL

If true, sets the C<AI_PASSIVE> flag. This is provided as a convenience to
avoid the caller from having to import the C<AI_PASSIVE> constant from
C<Socket>.

=item timeout => NUMBER

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;

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

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

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

   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};

   # Clear any other existing but undefined hints
   defined $args{$_} or delete $args{$_} for keys %args;

   # It's likely this will succeed with AI_NUMERICHOST if host contains only
   # [\d.] (IPv4) or [[:xdigit:]:] (IPv6)
   # Technically we should pass AI_NUMERICSERV but not all platforms support
   # it, but since we're checking service contains only \d we should be fine.

   # These address tests don't have to be perfect as if it fails we'll get
   # EAI_NONAME and just try it asynchronously anyway
   if( ( $host =~ m/^[\d.]+$/ or $host =~ m/^[[:xdigit:]:]$/ or $host eq "" ) and
       $service =~ m/^\d+$/ ) {

       my ( $err, @results ) = Socket::getaddrinfo( $host, $service,
          { %args, flags => $flags | AI_NUMERICHOST }
       );

       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
       }

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

          $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;

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


A shortcut wrapper around the C<getnameinfo> resolver, taking its arguments in
a more convenient form.

=over 8

=item addr => STRING

The packed socket address to look up.

=item flags => INT

Flags to control the C<getnameinfo(3)> function. See the C<NI_*> constants in
L<Socket>'s C<getnameinfo> for more detail.

=item numerichost => BOOL

=item numericserv => BOOL

=item dgram => BOOL

If true, set the C<NI_NUMERICHOST>, C<NI_NUMERICSERV> or C<NI_DGRAM> flags.

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

   $resolver->getnameinfo( %args )

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

=over 8

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

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

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

   defined $args{$_} or delete $args{$_} for keys %args;

   my ( $err, @addrs ) = Socket::getaddrinfo( $host, $service, \%args );

   die [ "$err", $err+0 ] if $err;

   return @addrs;
};

register_resolver getaddrinfo_array => sub {
   my ( $host, $service, $family, $socktype, $protocol, $flags ) = @_;

   $family   = IO::Async::OS->getfamilybyname( $family );
   $socktype = IO::Async::OS->getsocktypebyname( $socktype );

   my %hints;
   $hints{family}   = $family   if defined $family;
   $hints{socktype} = $socktype if defined $socktype;
   $hints{protocol} = $protocol if defined $protocol;
   $hints{flags}    = $flags    if defined $flags;

   my ( $err, @addrs ) = Socket::getaddrinfo( $host, $service, \%hints );

   die [ "$err", $err+0 ] if $err;

   # Convert the @addrs list into a list of ARRAY refs of 5 values each
   return map {
      [ $_->{family}, $_->{socktype}, $_->{protocol}, $_->{addr}, $_->{canonname} ]
   } @addrs;
};

register_resolver getnameinfo => sub {
   my ( $addr, $flags ) = @_;

   my ( $err, $host, $service ) = Socket::getnameinfo( $addr, $flags || 0 );

   die [ "$err", $err+0 ] if $err;

   return [ $host, $service ];
};

=head1 EXAMPLES

The following somewhat contrieved example shows how to implement a new
resolver function. This example just uses in-memory data, but a real function

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


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

=head1 METHODS

=cut

=head2 send

   $socket->send( $data, $flags, $addr )

This method adds a segment of data to be sent, or sends it immediately,
according to the C<autoflush> parameter. C<$flags> and C<$addr> are optional.

If the C<autoflush> option is set, this method will try immediately to send
the data to the underlying filehandle, optionally using the given flags and
destination address. If this completes successfully then it will have been
sent by the time this method returns. If it fails to send, then the data is
queued as if C<autoflush> were not set, and will be flushed as normal.

=cut

sub send
{
   my $self = shift;
   my ( $data, $flags, $addr ) = @_;

   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


sub on_write_ready
{
   my $self = shift;

   my $handle = $self->write_handle;

   my $sendqueue = $self->{sendqueue};

   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;

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

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;
use constant WANT_ANY_WRITE => WANT_WRITE_FOR_READ|WANT_WRITE_FOR_WRITE;

=head1 NAME

C<IO::Async::Stream> - event callbacks and write bufering for a stream

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

If supplied, sets the name of encoding of the underlying stream. If an
encoding is set, then the C<write> method will expect to receive Unicode
strings and encodes them into bytes, and incoming bytes will be decoded into
Unicode strings for the C<on_read> event.

If an encoding is not supplied then C<write> and C<on_read> will work in byte
strings.

I<IMPORTANT NOTE:> in order to handle reads of UTF-8 content or other
multibyte encodings, the code implementing the C<on_read> event uses a feature
of L<Encode>; the C<STOP_AT_PARTIAL> flag. While this flag has existed for a
while and is used by the C<:encoding> PerlIO layer itself for similar
purposes, the flag is not officially documented by the C<Encode> module. In
principle this undocumented feature could be subject to change, in practice I
believe it to be reasonably stable.

This note applies only to the C<on_read> event; data written using the
C<write> method does not rely on any undocumented features of C<Encode>.

If a read handle is given, it is required that either an C<on_read> callback
reference is configured, or that the object provides an C<on_read> method. It
is optional whether either is true for C<on_outgoing_empty>; if neither is
supplied then no action will be taken when the writing buffer becomes empty.

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

=cut

sub connect
{
   my $self = shift;
   return $self->SUPER::connect( socktype => "stream", @_ );
}

=head1 DEBUGGING FLAGS

The following flags in C<IO_ASYNC_DEBUG_FLAGS> enable extra logging:

=over 4

=item C<Sr>

Log byte buffers as data is read from a Stream

=item C<Sw>

Log byte buffers as data is written to a Stream

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

=item diff

[version 0.14]

This action will compare the files about to be installed with their
installed counterparts.  For .pm and .pod files, a diff will be shown
(this currently requires a 'diff' program to be in your PATH).  For
other files like compiled binary files, we simply report whether they
differ.

A C<flags> parameter may be passed to the action, which will be passed
to the 'diff' program.  Consult your 'diff' documentation for the
parameters it will accept - a good one is C<-u>:

  ./Build diff flags=-u

=item dist

[version 0.02]

This action is helpful for module authors who want to package up their
module for source distribution through a medium like CPAN.  It will create a
tarball of the files listed in F<MANIFEST> and compress the tarball using
GZIP compression.

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

is considered a comment, and is stripped before parsing.  If more than
one line begins with the same action name, those lines are merged into
one set of options.

Besides the regular actions, there are two special pseudo-actions: the
key C<*> (asterisk) denotes any global options that should be applied
to all actions, and the key 'Build_PL' specifies options to be applied
when you invoke C<perl Build.PL>.

  *           verbose=1   # global options
  diff        flags=-u
  install     --install_base /home/ken
              --install_path html=/home/ken/docs/html
  installdeps --cpan_client 'cpanp -i'

If you wish to locate your resource file in a different location, you
can set the environment variable C<MODULEBUILDRC> to the complete
absolute path of the file containing your options.

=head2 Environment variables

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

better.

If the target file of L</dist_version_from> contains more than one package
declaration, the version returned will be the one matching the configured
L</module_name>.

=item dynamic_config

[version 0.07]

A boolean flag indicating whether the F<Build.PL> file must be
executed, or whether this module can be built, tested and installed
solely from consulting its metadata file.  The main reason to set this
to a true value is that your module performs some dynamic
configuration as part of its build/install process.  If the flag is
omitted, the F<META.yml> spec says that installation tools should
treat it as 1 (true), because this is a safer way to behave.

Currently C<Module::Build> doesn't actually do anything with this flag
- it's up to higher-level tools like C<CPAN.pm> to do something useful
with it.  It can potentially bring lots of security, packaging, and
convenience improvements.

=item extra_compiler_flags

=item extra_linker_flags

[version 0.19]

These parameters can contain array references (or strings, in which
case they will be split into arrays) to pass through to the compiler
and linker phases when compiling/linking C code.  For example, to tell
the compiler that your code is C++, you might do:

  my $build = Module::Build->new
    (
     module_name          => 'Foo::Bar',
     extra_compiler_flags => ['-x', 'c++'],
    );

To link your XS code against glib you might write something like:

  my $build = Module::Build->new
    (
     module_name          => 'Foo::Bar',
     dynamic_config       => 1,
     extra_compiler_flags => scalar `glib-config --cflags`,
     extra_linker_flags   => scalar `glib-config --libs`,
    );

=item extra_manify_args

[version 0.4006]

Any extra arguments to pass to C<< Pod::Man->new() >> when building
man pages.  One common choice might be C<< utf8 => 1 >> to get Unicode
support.

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

method will print the command to C<STDOUT>, and then execute it using
Perl's C<system()>.  It returns true or false to indicate success or
failure (the opposite of how C<system()> works, but more intuitive).

Note that if you supply a single argument to C<do_system()>, it
will/may be processed by the system's shell, and any special
characters will do their special things.  If you supply multiple
arguments, no shell will get involved and the command will be executed
directly.

=item extra_compiler_flags()

=item extra_compiler_flags(@flags)

[version 0.25]

Set or retrieve the extra compiler flags. Returns an arrayref of flags.

=item extra_linker_flags()

=item extra_linker_flags(@flags)

[version 0.25]

Set or retrieve the extra linker flags. Returns an arrayref of flags.

=item feature($name)

=item feature($name => $value)

[version 0.26]

With a single argument, returns true if the given feature is set.
With two arguments, sets the given feature to the given boolean value.
In this context, a "feature" is any optional functionality of an

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

  $p->{bindoc_dirs} ||= [ $blibdir->("script") ];
  $p->{libdoc_dirs} ||= [ $blibdir->("lib"), $blibdir->("arch") ];

  $p->{dist_author} = [ $p->{dist_author} ] if defined $p->{dist_author} and not ref $p->{dist_author};

  # Synonyms
  $p->{requires} = delete $p->{prereq} if defined $p->{prereq};
  $p->{script_files} = delete $p->{scripts} if defined $p->{scripts};

  # Convert to from shell strings to arrays
  for ('extra_compiler_flags', 'extra_linker_flags') {
    $p->{$_} = [ $self->split_like_shell($p->{$_}) ] if exists $p->{$_};
  }

  # Convert to arrays
  for ('include_dirs') {
    $p->{$_} = [ $p->{$_} ] if exists $p->{$_} && !ref $p->{$_}
  }

  $self->add_to_cleanup( @{delete $p->{add_to_cleanup}} )
    if $p->{add_to_cleanup};

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

  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
  install_base
  libdoc_dirs
  magic_number
  mb_version
  module_name
  needs_compiler
  orig_dir
  perl
  pm_files

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

          } @{"$current\::ISA"};

        # I.e., if this class has any parents (at least, ones I've never seen
        # before), push them, in order, onto the stack of classes I need to
        # explore.
    }
    shift @out;
    return @out;
}

sub extra_linker_flags   { shift->_list_accessor('extra_linker_flags',   @_) }
sub extra_compiler_flags { shift->_list_accessor('extra_compiler_flags', @_) }

sub _list_accessor {
  (my $self, local $_) = (shift, shift);
  my $p = $self->{properties};
  $p->{$_} = [@_] if @_;
  $p->{$_} = [] unless exists $p->{$_};
  return ref($p->{$_}) ? $p->{$_} : [$p->{$_}];
}

# XXX Problem - if Module::Build is loaded from a different directory,

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

sub _translate_option {
  my $self = shift;
  my $opt  = shift;

  (my $tr_opt = $opt) =~ tr/-/_/;

  return $tr_opt if grep $tr_opt =~ /^(?:no_?)?$_$/, qw(
    create_license
    create_makefile_pl
    create_readme
    extra_compiler_flags
    extra_linker_flags
    install_base
    install_path
    meta_add
    meta_merge
    test_files
    use_rcfile
    use_tap_harness
    tap_harness_args
    cpan_client
    pureperl_only

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

  if ( grep $opt =~ /^no[-_]?$_$/, @bool_opts ) {
    $opt =~ s/^no-?//;
    return ($opt, 0);
  }

  # non-boolean option; return option unchanged along with its argument
  return ($opt, shift(@$argv)) unless grep $_ eq $opt, @bool_opts;

  # we're punting a bit here, if an option appears followed by a digit
  # we take the digit as the argument for the option. If there is
  # nothing that looks like a digit, we pretend the option is a flag
  # that is being set and has no argument.
  my $arg = 1;
  $arg = shift(@$argv) if @$argv && $argv->[0] =~ /^\d+$/;

  return ($opt, $arg);
}

sub read_args {
  my $self = shift;

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

      my($opt, $arg) = $self->_optional_arg($1, \@_);
      $self->_read_arg(\%args, $opt, $arg);
    } elsif ( /^($opt_re)$/ and !defined($action)) {
      $action = $1;
    } else {
      push @argv, $_;
    }
  }
  $args{ARGV} = \@argv;

  for ('extra_compiler_flags', 'extra_linker_flags') {
    $args{$_} = [ $self->split_like_shell($args{$_}) ] if exists $args{$_};
  }

  # Convert to arrays
  for ('include_dirs') {
    $args{$_} = [ $args{$_} ] if exists $args{$_} && !ref $args{$_}
  }

  # Hashify these parameters
  for ($self->hash_properties, 'config') {

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

# For systems that don't have 'diff' executable, should use Algorithm::Diff
sub ACTION_diff {
  my $self = shift;
  $self->depends_on('build');
  my $local_lib = File::Spec->rel2abs('lib');
  my @myINC = grep {$_ ne $local_lib} @INC;

  # The actual install destination might not be in @INC, so check there too.
  push @myINC, map $self->install_destination($_), qw(lib arch);

  my @flags = @{$self->{args}{ARGV}};
  @flags = $self->split_like_shell($self->{args}{flags} || '') unless @flags;

  my $installmap = $self->install_map;
  delete $installmap->{read};
  delete $installmap->{write};

  my $text_suffix = $self->file_qr('\.(pm|pod)$');

  foreach my $localdir (sort keys %$installmap) {
    my @localparts = File::Spec->splitdir($localdir);
    my $files = $self->rscan_dir($localdir, sub {-f});

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

      if (not $installed) {
        print "Only in lib: $file\n";
        next;
      }

      my $status = File::Compare::compare($installed, $file);
      next if $status == 0;  # Files are the same
      die "Can't compare $installed and $file: $!" if $status == -1;

      if ($file =~ $text_suffix) {
        $self->do_system('diff', @flags, $installed, $file);
      } else {
        print "Binary files $file and $installed differ\n";
      }
    }
  }
}

sub ACTION_pure_install {
  shift()->depends_on('install');
}

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

  return \%result;
}

sub make_tarball {
  my ($self, $dir, $file) = @_;
  $file ||= $dir;

  $self->log_info("Creating $file.tar.gz\n");

  if ($self->{args}{tar}) {
    my $tar_flags = $self->verbose ? 'cvf' : 'cf';
    $self->do_system($self->split_like_shell($self->{args}{tar}), $tar_flags, "$file.tar", $dir);
    $self->do_system($self->split_like_shell($self->{args}{gzip}), "$file.tar") if $self->{args}{gzip};
  } else {
    eval { require Archive::Tar && Archive::Tar->VERSION(1.09); 1 }
      or die "You must install Archive::Tar 1.09+ to make a distribution tarball\n".
             "or specify a binary tar program with the '--tar' option.\n".
             "See the documentation for the 'dist' action.\n";

    my $files = $self->rscan_dir($dir);

    # Archive::Tar versions >= 1.09 use the following to enable a compatibility

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


  my $b = $self->cbuilder;
  my $obj_file = $b->object_file($file);
  $self->add_to_cleanup($obj_file);
  return $obj_file if $self->up_to_date($file, $obj_file);

  $b->compile(source => $file,
              defines => $args{defines},
              object_file => $obj_file,
              include_dirs => $self->include_dirs,
              extra_compiler_flags => $self->extra_compiler_flags,
             );

  return $obj_file;
}

sub link_c {
  my ($self, $spec) = @_;
  my $p = $self->{properties}; # For convenience

  $self->add_to_cleanup($spec->{lib_file});

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

  return $spec->{lib_file}
    if $self->up_to_date([$spec->{obj_file}, @$objects],
                         $spec->{lib_file});

  my $module_name = $spec->{module_name} || $self->module_name;

  $self->cbuilder->link(
    module_name => $module_name,
    objects     => [$spec->{obj_file}, @$objects],
    lib_file    => $spec->{lib_file},
    extra_linker_flags => $self->extra_linker_flags );

  return $spec->{lib_file};
}

sub compile_xs {
  my ($self, $file, %args) = @_;

  $self->log_verbose("$file -> $args{outfile}\n");

  if (eval {require ExtUtils::ParseXS; 1}) {

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

my %convert_installdirs = (
    PERL        => 'core',
    SITE        => 'site',
    VENDOR      => 'vendor',
);

my %makefile_to_build =
  (
   TEST_VERBOSE => 'verbose',
   VERBINST     => 'verbose',
   INC          => sub { map {(extra_compiler_flags => $_)} Module::Build->split_like_shell(shift) },
   POLLUTE      => sub { (extra_compiler_flags => '-DPERL_POLLUTE') },
   INSTALLDIRS  => sub { (installdirs => $convert_installdirs{uc shift()}) },
   LIB          => sub {
       my $lib = shift;
       my %config = (
           installprivlib  => $lib,
           installsitelib  => $lib,
           installarchlib  => "$lib/$Config{archname}",
           installsitearch => "$lib/$Config{archname}"
       );
       return map { (config => "$_=$config{$_}") } sort keys %config;

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

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,
by passing arguments for the C<--config> parameter on the command
line:

  perl Build.PL --config cc=gcc --config ld=gcc

Inside the C<Build.PL> script the same thing can be accomplished by
passing values for the C<config> parameter to C<new()>:

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

=head2 Installing in the same location as ExtUtils::MakeMaker

With the introduction of C<--prefix> in Module::Build 0.28 and
C<INSTALL_BASE> in C<ExtUtils::MakeMaker> 6.31 its easy to get them both
to install to the same locations.

First, ensure you have at least version 0.28 of Module::Build
installed and 6.31 of C<ExtUtils::MakeMaker>.  Prior versions have
differing (and in some cases quite strange) installation behaviors.

The following installation flags are equivalent between
C<ExtUtils::MakeMaker> and C<Module::Build>.

    MakeMaker             Module::Build
    PREFIX=...            --prefix ...
    INSTALL_BASE=...      --install_base ...
    DESTDIR=...           --destdir ...
    LIB=...               --install_path lib=...
    INSTALLDIRS=...       --installdirs ...
    INSTALLDIRS=perl      --installdirs core
    UNINST=...            --uninst ...
    INC=...               --extra_compiler_flags ...
    POLLUTE=1             --extra_compiler_flags -DPERL_POLLUTE

For example, if you are currently installing C<MakeMaker> modules with
this command:

    perl Makefile.PL PREFIX=~
    make test
    make install UNINST=1

You can install into the same location with Module::Build using this:



( run in 1.191 second using v1.01-cache-2.11-cpan-140bd7fdf52 )