Acme-Sort-Sleep
view release on metacpan or search on metacpan
modifying or distributing the Package, you accept this license. Do not
use, modify, or distribute the Package, if you do not accept this
license.
(11) If your Modified Version has been derived from a Modified
Version made by someone other than you, you are nevertheless required
to ensure that your Modified Version complies with the requirements of
this license.
(12) This license does not grant you the right to use any trademark,
service mark, tradename, or logo of the Copyright Holder.
(13) This license includes the non-exclusive, worldwide,
free-of-charge patent license to make, have made, use, offer to sell,
sell, import and otherwise transfer the Package with respect to any
patent claims licensable by the Copyright Holder that are necessarily
infringed by the Package. If you institute patent litigation
(including a cross-claim or counterclaim) against any party alleging
that the Package constitutes direct or contributory patent
infringement, then this Artistic License to you shall terminate on the
date that such litigation is filed.
local/lib/perl5/Future.pm view on Meta::CPAN
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
This class easily supports being subclassed to provide extra behavior, such as
giving the C<get> method the ability to block and wait for completion. This
may be useful to provide C<Future> subclasses with event systems, or similar.
Each method that returns a new future object will use the invocant to
construct its return value. If the constructor needs to perform per-instance
local/lib/perl5/Future.pm view on Meta::CPAN
}
=head2 die
$future->die( $message, @details )
I<Since version 0.09.>
A convenient wrapper around C<fail>. If the exception is a non-reference that
does not end in a linefeed, its value will be extended by the file and line
number of the caller, similar to the logic that C<die> uses.
Returns the C<$future>.
=cut
sub die :method
{
my $self = shift;
my ( $exception, @details ) = @_;
local/lib/perl5/Future.pm view on Meta::CPAN
I<Since version 0.31.>
I<Note: This method is experimental and may be changed or removed in a later
version.>
This method is invoked internally by various methods that are about to save a
callback CODE reference supplied by the user, to be invoked later. The default
implementation simply returns the callback agument as-is; the method is
provided to allow users to provide extra behaviour. This can be done by
applying a method modifier of the C<around> kind, so in effect add a chain of
wrappers. Each wrapper can then perform its own wrapping logic of the
callback. C<$operation_name> is a string giving the reason for which the
callback is being saved; currently one of C<on_ready>, C<on_done>, C<on_fail>
or C<sequence>; the latter being used for all the sequence-returning methods.
This method is intentionally invoked only for CODE references that are being
saved on a pending C<Future> instance to be invoked at some later point. It
does not run for callbacks to be invoked on an already-complete instance. This
is for performance reasons, where the intended behaviour is that the wrapper
can provide some amount of context save and restore, to return the operating
environment for the callback back to what it was at the time it was saved.
For example, the following wrapper saves the value of a package variable at
the time the callback was saved, and restores that value at invocation time
later on. This could be useful for preserving context during logging in a
Future-based program.
our $LOGGING_CTX;
no warnings 'redefine';
my $orig = Future->can( "wrap_cb" );
*Future::wrap_cb = sub {
my $cb = $orig->( @_ );
my $saved_logging_ctx = $LOGGING_CTX;
return sub {
local $LOGGING_CTX = $saved_logging_ctx;
$cb->( @_ );
};
};
At this point, any code deferred into a C<Future> by any of its callbacks will
observe the C<$LOGGING_CTX> variable as having the value it held at the time
the callback was saved, even if it is invoked later on when that value is
different.
Remember when writing such a wrapper, that it still needs to invoke the
local/lib/perl5/Future.pm view on Meta::CPAN
$f2 = $f1->then( sub { ... } ); # plus related ->then_with_f, ...
$f2 = $f1->else( sub { ... } ); # plus related ->else_with_f, ...
$f2 = $f1->followed_by( sub { ... } );
In the C<then>-style case it is likely that this situation should be treated
as if C<$f1> had failed, perhaps with some special message. The C<else>-style
case is more complex, because it may be that the entire operation should still
fail, or it may be that the cancellation of C<$f1> should again be treated
simply as a special kind of failure, and the C<else> logic run as normal.
To be specific; in each case it is unclear what happens if the first future is
cancelled, while the second one is still waiting on it. The semantics for
"normal" top-down cancellation of C<$f2> and how it affects C<$f1> are already
clear and defined.
=head2 Cancellation of Divergent Flow
A further complication of cancellation comes from the case where a given
future is reused multiple times for multiple sequences or convergent trees.
local/lib/perl5/Future.pm view on Meta::CPAN
because C<$f1> has been cancelled, the initial future C<$f_initial> is still
required because there is another future (C<$f2>) that will still require its
result.
Initially it would appear that some kind of reference-counting mechanism could
solve this question, though that itself is further complicated by the
C<on_ready> handler and its variants.
It may simply be that a comprehensive useful set of cancellation semantics
can't be universally provided to cover all cases; and that some use-cases at
least would require the application logic to give extra information to its
C<Future> objects on how they should wire up the cancel propagation logic.
Both of these cancellation issues are still under active design consideration;
see the discussion on RT96685 for more information
(L<https://rt.cpan.org/Ticket/Display.html?id=96685>).
=cut
=head1 SEE ALSO
=over 4
local/lib/perl5/Future.pm view on Meta::CPAN
"The Past, The Present and The Future" - slides from a talk given at the
London Perl Workshop, 2012.
L<https://docs.google.com/presentation/d/1UkV5oLcTOOXBXPh8foyxko4PR28_zU_aVx6gBms7uoo/edit>
=item *
"Futures advent calendar 2013"
L<http://leonerds-code.blogspot.co.uk/2013/12/futures-advent-day-1.html>
=back
=cut
=head1 TODO
=over 4
=item *
local/lib/perl5/Future/Phrasebook.pod view on Meta::CPAN
# or the Artistic License (the same terms as Perl itself)
#
# (C) Paul Evans, 2013-2014 -- leonerd@leonerd.org.uk
=head1 NAME
C<Future::Phrasebook> - coding examples for C<Future> and C<Future::Utils>
This documentation-only module provides a phrasebook-like approach to giving
examples on how to use L<Future> and L<Future::Utils> to structure
Future-driven asynchronous or concurrent logic. As with any inter-dialect
phrasebook it is structured into pairs of examples; each given first in a
traditional call/return Perl style, and second in a style using Futures. In
each case, the generic function or functions in the example are named in
C<ALL_CAPITALS()> to make them stand out.
In the examples showing use of Futures, any function that is expected to
return a C<Future> instance is named with a leading C<F_> prefix. Each example
is also constructed so as to yield an overall future in a variable called
C<$f>, which represents the entire operation.
local/lib/perl5/Future/Utils.pm view on Meta::CPAN
The C<call_with_escape> function invokes a block of code that returns a
future, and passes in a separate future (called here an "escape future").
Normally this is equivalent to the simple C<call> function. However, if the
code captures this future and completes it by calling C<done> or C<fail> on
it, the future returned by C<call_with_escape> immediately completes with this
result, and the future returned by the code itself is cancelled.
This can be used to implement short-circuit return from an iterating loop or
complex sequence of code, or immediate fail that bypasses failure handling
logic in the code itself, or several other code patterns.
$f = $code->( $escape_f )
(This can be considered similar to C<call-with-escape-continuation> as found
in some Scheme implementations).
=cut
sub call_with_escape(&)
{
local/lib/perl5/IO/Async.pm view on Meta::CPAN
Consider some form of persistent object wrapper in the form of an
C<IO::Async::Object>, based on L<IO::Async::Routine>.
=item *
C<IO::Async::Protocol::Datagram>
=item *
Support for watching filesystem entries for change. Extract logic from
L<IO::Async::File> and define a Loop watch/unwatch method pair.
=item *
Define more L<Future>-returning methods. Consider also one-shot Futures on
things like L<IO::Async::Process> exits, or L<IO::Async::Handle> close.
=back
=head1 SUPPORT
local/lib/perl5/IO/Async/ChildManager.pm view on Meta::CPAN
},
);
my ( $pipeRd, $pipeWr ) = IO::Async::OS->pipepair;
$loop->spawn_child(
command => "/usr/bin/my-command",
setup => [
stdin => [ "open", "<", "/dev/null" ],
stdout => $pipeWr,
stderr => [ "open", ">>", "/var/log/mycmd.log" ],
chdir => "/",
]
on_exit => sub {
my ( $pid, $exitcode ) = @_;
my $status = ( $exitcode >> 8 );
print "Command exited with status $status\n";
},
);
local/lib/perl5/IO/Async/Debug.pm view on Meta::CPAN
when the event is fired, a debugging line is printed, using the C<debug_printf>
method. This identifes the name of the event.
By default, the line is only printed if the caller of one of these methods is
the same package as the object is blessed into, allowing it to print the
events of the most-derived class, without the extra verbosity of the
lower-level events of its parent class used to create it. All calls regardless
of caller can be printed by setting a number greater than 1 as the value of
C<IO_ASYNC_DEBUG>.
By default the debugging log goes to C<STDERR>, but two other environment
variables can redirect it. If C<IO_ASYNC_DEBUG_FILE> is set, it names a file
which will be opened for writing, and logging written into it. Otherwise, if
C<IO_ASYNC_DEBUG_FD> is set, it gives a file descriptor number that logging
should be written to. If opening the named file or file descriptor fails then
the log will be written to C<STDERR> as normal.
Extra debugging flags can be set in a comma-separated list in an environment
variable called C<IO_ASYNC_DEBUG_FLAGS>. The presence of these flags can cause
extra information to be written to the log. Full details on these flags will
be documented by the implementing classes. Typically these flags take the form
of one or more capital letters indicating the class, followed by one or more
lowercase letters enabling some particular feature within that class.
=cut
sub logf
{
my ( $fmt, @args ) = @_;
$DEBUG_FH ||= do {
my $fh;
if( $DEBUG_FILE ) {
open $fh, ">", $DEBUG_FILE or undef $fh;
}
elsif( $DEBUG_FD ) {
$fh = IO::Handle->new;
$fh->fdopen( $DEBUG_FD, "w" ) or undef $fh;
}
$fh ||= \*STDERR;
$fh->autoflush;
$fh;
};
printf $DEBUG_FH $fmt, @args;
}
sub log_hexdump
{
my ( $bytes ) = @_;
foreach my $chunk ( $bytes =~ m/(.{1,16})/sg ) {
my $chunk_hex = join " ", map { sprintf "%02X", ord $_ } split //, $chunk;
( my $chunk_safe = $chunk ) =~ s/[^\x20-\x7e]/./g;
logf " | %-48s | %-16s |\n", $chunk_hex, $chunk_safe;
}
}
=head1 AUTHOR
Paul Evans <leonerd@leonerd.org.uk>
=cut
0x55AA;
local/lib/perl5/IO/Async/FileStream.pm view on Meta::CPAN
C<IO::Async::FileStream> - read the tail of a file
=head1 SYNOPSIS
use IO::Async::FileStream;
use IO::Async::Loop;
my $loop = IO::Async::Loop->new;
open my $logh, "<", "var/logs/daemon.log" or
die "Cannot open logfile - $!";
my $filestream = IO::Async::FileStream->new(
read_handle => $logh,
on_initial => sub {
my ( $self ) = @_;
$self->seek_to_last( "\n" );
},
on_read => sub {
my ( $self, $buffref ) = @_;
while( $$buffref =~ s/^(.*\n)// ) {
local/lib/perl5/IO/Async/FileStream.pm view on Meta::CPAN
operates entirely synchronously. If the file is very large, it may take a
while to read back through the entire contents. While this is happening no
other events can be invoked in the process.
When looking for a string or regexp match, this method appends the
previously-read buffer to each block read from the file, in case a match
becomes split across two reads. If C<blocksize> is reduced to a very small
value, take care to ensure it isn't so small that a match may not be noticed.
This is most likely useful for seeking after the last complete line in a
line-based log file, to commence reading from the end, while still managing to
capture any partial content that isn't yet a complete line.
on_initial => sub {
my $self = shift;
$self->seek_to_last( "\n" );
}
=cut
sub seek_to_last
local/lib/perl5/IO/Async/Loop.pm view on Meta::CPAN
failures among the first attempts, before a valid connection is made. For
example, the resolver may have returned some IPv6 addresses, but only IPv4
routes are valid on the system. In this case, the first C<connect(2)> syscall
will fail. This isn't yet a fatal error, if there are more addresses to try,
perhaps some IPv4 ones.
For this reason, it is possible that the operation eventually succeeds even
though some system calls initially fail. To be aware of individual failures,
the optional C<on_fail> callback can be used. This will be invoked on each
individual C<socket(2)> or C<connect(2)> failure, which may be useful for
debugging or logging.
Because this module simply uses the C<getaddrinfo> resolver, it will be fully
IPv6-aware if the underlying platform's resolver is. This allows programs to
be fully IPv6-capable.
In plain address mode, the C<%params> hash takes the following keys:
=over 8
=item addrs => ARRAY
local/lib/perl5/IO/Async/Notifier.pm view on Meta::CPAN
my $name = $self->notifier_name;
$id[-1] .= "{$name}" if defined $name and length $name;
$self = $self->parent;
}
s/^IO::Async::Protocol::/IaP:/,
s/^IO::Async::/Ia:/,
s/^Net::Async::/Na:/ for @id;
IO::Async::Debug::logf "[%s] $format\n", join("<-", @id), @args;
}
sub _debug_printf_event
{
my $self = shift;
my ( $caller, $event_name ) = @_;
my $class = ref $self;
if( $IO::Async::Debug::DEBUG > 1 or $class eq $caller ) {
local/lib/perl5/IO/Async/Socket.pm view on Meta::CPAN
buffer, the handle will stil be readable, and will be received from again.
This behaviour allows multiple streams and sockets to be multiplexed
simultaneously, meaning that a large bulk transfer on one cannot starve other
filehandles of processing time. Turning this option on may improve bulk data
transfer rate, at the risk of delaying or stalling processing on other
filehandles.
=head2 send_all => INT
Optional. Analogous to the C<recv_all> option, but for sending. When
C<autoflush> is enabled, this option only affects deferred sending if the
initial attempt failed.
The condition requiring an C<on_recv> handler is checked at the time the
object is added to a Loop; it is allowed to create a C<IO::Async::Socket>
object with a read handle but without a C<on_recv> handler, provided that
one is later given using C<configure> 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.
local/lib/perl5/IO/Async/Stream.pm view on Meta::CPAN
=head2 on_writeable_stop => CODE
CODE references for event handlers.
=head2 autoflush => BOOL
Optional. If true, the C<write> method will attempt to write data to the
operating system immediately, without waiting for the loop to indicate the
filehandle is write-ready. This is useful, for example, on streams that should
contain up-to-date logging or console information.
It currently defaults to false for any file handle, but future versions of
L<IO::Async> may enable this by default on STDOUT and STDERR.
=head2 read_len => INT
Optional. Sets the buffer size for C<read> calls. Defaults to 8 KiBytes.
=head2 read_all => BOOL
local/lib/perl5/IO/Async/Stream.pm view on Meta::CPAN
filehandles of processing time. Turning this option on may improve bulk data
transfer rate, at the risk of delaying or stalling processing on other
filehandles.
=head2 write_len => INT
Optional. Sets the buffer size for C<write> calls. Defaults to 8 KiBytes.
=head2 write_all => BOOL
Optional. Analogous to the C<read_all> option, but for writing. When
C<autoflush> is enabled, this option only affects deferred writing if the
initial attempt failed due to buffer space.
=head2 read_high_watermark => INT
=head2 read_low_watermark => INT
Optional. If defined, gives a way to implement flow control or other
behaviours that depend on the size of Stream's read buffer.
local/lib/perl5/IO/Async/Stream.pm view on Meta::CPAN
$head->on_write = $second->on_write;
$head->on_flush = $second->on_flush;
splice @$writequeue, 1, 1, ();
}
die "TODO: head data does not contain a plain string" if ref $head->data;
if( $IO::Async::Debug::DEBUG > 1 ) {
my $data = substr $head->data, 0, $head->writelen;
$self->debug_printf( "WRITE len=%d", length $data );
IO::Async::Debug::log_hexdump( $data ) if $IO::Async::Debug::DEBUG_FLAGS{Sw};
}
my $writer = $self->{writer};
my $len = $self->$writer( $self->write_handle, $head->data, $head->writelen );
if( !defined $len ) {
my $errno = $!;
if( $errno == EAGAIN or $errno == EWOULDBLOCK ) {
$self->maybe_invoke_event( on_writeable_stop => ) if $self->{writeable};
local/lib/perl5/IO/Async/Stream.pm view on Meta::CPAN
foreach ( @{ $self->{readqueue} } ) {
$_->future->fail( "read failed: $errno", sysread => $errno ) if $_->future;
}
undef @{ $self->{readqueue} };
return;
}
if( $IO::Async::Debug::DEBUG > 1 ) {
$self->debug_printf( "READ len=%d", $len );
IO::Async::Debug::log_hexdump( $data ) if $IO::Async::Debug::DEBUG_FLAGS{Sr};
}
my $eof = $self->{read_eof} = ( $len == 0 );
if( my $encoding = $self->{encoding} ) {
my $bytes = defined $self->{bytes_remaining} ? $self->{bytes_remaining} . $data : $data;
$data = $encoding->decode( $bytes, STOP_AT_PARTIAL );
$self->{bytes_remaining} = $bytes;
}
local/lib/perl5/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
=over 4
=item build
[version 0.01]
If you run the C<Build> script without any arguments, it runs the
C<build> action, which in turn runs the C<code> and C<docs> actions.
This is analogous to the C<MakeMaker> I<make all> target.
=item clean
[version 0.01]
This action will clean up any files that the build process may have
created, including the C<blib/> directory (but not including the
C<_build/> directory and the C<Build> script itself).
=item code
local/lib/perl5/Module/Build.pm view on Meta::CPAN
Provided for compatibility with C<ExtUtils::MakeMaker>'s PREFIX argument.
C<prefix> should be used when you want Module::Build to install your
modules, documentation, and scripts in the same place as
C<ExtUtils::MakeMaker>'s PREFIX mechanism.
The following are equivalent.
perl Build.PL --prefix /tmp/foo
perl Makefile.PL PREFIX=/tmp/foo
Because of the complex nature of the prefixification logic, the
behavior of PREFIX in C<MakeMaker> has changed subtly over time.
Module::Build's --prefix logic is equivalent to the PREFIX logic found
in C<ExtUtils::MakeMaker> 6.30.
The maintainers of C<MakeMaker> do understand the troubles with the
PREFIX mechanism, and added INSTALL_BASE support in version 6.31 of
C<MakeMaker>, which was released in 2006.
If you don't need to retain compatibility with old versions (pre-6.31) of C<ExtUtils::MakeMaker> or
are starting a fresh Perl installation we recommend you use
C<install_base> instead (and C<INSTALL_BASE> in C<ExtUtils::MakeMaker>).
See L<Module::Build::Cookbook/Installing in the same location as
local/lib/perl5/Module/Build/API.pod view on Meta::CPAN
PL files are not installed by default, so its safe to put them in
F<lib/> and F<bin/>.
=item pm_files
[version 0.19]
An optional parameter specifying the set of C<.pm> files in this
distribution, specified as a hash reference whose keys are the files'
locations in the distributions, and whose values are their logical
locations based on their package name, i.e. where they would be found
in a "normal" Module::Build-style distribution. This parameter is
mainly intended to support alternative layouts of files.
For instance, if you have an old-style C<MakeMaker> distribution for a
module called C<Foo::Bar> and a F<Bar.pm> file at the top level of the
distribution, you could specify your layout in your C<Build.PL> like
this:
my $build = Module::Build->new
local/lib/perl5/Module/Build/API.pod view on Meta::CPAN
} 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.
=item compare_versions($v1, $op, $v2)
[version 0.28]
local/lib/perl5/Module/Build/API.pod view on Meta::CPAN
The destination file is set to read-only. If the source file has the
executable bit set, then the destination file will be made executable.
=item create_build_script()
[version 0.05]
Creates an executable script called C<Build> in the current directory
that will be used to execute further user actions. This script is
roughly analogous (in function, not in form) to the Makefile created
by C<ExtUtils::MakeMaker>. This method also creates some temporary
data in a directory called C<_build/>. Both of these will be removed
when the C<realclean> action is performed.
Among the files created in C<_build/> is a F<_build/prereqs> file
containing the set of prerequisites for this distribution, as a hash
of hashes. This file may be C<eval()>-ed to obtain the authoritative
set of prerequisites, which might be different from the contents of
F<META.yml> (because F<Build.PL> might have set them dynamically).
But fancy developers take heed: do not put any fancy custom runtime
local/lib/perl5/Module/Build/API.pod view on Meta::CPAN
See also L<dispatch()|/"dispatch($action, %args)">. The main
distinction between the two is that C<depends_on()> is meant to call
an action from inside another action, whereas C<dispatch()> is meant
to set the very top action in motion.
=item dir_contains($first_dir, $second_dir)
[version 0.28]
Returns true if the first directory logically contains the second
directory. This is just a convenience function because C<File::Spec>
doesn't really provide an easy way to figure this out (but
C<Path::Class> does...).
=item dispatch($action, %args)
[version 0.03]
Invokes the build action C<$action>. Optionally, a list of options
and their values can be passed in. This is equivalent to invoking an
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
$self->cull_args(@ARGV);
die "Too early to specify a build action '$self->{action}'. Do 'Build $self->{action}' instead.\n"
if $self->{action} && $self->{action} ne 'Build_PL';
$self->check_manifest;
$self->auto_require;
# All checks must run regardless if one fails, so no short circuiting!
if( grep { !$_ } $self->check_prereq, $self->check_autofeatures ) {
$self->log_warn(<<EOF);
ERRORS/WARNINGS FOUND IN PREREQUISITES. You may wish to install the versions
of the modules indicated above before proceeding with this installation
EOF
unless (
$self->dist_name eq 'Module-Build' ||
$ENV{PERL5_CPANPLUS_IS_RUNNING} || $ENV{PERL5_CPAN_IS_RUNNING}
) {
$self->log_warn(
"Run 'Build installdeps' to install missing prerequisites.\n\n"
);
}
}
# record for later use in resume;
$self->{properties}{_added_to_INC} = [ $self->_added_to_INC ];
$self->set_bundle_inc;
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
but we are now using '$perl'. You must
run 'Build realclean' or 'make realclean' and re-configure.
DIEFATAL
}
$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;
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
}
}
}
# The following warning could be unnecessary if the user is running
# an embedded perl, but there aren't too many of those around, and
# embedded perls aren't usually used to install modules, and the
# installation process sometimes needs to run external scripts
# (e.g. to run tests).
$p->{perl} = $self->find_perl_interpreter
or $self->log_warn("Warning: Can't locate your perl binary");
my $blibdir = sub { File::Spec->catdir($p->{blib}, @_) };
$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};
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
}
$self->add_to_cleanup( @{delete $p->{add_to_cleanup}} )
if $p->{add_to_cleanup};
return $self;
}
################## End constructors #########################
sub log_info {
my $self = shift;
print @_ if ref($self) && ( $self->verbose || ! $self->quiet );
}
sub log_verbose {
my $self = shift;
print @_ if ref($self) && $self->verbose;
}
sub log_debug {
my $self = shift;
print @_ if ref($self) && $self->debug;
}
sub log_warn {
# Try to make our call stack invisible
shift;
if (@_ and $_[-1] !~ /\n$/) {
my (undef, $file, $line) = caller();
warn @_, " at $file line $line.\n";
} else {
warn @_;
}
}
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
return $self->feature(@_);
} else {
require Module::Build::ConfigData;
return Module::Build::ConfigData->feature(@_);
}
}
sub _warn_mb_feature_deps {
my $self = shift;
my $name = shift;
$self->log_warn(
"The '$name' feature is not available. Please install missing\n" .
"feature dependencies and try again.\n".
$self->_feature_deps_msg($name) . "\n"
);
}
sub add_build_element {
my ($self, $elem) = @_;
my $elems = $self->build_elements;
push @$elems, $elem unless grep { $_ eq $elem } @$elems;
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
my $module_name = $self->module_name
or die "The config_data feature requires that 'module_name' be set";
my $notes_name = $module_name . '::ConfigData'; # TODO: Customize name ???
my $notes_pm = File::Spec->catfile($self->blib, 'lib', split /::/, "$notes_name.pm");
return if $self->up_to_date(['Build.PL',
$self->config_file('config_data'),
$self->config_file('features')
], $notes_pm);
$self->log_verbose("Writing config notes to $notes_pm\n");
File::Path::mkpath(File::Basename::dirname($notes_pm));
Module::Build::Notes->write_config_data
(
file => $notes_pm,
module => $module_name,
config_module => $notes_name,
config_data => scalar $self->config_data,
feature => scalar $self->{phash}{features}->access(),
auto_features => scalar $self->auto_features,
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
$pack->delete_filetree($build_dir) if -e $build_dir;
die "Must provide 'code' or 'class' option to subclass()\n"
unless $opts{code} or $opts{class};
$opts{code} ||= '';
$opts{class} ||= 'MyModuleBuilder';
my $filename = File::Spec->catfile($build_dir, 'lib', split '::', $opts{class}) . '.pm';
my $filedir = File::Basename::dirname($filename);
$pack->log_verbose("Creating custom builder $filename in $filedir\n");
File::Path::mkpath($filedir);
die "Can't create directory $filedir: $!" unless -d $filedir;
open(my $fh, '>', $filename) or die "Can't create $filename: $!";
print $fh <<EOF;
package $opts{class};
use $pack;
\@ISA = qw($pack);
$opts{code}
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
}
else {
my $mod_path = my $mod_name = $p->{dist_name};
$mod_name =~ s{-}{::}g;
$mod_path =~ s{-}{/}g;
$mod_path .= ".pm";
if ( -e $mod_path || -e "lib/$mod_path" ) {
$p->{module_name} = $mod_name;
}
else {
$self->log_warn( << 'END_WARN' );
No 'module_name' was provided and it could not be inferred
from other properties. This will prevent a packlist from
being written for this file. Please set either 'module_name'
or 'dist_version_from' in Build.PL.
END_WARN
}
}
}
sub dist_name {
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
my $self = shift;
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?!
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
my @len = map({length($_)} @str);
my $max = 0;
my $longest;
for my $i (0..$#len) {
($max, $longest) = ($len[$i], $str[$i]) if($len[$i] > $max);
}
return($longest);
};
my $max_name_len = length($longest->(keys %$features));
my ($num_disabled, $log_text) = (0, "\nChecking optional features...\n");
for my $name ( sort keys %$features ) {
$log_text .= $self->_feature_deps_msg($name, $max_name_len);
}
$num_disabled = () = $log_text =~ /disabled/g;
# warn user if features disabled
if ( $num_disabled ) {
$self->log_warn( $log_text );
return 0;
}
else {
$self->log_verbose( $log_text );
return 1;
}
}
sub _feature_deps_msg {
my ($self, $name, $max_name_len) = @_;
$max_name_len ||= length $name;
my $features = $self->auto_features;
my $info = $features->{$name};
my $feature_text = "$name" . '.' x ($max_name_len - length($name) + 4);
my ($log_text, $disabled) = ('','');
if ( my $failures = $self->prereq_failures($info) ) {
$disabled = grep( /^(?:\w+_)?(?:requires|conflicts)$/,
keys %$failures ) ? 1 : 0;
$feature_text .= $disabled ? "disabled\n" : "enabled\n";
for my $type ( @{ $self->prereq_action_types } ) {
next unless exists $failures->{$type};
$feature_text .= " $type:\n";
my $prereqs = $failures->{$type};
for my $module ( sort keys %$prereqs ) {
my $status = $prereqs->{$module};
my $required =
($type =~ /^(?:\w+_)?(?:requires|conflicts)$/) ? 1 : 0;
my $prefix = ($required) ? '!' : '*';
$feature_text .= " $prefix $status->{message}\n";
}
}
} else {
$feature_text .= "enabled\n";
}
$log_text .= $feature_text if $disabled || $self->verbose;
return $log_text;
}
# Automatically detect configure_requires prereqs
sub auto_config_requires {
my ($self) = @_;
my $p = $self->{properties};
# add current Module::Build to configure_requires if there
# isn't one already specified (but not ourself, so we're not circular)
if ( $self->dist_name ne 'Module-Build'
&& $self->auto_configure_requires
&& ! exists $p->{configure_requires}{'Module::Build'}
) {
(my $ver = $VERSION) =~ s/^(\d+\.\d\d).*$/$1/; # last major release only
$self->log_warn(<<EOM);
Module::Build was not found in configure_requires! Adding it now
automatically as: configure_requires => { 'Module::Build' => $ver }
EOM
$self->_add_prereq('configure_requires', 'Module::Build', $ver);
}
# if we're in author mode, add inc::latest modules to
# configure_requires if not already set. If we're not in author mode
# then configure_requires will have been satisfied, or we'll just
# live with what we've bundled
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
# If needs_compiler is not explicitly set, automatically set it
# If set, we need ExtUtils::CBuilder (and a compiler)
my $xs_files = $self->find_xs_files;
if ( ! defined $p->{needs_compiler} ) {
$self->needs_compiler( keys %$xs_files || defined $self->c_source );
}
if ($self->needs_compiler) {
$self->_add_prereq('build_requires', 'ExtUtils::CBuilder', 0);
if ( ! $self->have_c_compiler ) {
$self->log_warn(<<'EOM');
Warning: ExtUtils::CBuilder not installed or no compiler detected
Proceeding with configuration, but compilation may fail during Build
EOM
}
}
# If using share_dir, require File::ShareDir
if ( $self->share_dir ) {
$self->_add_prereq( 'requires', 'File::ShareDir', '1.00' );
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
return;
}
sub _add_prereq {
my ($self, $type, $module, $version) = @_;
my $p = $self->{properties};
$version = 0 unless defined $version;
if ( exists $p->{$type}{$module} ) {
return if $self->compare_versions( $version, '<=', $p->{$type}{$module} );
}
$self->log_verbose("Adding to $type\: $module => $version\n");
$p->{$type}{$module} = $version;
return 1;
}
sub prereq_failures {
my ($self, $info) = @_;
my @types = @{ $self->prereq_action_types };
$info ||= {map {$_, $self->$_()} @types};
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
return \%prereqs;
}
sub check_prereq {
my $self = shift;
# Check to see if there are any prereqs to check
my $info = $self->_enum_prereqs;
return 1 unless $info;
my $log_text = "Checking prerequisites...\n";
my $failures = $self->prereq_failures($info);
if ( $failures ) {
$self->log_warn($log_text);
for my $type ( @{ $self->prereq_action_types } ) {
my $prereqs = $failures->{$type};
$self->log_warn(" ${type}:\n") if keys %$prereqs;
for my $module ( sort keys %$prereqs ) {
my $status = $prereqs->{$module};
my $prefix = ($type =~ /^(?:\w+_)?recommends$/) ? "* " : "! ";
$self->log_warn(" $prefix $status->{message}\n");
}
}
return 0;
} else {
$self->log_verbose($log_text . "Looks good\n\n");
return 1;
}
}
sub perl_version {
my ($self) = @_;
# Check the current perl interpreter
# It's much more convenient to use $] here than $^V, but 'man
# perlvar' says I'm not supposed to. Bloody tyrant.
return $^V ? $self->perl_version_to_float(sprintf "%vd", $^V) : $];
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
sub create_mymeta {
my ($self) = @_;
my ($meta_obj, $mymeta);
my @metafiles = ( $self->metafile2, $self->metafile, );
my @mymetafiles = ( $self->mymetafile2, $self->mymetafile, );
# cleanup old MYMETA
for my $f ( @mymetafiles ) {
if ( $self->delete_filetree($f) ) {
$self->log_verbose("Removed previous '$f'\n");
}
}
# Try loading META.json or META.yml
if ( $self->try_require("CPAN::Meta", "2.142060") ) {
for my $file ( @metafiles ) {
next unless -f $file;
$meta_obj = eval { CPAN::Meta->load_file($file, { lazy_validation => 0 }) };
last if $meta_obj;
}
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
generated_by => "Module::Build version $Module::Build::VERSION",
);
$mymeta_obj = CPAN::Meta->new( \%updated, { lazy_validation => 0 } );
}
else {
$mymeta_obj = $self->_get_meta_object(quiet => 0, dynamic => 0, fatal => 1, auto => 0);
}
my @created = $self->_write_meta_files( $mymeta_obj, 'MYMETA' );
$self->log_warn("Could not create MYMETA files\n")
unless @created;
return 1;
}
sub create_build_script {
my ($self) = @_;
$self->write_config;
$self->create_mymeta;
# Create Build
my ($build_script, $dist_name, $dist_version)
= map $self->$_(), qw(build_script dist_name dist_version);
if ( $self->delete_filetree($build_script) ) {
$self->log_verbose("Removed previous script '$build_script'\n");
}
$self->log_info("Creating new '$build_script' script for ",
"'$dist_name' version '$dist_version'\n");
open(my $fh, '>', $build_script) or die "Can't create '$build_script': $!";
$self->print_build_script($fh);
close $fh;
$self->make_executable($build_script);
return 1;
}
sub check_manifest {
my $self = shift;
return unless -e 'MANIFEST';
# Stolen nearly verbatim from MakeMaker. But ExtUtils::Manifest
# could easily be re-written into a modern Perl dialect.
require ExtUtils::Manifest; # ExtUtils::Manifest is not warnings clean.
local ($^W, $ExtUtils::Manifest::Quiet) = (0,1);
$self->log_verbose("Checking whether your kit is complete...\n");
if (my @missed = ExtUtils::Manifest::manicheck()) {
$self->log_warn("WARNING: the following files are missing in your kit:\n",
"\t", join("\n\t", @missed), "\n",
"Please inform the author.\n\n");
} else {
$self->log_verbose("Looks good\n\n");
}
}
sub dispatch {
my $self = shift;
local $self->{_completed_actions} = {};
if (@_) {
my ($action, %p) = @_;
my $args = $p{args} ? delete($p{args}) : {};
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
}
sub _call_action {
my ($self, $action) = @_;
return if $self->{_completed_actions}{$action}++;
local $self->{action} = $action;
my $method = $self->can_action( $action );
die "No action '$action' defined, try running the 'help' action.\n" unless $method;
$self->log_debug("Starting ACTION_$action\n");
my $rc = $self->$method();
$self->log_debug("Finished ACTION_$action\n");
return $rc;
}
sub can_action {
my ($self, $action) = @_;
return $self->can( "ACTION_$action" );
}
# cuts the user-specified options out of the command-line args
sub cull_options {
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
my( $self, $action ) = @_;
return () unless $self->use_rcfile;
my $modulebuildrc;
if ( exists($ENV{MODULEBUILDRC}) && $ENV{MODULEBUILDRC} eq 'NONE' ) {
return ();
} elsif ( exists($ENV{MODULEBUILDRC}) && -e $ENV{MODULEBUILDRC} ) {
$modulebuildrc = $ENV{MODULEBUILDRC};
} elsif ( exists($ENV{MODULEBUILDRC}) ) {
$self->log_warn("WARNING: Can't find resource file " .
"'$ENV{MODULEBUILDRC}' defined in environment.\n" .
"No options loaded\n");
return ();
} else {
$modulebuildrc = $self->_find_user_config( '.modulebuildrc' );
return () unless $modulebuildrc;
}
open(my $fh, '<', $modulebuildrc )
or die "Can't open $modulebuildrc: $!";
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
unless (@docs) {
$@ = "Couldn't find any docs for action '$action'";
return;
}
return join '', @docs;
}
sub ACTION_prereq_report {
my $self = shift;
$self->log_info( $self->prereq_report );
}
sub ACTION_prereq_data {
my $self = shift;
$self->log_info( Module::Build::Dumper->_data_dump( $self->prereq_data ) );
}
sub prereq_data {
my $self = shift;
my @types = ('configure_requires', @{ $self->prereq_action_types } );
my $info = { map { $_ => $self->$_() } grep { %{$self->$_()} } @types };
return $info;
}
sub prereq_report {
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
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");
}
$self->run_visual_script;
}
sub run_tap_harness {
my ($self, $tests) = @_;
require TAP::Harness::Env;
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
my $method = "process_${element}_files";
$method = "process_files_by_extension" unless $self->can($method);
$self->$method($element);
}
$self->depends_on('config_data');
}
sub ACTION_build {
my $self = shift;
$self->log_info("Building " . $self->dist_name . "\n");
$self->depends_on('code');
$self->depends_on('docs');
}
sub process_files_by_extension {
my ($self, $ext) = @_;
my $method = "find_${ext}_files";
my $files = $self->can($method) ? $self->$method() : $self->_find_file_by_type($ext, 'lib');
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
for my $file (@files) {
open(my $FIXIN, '<', $file) or die "Can't process '$file': $!";
local $/ = "\n";
chomp(my $line = <$FIXIN>);
next unless $line =~ s/^\s*\#!\s*//; # Not a shebang file.
my ($cmd, $arg) = (split(' ', $line, 2), '');
next unless $cmd =~ /perl/i;
my $interpreter = $self->{properties}{perl};
$self->log_verbose("Changing sharpbang in $file to $interpreter\n");
my $shb = '';
$shb .= $c->get('sharpbang')."$interpreter $arg\n" if $does_shbang;
open(my $FIXOUT, '>', "$file.new")
or die "Can't create new $file: $!\n";
# Print out the new #! line (or equivalent).
local $\;
undef $/; # Was localized above
print $FIXOUT $shb, <$FIXIN>;
close $FIXIN;
close $FIXOUT;
rename($file, "$file.bak")
or die "Can't rename $file to $file.bak: $!";
rename("$file.new", $file)
or die "Can't rename $file.new to $file: $!";
$self->delete_filetree("$file.bak")
or $self->log_warn("Couldn't clean up $file.bak, leaving it there");
$self->do_system($c->get('eunicefix'), $file) if $c->get('eunicefix') ne ':';
}
}
sub ACTION_testpod {
my $self = shift;
$self->depends_on('docs');
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
require Pod::Man;
foreach my $file (sort keys %$files) {
# Pod::Simple based parsers only support one document per instance.
# This is expected to change in a future version (Pod::Simple > 3.03).
my $parser = Pod::Man->new( %podman_args );
my $manpage = $self->man1page_name( $file ) . '.' .
$self->config( 'man1ext' );
my $outfile = File::Spec->catfile($mandir, $manpage);
next if $self->up_to_date( $file, $outfile );
$self->log_verbose("Manifying $file -> $outfile\n");
eval { $parser->parse_from_file( $file, $outfile ); 1 }
or $self->log_warn("Error creating '$outfile': $@\n");
$files->{$file} = $outfile;
}
}
sub manify_lib_pods {
my $self = shift;
my %podman_args = (section => 3, @_); # libraries go in section 3
my $files = $self->_find_pods($self->{properties}{libdoc_dirs});
return unless keys %$files;
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
require Pod::Man;
foreach my $file (sort keys %$files) {
# Pod::Simple based parsers only support one document per instance.
# This is expected to change in a future version (Pod::Simple > 3.03).
my $parser = Pod::Man->new( %podman_args );
my $manpage = $self->man3page_name( $files->{$file} ) . '.' .
$self->config( 'man3ext' );
my $outfile = File::Spec->catfile( $mandir, $manpage);
next if $self->up_to_date( $file, $outfile );
$self->log_verbose("Manifying $file -> $outfile\n");
eval { $parser->parse_from_file( $file, $outfile ); 1 }
or $self->log_warn("Error creating '$outfile': $@\n");
$files->{$file} = $outfile;
}
}
sub _find_pods {
my ($self, $dirs, %args) = @_;
my %files;
foreach my $spec (@$dirs) {
my $dir = $self->localize_dir_path($spec);
next unless -e $dir;
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
) {
my $tool_v = ActiveState::DocTools::Pod->VERSION;
$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 ) );
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
my $outfile = File::Spec->catfile($fulldir, "${name}.html");
my $infile = File::Spec->abs2rel($pod);
next if $self->up_to_date($infile, $outfile);
unless ( -d $fulldir ){
File::Path::mkpath($fulldir, 0, oct(755))
or die "Couldn't mkdir $fulldir: $!";
}
$self->log_verbose("HTMLifying $infile -> $outfile\n");
if ( $with_ActiveState ) {
my $depth = @rootdirs + @dirs;
my %opts = ( infile => $infile,
outfile => $tmpfile,
( defined($podpath) ? (podpath => $podpath) : ()),
podroot => $podroot,
index => 1,
depth => $depth,
);
eval {
ActivePerl::DocTools::Pod::pod2html(map { ($_, $opts{$_}) } sort keys %opts);
1;
} or $self->log_warn("[$htmltool] pod2html (" .
join(", ", map { "q{$_} => q{$opts{$_}}" } (sort keys %opts)) . ") failed: $@");
} else {
my $path2root = File::Spec->catdir((File::Spec->updir) x @dirs);
open(my $fh, '<', $infile) or die "Can't read $infile: $!";
my $abstract = Module::Build::PodParser->new(fh => $fh)->get_abstract();
my $title = join( '::', (@dirs, $name) );
$title .= " - $abstract" if $abstract;
my @opts = (
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
unless ( eval{Pod::Html->VERSION(1.12)} ) {
push( @opts, ('--flush') ); # caching removed in 1.12
}
if ( eval{Pod::Html->VERSION(1.12)} ) {
push( @opts, ('--header', '--backlink') );
} elsif ( eval{Pod::Html->VERSION(1.03)} ) {
push( @opts, ('--header', '--backlink=Back to Top') );
}
$self->log_verbose("P::H::pod2html @opts\n");
{
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: $!";
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
$self->depends_on('build');
# RT#63003 suggest that odd circumstances that we might wind up
# in a different directory than we started, so wrap with _do_in_dir to
# ensure we get back to where we started; hope this fixes it!
$self->_do_in_dir( ".", sub {
ExtUtils::Install::install(
$self->install_map, $self->verbose, 0, $self->{args}{uninst}||0
);
});
if ($self->_is_ActivePerl && $self->{_completed_actions}{html}) {
$self->log_info("Building ActivePerl Table of Contents\n");
eval { ActivePerl::DocTools::WriteTOC(verbose => $self->verbose ? 1 : 0); 1; }
or $self->log_warn("AP::DT:: WriteTOC() failed: $@");
}
if ($self->_is_ActivePPM) {
# We touch 'lib/perllocal.pod'. There is an existing logic in subroutine _init_db()
# of 'ActivePerl/PPM/InstallArea.pm' that says that if 'lib/perllocal.pod' has a 'date-last-touched'
# greater than that of the PPM SQLite databases ('etc/ppm-perl-area.db' and/or
# 'site/etc/ppm-site-area.db') then the PPM SQLite databases are rebuilt from scratch.
# in the following line, 'perllocal.pod' this is *always* 'lib/perllocal.pod', never 'site/lib/perllocal.pod'
my $F_perllocal = File::Spec->catfile($self->install_sets('core', 'lib'), 'perllocal.pod');
my $dt_stamp = time;
$self->log_info("For ActivePerl's PPM: touch '$F_perllocal'\n");
open my $perllocal, ">>", $F_perllocal;
close $perllocal;
utime($dt_stamp, $dt_stamp, $F_perllocal);
}
}
sub ACTION_fakeinstall {
my ($self) = @_;
require ExtUtils::Install;
my $eui_version = ExtUtils::Install->VERSION;
if ( $eui_version < 1.32 ) {
$self->log_warn(
"The 'fakeinstall' action requires Extutils::Install 1.32 or later.\n"
. "(You only have version $eui_version)."
);
return;
}
$self->depends_on('build');
ExtUtils::Install::install($self->install_map, !$self->quiet, 1, $self->{args}{uninst}||0);
}
sub ACTION_versioninstall {
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
only::install::install(%onlyargs);
}
sub ACTION_installdeps {
my ($self) = @_;
# XXX include feature prerequisites as optional prereqs?
my $info = $self->_enum_prereqs;
if (! $info ) {
$self->log_info( "No prerequisites detected\n" );
return;
}
my $failures = $self->prereq_failures($info);
if ( ! $failures ) {
$self->log_info( "All prerequisites satisfied\n" );
return;
}
my @install;
foreach my $type (sort keys %$failures) {
my $prereqs = $failures->{$type};
if($type =~ m/^(?:\w+_)?requires$/) {
push(@install, sort keys %$prereqs);
next;
}
$self->log_info("Checking optional dependencies:\n");
foreach my $module (sort keys %$prereqs) {
push(@install, $module) if($self->y_n("Install $module?", 'y'));
}
}
return unless @install;
my ($command, @opts) = $self->split_like_shell($self->cpan_client);
# relative command should be relative to our active Perl
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
last;
}
}
}
$self->do_system($command, @opts, @install);
}
sub ACTION_clean {
my ($self) = @_;
$self->log_info("Cleaning up build files\n");
foreach my $item (map glob($_), $self->cleanup) {
$self->delete_filetree($item);
}
}
sub ACTION_realclean {
my ($self) = @_;
$self->depends_on('clean');
$self->log_info("Cleaning up configuration files\n");
$self->delete_filetree(
$self->config_dir, $self->mymetafile, $self->mymetafile2, $self->build_script
);
}
sub ACTION_ppd {
my ($self) = @_;
require Module::Build::PPMMaker;
my $ppd = Module::Build::PPMMaker->new();
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
$self->add_to_cleanup($file);
}
sub ACTION_ppmdist {
my ($self) = @_;
$self->depends_on( 'build' );
my $ppm = $self->ppm_name;
$self->delete_filetree( $ppm );
$self->log_info( "Creating $ppm\n" );
$self->add_to_cleanup( $ppm, "$ppm.tar.gz" );
my %types = ( # translate types/dirs to those expected by ppm
lib => 'lib',
arch => 'arch',
bin => 'bin',
script => 'script',
bindoc => 'man1',
libdoc => 'man3',
binhtml => undef,
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
$self->depends_on( 'ppd' );
$self->delete_filetree( $ppm );
}
sub ACTION_pardist {
my ($self) = @_;
# Need PAR::Dist
if ( not eval { require PAR::Dist; PAR::Dist->VERSION(0.17) } ) {
$self->log_warn(
"In order to create .par distributions, you need to\n"
. "install PAR::Dist first."
);
return();
}
$self->depends_on( 'build' );
return PAR::Dist::blib_to_par(
name => $self->dist_name,
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
local $^W; # ExtUtils::Manifest is not warnings clean.
# older ExtUtils::Manifest had a private _maniskip
my $skip_factory = ExtUtils::Manifest->can('maniskip')
|| ExtUtils::Manifest->can('_maniskip');
my $mymetafile = $self->mymetafile;
# we can't check it, just add it anyway to be safe
for my $file ( $self->mymetafile, $self->mymetafile2 ) {
unless ( $skip_factory && $skip_factory->($maniskip)->($file) ) {
$self->log_warn("File '$maniskip' does not include '$file'. Adding it now.\n");
my $safe = quotemeta($file);
$self->_append_maniskip("^$safe\$", $maniskip);
}
}
}
sub _add_to_manifest {
my ($self, $manifest, $lines) = @_;
$lines = [$lines] unless ref $lines;
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
my $last_line = (<$fh>)[-1] || "\n";
my $has_newline = $last_line =~ /\n$/;
close $fh;
open($fh, '>>', $manifest) or die "Can't write to $manifest: $!";
print $fh "\n" unless $has_newline;
print $fh map "$_\n", @$lines;
close $fh;
chmod($mode, $manifest);
$self->log_verbose(map "Added to $manifest: $_\n", @$lines);
}
sub _sign_dir {
my ($self, $dir) = @_;
unless (eval { require Module::Signature; 1 }) {
$self->log_warn("Couldn't load Module::Signature for 'distsign' action:\n $@\n");
return;
}
# Add SIGNATURE to the MANIFEST
{
my $manifest = File::Spec->catfile($dir, 'MANIFEST');
die "Signing a distribution requires a MANIFEST file" unless -e $manifest;
$self->_add_to_manifest($manifest, "SIGNATURE Added here by Module::Build");
}
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
sub ACTION_distclean {
my ($self) = @_;
$self->depends_on('realclean');
$self->depends_on('distcheck');
}
sub do_create_makefile_pl {
my $self = shift;
require Module::Build::Compat;
$self->log_info("Creating Makefile.PL\n");
eval { Module::Build::Compat->create_makefile_pl($self->create_makefile_pl, $self, @_) };
if ( $@ ) {
1 while unlink 'Makefile.PL';
die "$@\n";
}
$self->_add_to_manifest('MANIFEST', 'Makefile.PL');
}
sub do_create_license {
my $self = shift;
$self->log_info("Creating LICENSE file\n");
if ( ! $self->_mb_feature('license_creation') ) {
$self->_warn_mb_feature_deps('license_creation');
die "Aborting.\n";
}
my $l = $self->license
or die "Can't create LICENSE file: No license specified\n";
my $license = $self->_software_license_object
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
$self->_add_to_manifest('MANIFEST', 'LICENSE');
}
sub do_create_readme {
my $self = shift;
$self->delete_filetree('README');
my $docfile = $self->_main_docfile;
unless ( $docfile ) {
$self->log_warn(<<EOF);
Cannot create README: can't determine which file contains documentation;
Must supply either 'dist_version_from', or 'module_name' parameter.
EOF
return;
}
# work around some odd Pod::Readme->new() failures in test reports by
# confirming that new() is available
if ( eval {require Pod::Readme; Pod::Readme->can('new') } ) {
$self->log_info("Creating README using Pod::Readme\n");
my $parser = Pod::Readme->new;
$parser->parse_from_file($docfile, 'README', @_);
} elsif ( eval {require Pod::Text; 1} ) {
$self->log_info("Creating README using Pod::Text\n");
if ( open(my $fh, '>', 'README') ) {
local $^W = 0;
no strict "refs";
# work around bug in Pod::Text 3.01, which expects
# Pod::Simple::parse_file to take input and output filehandles
# when it actually only takes an input filehandle
my $old_parse_file;
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
$self->output_fh($_[1]) if $_[1];
$self->$old_parse_file($_[0]);
}
if $Pod::Text::VERSION
== 3.01; # Split line to avoid evil version-finder
Pod::Text::pod2text( $docfile, $fh );
close $fh;
} else {
$self->log_warn(
"Cannot create 'README' file: Can't open file for writing\n" );
return;
}
} else {
$self->log_warn("Can't load Pod::Readme or Pod::Text to create README\n");
return;
}
$self->_add_to_manifest('MANIFEST', 'README');
}
sub _main_docfile {
my $self = shift;
if ( my $pm_file = $self->dist_version_from ) {
(my $pod_file = $pm_file) =~ s/.pm$/.pod/;
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
}
$self->depends_on('distmeta');
my $dist_files = $self->_read_manifest('MANIFEST')
or die "Can't create distdir without a MANIFEST file - run 'manifest' action first.\n";
delete $dist_files->{SIGNATURE}; # Don't copy, create a fresh one
die "No files found in MANIFEST - try running 'manifest' action?\n"
unless ($dist_files and keys %$dist_files);
my $metafile = $self->metafile;
$self->log_warn("*** Did you forget to add $metafile to the MANIFEST?\n")
unless exists $dist_files->{$metafile};
my $dist_dir = $self->dist_dir;
$self->delete_filetree($dist_dir);
$self->log_info("Creating $dist_dir\n");
$self->add_to_cleanup($dist_dir);
foreach my $file (sort keys %$dist_files) {
next if $file =~ m{^MYMETA\.}; # Double check that we skip MYMETA.*
my $new = $self->copy_if_modified(from => $file, to_dir => $dist_dir, verbose => 0);
}
$self->do_create_bundle_inc if @{$self->bundle_inc};
$self->_sign_dir($dist_dir) if $self->{properties}{sign};
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
return;
}
sub _check_manifest_skip {
my ($self) = @_;
my $maniskip = 'MANIFEST.SKIP';
if ( ! -e $maniskip ) {
$self->log_warn("File '$maniskip' does not exist: Creating a temporary '$maniskip'\n");
$self->_write_default_maniskip($maniskip);
$self->_unlink_on_exit($maniskip);
}
else {
# MYMETA must not be added to MANIFEST, so always confirm the skip
$self->_check_mymeta_skip( $maniskip );
}
return;
}
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
require ExtUtils::Manifest; # ExtUtils::Manifest is not warnings clean.
local ($^W, $ExtUtils::Manifest::Quiet) = (0,1);
ExtUtils::Manifest::mkmanifest();
}
sub ACTION_manifest_skip {
my ($self) = @_;
if ( -e 'MANIFEST.SKIP' ) {
$self->log_warn("MANIFEST.SKIP already exists.\n");
return 0;
}
$self->log_info("Creating a new MANIFEST.SKIP file\n");
return $self->_write_default_maniskip;
return -e 'MANIFEST.SKIP'
}
# Case insensitive regex for files
sub file_qr {
return shift->{_case_tolerant} ? qr($_[0])i : qr($_[0]);
}
sub dist_dir {
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
sub _software_license_object {
my ($self) = @_;
return unless defined( my $license = $self->license );
my $class = $self->_software_license_class($license) or return;
# Software::License requires a 'holder' argument
my $author = join( " & ", @{ $self->dist_author }) || 'unknown';
my $sl = eval { $class->new({holder=>$author}) };
if ( $@ ) {
$self->log_warn( "Error getting '$class' object: $@" );
}
return $sl;
}
sub _hash_merge {
my ($self, $h, $k, $v) = @_;
if (ref $h->{$k} eq 'ARRAY') {
push @{$h->{$k}}, ref $v ? @$v : $v;
} elsif (ref $h->{$k} eq 'HASH') {
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
$self->do_create_metafile;
}
sub do_create_metafile {
my $self = shift;
return if $self->{wrote_metadata};
my $p = $self->{properties};
unless ($p->{license}) {
$self->log_warn("No license specified, setting license = 'unknown'\n");
$p->{license} = 'unknown';
}
my @metafiles = ( $self->metafile, $self->metafile2 );
# If we're in the distdir, the metafile may exist and be non-writable.
$self->delete_filetree($_) for @metafiles;
# Since we're building ourself, we have to do some special stuff
# here: the ConfigData module is found in blib/lib.
local @INC = @INC;
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
my ($meta, $file) = @_;
$file =~ s{\.(?:yml|json)$}{};
my @created;
push @created, "$file\.yml"
if $meta && $meta->save( "$file\.yml", {version => "1.4"} );
push @created, "$file\.json"
if $meta && $meta->save( "$file\.json" );
if ( @created ) {
$self->log_info("Created " . join(" and ", @created) . "\n");
}
return @created;
}
sub _get_meta_object {
my $self = shift;
my %args = @_;
return unless $self->try_require("CPAN::Meta", "2.142060");
my $meta;
eval {
my $data = $self->get_metadata(
fatal => $args{fatal},
auto => $args{auto},
);
$data->{dynamic_config} = $args{dynamic} if defined $args{dynamic};
$meta = CPAN::Meta->create($data);
};
if ($@ && ! $args{quiet}) {
$self->log_warn(
"Could not get valid metadata. Error is: $@\n"
);
}
return $meta;
}
sub read_metafile {
my $self = shift;
my ($metafile) = @_;
return unless $self->try_require("CPAN::Meta", "2.110420");
my $meta = CPAN::Meta->load_file($metafile);
return $meta->as_struct( {version => "2.0"} );
}
sub normalize_version {
my ($self, $version) = @_;
$version = 0 unless defined $version and length $version;
if ( $version =~ /[=<>!,]/ ) { # logic, not just version
# take as is without modification
}
elsif ( ref $version eq 'version') { # version objects
$version = $version->is_qv ? $version->normal : $version->stringify;
}
elsif ( $version =~ /^[^v][^.]*\.[^.]+\./ ) { # no leading v, multiple dots
# normalize string tuples without "v": "1.2.3" -> "v1.2.3"
$version = "v$version";
}
else {
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
my $valid_licenses = $self->valid_licenses();
if ( my $sl = $self->_software_license_object ) {
$meta_license = $sl->meta2_name;
$meta_license_url = $sl->url;
}
elsif ( exists $valid_licenses->{$license} ) {
$meta_license = $valid_licenses->{$license} ? lc $valid_licenses->{$license} : $license;
$meta_license_url = $self->_license_url( $license );
}
else {
$self->log_warn( "Can not determine license type for '" . $self->license
. "'\nSetting META license field to 'unknown'.\n");
$meta_license = 'unknown';
}
return ($meta_license, $meta_license_url);
}
sub get_metadata {
my ($self, %args) = @_;
my $fatal = $args{fatal} || 0;
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
# validate required fields
foreach my $f (qw(dist_name dist_version dist_author dist_abstract license)) {
my $field = $self->$f();
unless ( defined $field and length $field ) {
my $err = "ERROR: Missing required field '$f' for metafile\n";
if ( $fatal ) {
die $err;
}
else {
$self->log_warn($err);
}
}
}
my %metadata = (
name => $self->dist_name,
version => $self->normalize_version($self->dist_version),
author => $self->dist_author,
abstract => $self->dist_abstract,
generated_by => "Module::Build version $Module::Build::VERSION",
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
$metadata{license} = [ $meta_license ];
$metadata{resources}{license} = [ $meta_license_url ] if defined $meta_license_url;
$metadata{prereqs} = $self->_normalize_prereqs;
if (exists $p->{no_index}) {
$metadata{no_index} = $p->{no_index};
} elsif (my $pkgs = eval { $self->find_dist_packages }) {
$metadata{provides} = $pkgs if %$pkgs;
} else {
$self->log_warn("$@\nWARNING: Possible missing or corrupt 'MANIFEST' file.\n" .
"Nothing to enter for 'provides' field in metafile.\n");
}
if (my $add = $self->meta_add) {
if (not exists $add->{'meta-spec'} or $add->{'meta-spec'}{version} != 2) {
require CPAN::Meta::Converter;
if (CPAN::Meta::Converter->VERSION('2.141170')) {
$add = CPAN::Meta::Converter->new($add)->upgrade_fragment;
delete $add->{prereqs}; # XXX this would now overwrite all prereqs
}
else {
$self->log_warn("Can't meta_add without CPAN::Meta 2.141170");
}
}
while (my($k, $v) = each %{$add}) {
$metadata{$k} = $v;
}
}
if (my $merge = $self->meta_merge) {
if (eval { require CPAN::Meta::Merge }) {
%metadata = %{ CPAN::Meta::Merge->new(default_version => '1.4')->merge(\%metadata, $merge) };
}
else {
$self->log_warn("Can't merge without CPAN::Meta::Merge");
}
}
return \%metadata;
}
# To preserve compatibility with old API, $node *must* be a hashref
# passed in to prepare_metadata. $keys is an arrayref holding a
# list of keys -- it's use is optional and generally no longer needed
# but kept for back compatibility. $args is an optional parameter to
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
# 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
if ( exists( $prime{$package}{version} ) &&
defined( $prime{$package}{version} ) ) {
# Unless the version of the primary package agrees with the
# version of the alternative package, report a conflict
if ( $self->compare_versions( $prime{$package}{version}, '!=',
$result->{version} ) ) {
$self->log_warn(
"Found conflicting versions for package '$package'\n" .
" $prime{$package}{file} ($prime{$package}{version})\n" .
" $result->{file} ($result->{version})\n"
);
}
} else {
# The prime package selected has no version so, we choose to
# use any alternative package that does have a version
$prime{$package}{file} = $result->{file};
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
}
} else {
# no alt package found with a version, but we have a prime
# package so we use it whether it has a version or not
}
} else { # No primary package was selected, use the best alternative
if ( $result->{err} ) {
$self->log_warn(
"Found conflicting versions for package '$package'\n" .
$result->{err}
);
}
# Despite possible conflicting versions, we choose to record
# something rather than nothing
$prime{$package}{file} = $result->{file};
$prime{$package}{version} = $result->{version}
if defined( $result->{version} );
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
$provides->{version} = $self->normalize_version( $provides->{version} )
}
else {
delete $provides->{version};
}
}
return \%prime;
}
# separate out some of the conflict resolution logic from
# $self->find_dist_packages(), above, into a helper function.
#
sub _resolve_module_versions {
my $self = shift;
my $packages = shift;
my( $file, $version );
my $err = '';
foreach my $p ( @$packages ) {
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
err => $err
);
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";
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
);
}
# Translated from ExtUtils::MM_Unix::prefixify()
sub _prefixify {
my($self, $path, $sprefix, $type) = @_;
my $rprefix = $self->prefix;
$rprefix .= '/' if $sprefix =~ m|/$|;
$self->log_verbose(" prefixify $path from $sprefix to $rprefix\n")
if defined( $path ) && length( $path );
if( !defined( $path ) || ( length( $path ) == 0 ) ) {
$self->log_verbose(" no path to prefixify, falling back to default.\n");
return $self->_prefixify_default( $type, $rprefix );
} elsif( !File::Spec->file_name_is_absolute($path) ) {
$self->log_verbose(" path is relative, not prefixifying.\n");
} elsif( $path !~ s{^\Q$sprefix\E\b}{}s ) {
$self->log_verbose(" cannot prefixify, falling back to default.\n");
return $self->_prefixify_default( $type, $rprefix );
}
$self->log_verbose(" now $path in $rprefix\n");
return $path;
}
sub _prefixify_default {
my $self = shift;
my $type = shift;
my $rprefix = shift;
my $default = $self->prefix_relpaths($self->installdirs, $type);
if( !$default ) {
$self->log_verbose(" no default install location for type '$type', using prefix '$rprefix'.\n");
return $rprefix;
} else {
return $default;
}
}
sub install_destination {
my ($self, $type) = @_;
return $self->install_path($type) if $self->install_path($type);
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
# ********* next if (($type eq 'bindoc' || $type eq 'libdoc') && not $self->is_unixish);
if (my $dest = $self->install_destination($type)) {
$map{$localdir} = $dest;
} else {
push( @skipping, $type );
}
}
$self->log_warn(
"WARNING: Can't figure out install path for types: @skipping\n" .
"Files will not be installed.\n"
) if @skipping;
# Write the packlist into the same place as ExtUtils::MakeMaker.
if ($self->create_packlist and my $module_name = $self->module_name) {
my $archdir = $self->install_destination('arch');
my @ext = split /::/, $module_name;
$map{write} = File::Spec->catfile($archdir, 'auto', @ext, '.packlist');
}
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
File::Find::find({wanted => $subr, no_chdir => 1, preprocess => sub { sort @_ } }, $dir);
return \@result;
}
sub delete_filetree {
my $self = shift;
my $deleted = 0;
foreach (@_) {
next unless -e $_;
$self->log_verbose("Deleting $_\n");
File::Path::rmtree($_, 0, 0);
die "Couldn't remove '$_': $!\n" if -e $_;
$deleted++;
}
return $deleted;
}
sub autosplit_file {
my ($self, $file, $to) = @_;
require AutoSplit;
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
($self->quiet ? (quiet => 1 ) : ()),
);
}
sub have_c_compiler {
my ($self) = @_;
my $p = $self->{properties};
return $p->{_have_c_compiler} if defined $p->{_have_c_compiler};
$self->log_verbose("Checking if compiler tools configured... ");
my $b = $self->cbuilder;
my $have = $b && eval { $b->have_compiler };
$self->log_verbose($have ? "ok.\n" : "failed.\n");
return $p->{_have_c_compiler} = $have;
}
sub compile_c {
my ($self, $file, %args) = @_;
if ( ! $self->have_c_compiler ) {
die "Error: no compiler detected to compile '$file'. Aborting\n";
}
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
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}) {
ExtUtils::ParseXS::process_file(
filename => $file,
prototypes => 0,
output => $args{outfile},
);
} else {
# Ok, I give up. Just use backticks.
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
);
push @typemaps, $lib_typemap if $lib_typemap;
@typemaps = map {+'-typemap', $_} @typemaps;
my $cf = $self->{config};
my $perl = $self->{properties}{perl};
my @command = ($perl, "-I".$cf->get('installarchlib'), "-I".$cf->get('installprivlib'), $xsubpp, '-noprototypes',
@typemaps, $file);
$self->log_info("@command\n");
open(my $fh, '>', $args{outfile}) or die "Couldn't write $args{outfile}: $!";
print {$fh} $self->_backticks(@command);
close $fh;
}
}
sub split_like_shell {
my ($self, $string) = @_;
return () unless defined($string);
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
$self->compile_c($spec->{c_file},
defines => {VERSION => qq{"$v"}, XS_VERSION => qq{"$v"}});
# archdir
File::Path::mkpath($spec->{archdir}, 0, oct(777)) unless -d $spec->{archdir};
# .xs -> .bs
$self->add_to_cleanup($spec->{bs_file});
unless ($self->up_to_date($file, $spec->{bs_file})) {
require ExtUtils::Mkbootstrap;
$self->log_info("ExtUtils::Mkbootstrap::Mkbootstrap('$spec->{bs_file}')\n");
ExtUtils::Mkbootstrap::Mkbootstrap($spec->{bs_file}); # Original had $BSLOADLIBS - what's that?
open(my $fh, '>>', $spec->{bs_file}); # create
utime((time)x2, $spec->{bs_file}); # touch
}
# .o -> .(a|bundle)
$self->link_c($spec);
}
sub do_system {
my ($self, @cmd) = @_;
$self->log_verbose("@cmd\n");
# Some systems proliferate huge PERL5LIBs, try to ameliorate:
my %seen;
my $sep = $self->config('path_sep');
local $ENV{PERL5LIB} =
( !exists($ENV{PERL5LIB}) ? '' :
length($ENV{PERL5LIB}) < 500
? $ENV{PERL5LIB}
: join $sep, grep { ! $seen{$_}++ and -d $_ } split($sep, $ENV{PERL5LIB})
);
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
return if $self->up_to_date($file, $to_path); # Already fresh
{
local $self->{properties}{quiet} = 1;
$self->delete_filetree($to_path); # delete destination if exists
}
# Create parent directories
File::Path::mkpath(File::Basename::dirname($to_path), 0, oct(777));
$self->log_verbose("Copying $file -> $to_path\n");
if ($^O eq 'os2') {# copy will not overwrite; 0x1 = overwrite
chmod 0666, $to_path;
File::Copy::syscopy($file, $to_path, 0x1) or die "Can't copy('$file', '$to_path'): $!";
} else {
File::Copy::copy($file, $to_path) or die "Can't copy('$file', '$to_path'): $!";
}
# mode is read-only + (executable if source is executable)
my $mode = oct(444) | ( $self->is_executable($file) ? oct(111) : 0 );
local/lib/perl5/Module/Build/Base.pm view on Meta::CPAN
my ($self, $source, $derived) = @_;
$source = [$source] unless ref $source;
$derived = [$derived] unless ref $derived;
# empty $derived means $source should always run
return 0 if @$source && !@$derived || grep {not -e} @$derived;
my $most_recent_source = time / (24*60*60);
foreach my $file (@$source) {
unless (-e $file) {
$self->log_warn("Can't find source file $file for up-to-date check");
next;
}
$most_recent_source = -M _ if -M _ < $most_recent_source;
}
foreach my $derived (@$derived) {
return 0 if -M $derived > $most_recent_source;
}
return 1;
}
local/lib/perl5/Module/Build/Compat.pm view on Meta::CPAN
}
sub create_makefile_pl {
my ($package, $type, $build, %args) = @_;
die "Don't know how to build Makefile.PL of type '$type'"
unless $type =~ /^(small|passthrough|traditional)$/;
if ($type eq 'passthrough') {
$build->log_warn(<<"HERE");
IMPORTANT NOTE: The '$type' style of Makefile.PL is deprecated and
may be removed in a future version of Module::Build in favor of the
'configure_requires' property. See Module::Build::Compat
documentation for details.
HERE
}
my $fh;
local/lib/perl5/Module/Build/Cookbook.pm view on Meta::CPAN
my $self = shift;
$self->depends_on("test");
$self->do_system(qw(svn commit));
}
SUBCLASS
=head2 Bundling Module::Build
Note: This section probably needs an update as the technology improves
(see contrib/bundle.pl in the distribution).
Suppose you want to use some new-ish features of Module::Build,
e.g. newer than the version of Module::Build your users are likely to
already have installed on their systems. The first thing you should
do is set C<configure_requires> to your minimum version of
Module::Build. See L<Module::Build::Authoring>.
But not every build system honors C<configure_requires> yet. Here's
how you can ship a copy of Module::Build, but still use a newer
local/lib/perl5/Module/Build/Platform/MacOS.pm view on Meta::CPAN
there. So we copy the install variables to the other location
=item make_executable()
On MacOS we set the file type and creator to MacPerl so it will run
with a double-click.
=item dispatch()
Because there's no easy way to say "./Build test" on MacOS, if
dispatch is called with no arguments and no @ARGV a dialog box will
pop up asking what action to take and any extra arguments.
Default action is "test".
=item ACTION_realclean()
Need to unlock the Build program before deleting.
=back
local/lib/perl5/Module/Build/Platform/VMS.pm view on Meta::CPAN
}
}
sub _prefixify {
my($self, $path, $sprefix, $type) = @_;
my $rprefix = $self->prefix;
return '' unless defined $path;
$self->log_verbose(" prefixify $path from $sprefix to $rprefix\n");
# Translate $(PERLPREFIX) to a real path.
$rprefix = VMS::Filespec::vmspath($rprefix) if $rprefix;
$sprefix = VMS::Filespec::vmspath($sprefix) if $sprefix;
$self->log_verbose(" rprefix translated to $rprefix\n".
" sprefix translated to $sprefix\n");
if( length($path) == 0 ) {
$self->log_verbose(" no path to prefixify.\n")
}
elsif( !File::Spec->file_name_is_absolute($path) ) {
$self->log_verbose(" path is relative, not prefixifying.\n");
}
elsif( $sprefix eq $rprefix ) {
$self->log_verbose(" no new prefix.\n");
}
else {
my($path_vol, $path_dirs) = File::Spec->splitpath( $path );
my $vms_prefix = $self->config('vms_prefix');
if( $path_vol eq $vms_prefix.':' ) {
$self->log_verbose(" $vms_prefix: seen\n");
$path_dirs =~ s{^\[}{\[.} unless $path_dirs =~ m{^\[\.};
$path = $self->_catprefix($rprefix, $path_dirs);
}
else {
$self->log_verbose(" cannot prefixify.\n");
return $self->prefix_relpaths($self->installdirs, $type);
}
}
$self->log_verbose(" now $path\n");
return $path;
}
=item _quote_args
Command-line arguments (but not the command itself) must be quoted
to ensure case preservation.
=cut
local/lib/perl5/Module/Build/Platform/VMS.pm view on Meta::CPAN
=item do_system
Override to ensure that we quote the arguments but not the command.
=cut
sub do_system {
# The command must not be quoted but the arguments to it must be.
my ($self, @cmd) = @_;
$self->log_verbose("@cmd\n");
my $cmd = shift @cmd;
my $args = $self->_quote_args(@cmd);
return !system("$cmd $args");
}
=item oneliner
Override to ensure that we do not quote the command.
=cut
local/lib/perl5/Module/Build/Platform/VMS.pm view on Meta::CPAN
# Remove the tilde
$spec =~ s/^~//;
# Remove any slash following the tilde if present.
$spec =~ s#^/##;
# break up the paths for the merge
my $home = VMS::Filespec::unixify($ENV{HOME});
# In the default VMS mode, the trailing slash is present.
# In Unix report mode it is not. The parsing logic assumes that
# it is present.
$home .= '/' unless $home =~ m#/$#;
# Trivial case of just ~ by it self
if ($spec eq '') {
$home =~ s#/$##;
return $home;
}
my ($hvol, $hdir, $hfile) = File::Spec::Unix->splitpath($home);
local/lib/perl5/Module/Build/Platform/VMS.pm view on Meta::CPAN
$arg = File::Spec::Unix->catpath($hvol, $newdirs, $file);
}
return $arg;
}
=item find_perl_interpreter
On VMS, $^X returns the fully qualified absolute path including version
number. It's logically impossible to improve on it for getting the perl
we're currently running, and attempting to manipulate it is usually
lossy.
=cut
sub find_perl_interpreter {
return VMS::Filespec::vmsify($^X);
}
=item localize_file_path
local/lib/perl5/Module/Build/Platform/Windows.pm view on Meta::CPAN
sub ACTION_realclean {
my ($self) = @_;
$self->SUPER::ACTION_realclean();
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")
local/lib/perl5/Module/Build/Platform/Windows.pm view on Meta::CPAN
# Perl script that needs to be wrapped in a batch script
} else {
my %opts = ();
if ( $script eq $self->build_script ) {
$opts{ntargs} = q(-x -S %0 --build_bat %*);
$opts{otherargs} = q(-x -S "%0" --build_bat %1 %2 %3 %4 %5 %6 %7 %8 %9);
}
my $out = eval {$self->pl2bat(in => $script, update => 1, %opts)};
if ( $@ ) {
$self->log_warn("WARNING: Unable to convert file '$script' to an executable script:\n$@");
} else {
$self->SUPER::make_executable($out);
}
}
}
}
# This routine was copied almost verbatim from the 'pl2bat' utility
# distributed with perl. It requires too much voodoo with shell quoting
# differences and shortcomings between the various flavors of Windows
local/lib/perl5/Sub/Uplevel.pm view on Meta::CPAN
#pod winds up no or above uplevel(), it's CORE::caller(X+1+uplevel+1).
#pod
#pod Which means I'm probably going to have to do something nasty like walk
#pod up the call stack on each caller() to see if I'm going to wind up
#pod before or after Sub::Uplevel::uplevel().
#pod
#pod =end _private
#pod
#pod =begin _dagolden
#pod
#pod I found the description above a bit confusing. Instead, this is the logic
#pod that I found clearer when CORE::GLOBAL::caller is invoked and we have to
#pod walk up the call stack:
#pod
#pod * if searching up to the requested height in the real call stack doesn't find
#pod a call to uplevel, then we can return the result at that height in the
#pod call stack
#pod
#pod * if we find a call to uplevel, we need to keep searching upwards beyond the
#pod requested height at least by the amount of upleveling requested for that
#pod call to uplevel (from the Up_Frames stack set during the uplevel call)
local/lib/perl5/Sub/Uplevel.pm view on Meta::CPAN
winds up no or above uplevel(), it's CORE::caller(X+1+uplevel+1).
Which means I'm probably going to have to do something nasty like walk
up the call stack on each caller() to see if I'm going to wind up
before or after Sub::Uplevel::uplevel().
=end _private
=begin _dagolden
I found the description above a bit confusing. Instead, this is the logic
that I found clearer when CORE::GLOBAL::caller is invoked and we have to
walk up the call stack:
* if searching up to the requested height in the real call stack doesn't find
a call to uplevel, then we can return the result at that height in the
call stack
* if we find a call to uplevel, we need to keep searching upwards beyond the
requested height at least by the amount of upleveling requested for that
call to uplevel (from the Up_Frames stack set during the uplevel call)
( run in 0.716 second using v1.01-cache-2.11-cpan-49f99fa48dc )