Alien-Selenium
view release on metacpan or search on metacpan
inc/My/Module/Build.pm view on Meta::CPAN
=begin internals
=head2 Global variables
=head3 $running_under_emacs_debugger
Set by L</_massage_ARGV> if (you guessed it) we are currently running
under the Emacs debugger.
=cut
our $running_under_emacs_debugger;
=head2 Constants
=head3 is_win32
Your usual bugware-enabling OS checks.
=cut
use constant is_win32 => scalar($^O =~ /^(MS)?Win32$/);
=head2 read_file($file)
=head2 write_file($file, @lines)
Like in L<File::Slurp>.
=cut
sub read_file {
my ($filename) = @_;
defined(my $file = IO::File->new($filename, "<")) or die <<"MESSAGE";
Cannot open $filename for reading: $!.
MESSAGE
return wantarray? <$file> : join("", <$file>);
}
sub write_file {
my ($filename, @contents) = @_;
defined(my $file = IO::File->new($filename, ">")) or die <<"MESSAGE";
Cannot open $filename for writing: $!.
MESSAGE
($file->print(join("", @contents)) and $file->close()) or die <<"MESSAGE";
Cannot write into $filename: $!.
MESSAGE
}
=end internals
=head2 Constructors and Class Methods
These are intended to be called directly from Build.PL
=over
=item I<new(%named_options)>
Overloaded from parent class in order to call
L</check_maintainer_dependencies> if L</maintainer_mode_enabled> is
true. Also sets the C<recursive_test_files> property to true by
default (see L<Module::Build/test_files>), since I like to store
maintainer-only tests in C<t/maintainer> (as documented in
L</find_test_files>).
In addition to the %named_options documented in L<Module::Build/new>,
I<My::Module::Build> provides support for the following switches:
=over
=item I<< add_to_no_index => $data_structure >>
Appends the aforementioned directories and/or namespaces to the list
that L</ACTION_distmeta> stores in META.yml. Useful to hide some of
the Perl modules from the CPAN index.
=back
=cut
sub new {
my ($class, %opts) = @_;
$opts{recursive_test_files} = 1 if
(! defined $opts{recursive_test_files});
my $self = $class->SUPER::new(%opts);
if ($self->maintainer_mode_enabled()) {
print "Running specific maintainer checks...\n";
$self->check_maintainer_dependencies();
}
$self->_process_options;
$self;
}
=item I<requires_for_build()>
Returns a list of packages that are required by I<My::Module::Build>
itself, and should therefore be appended to the C<build_requires> hash
as shown in L</SYNOPSIS>.
=cut
sub requires_for_build {
('IO::File' => 0,
'File::Path' => 0,
'File::Spec' => 0,
'File::Spec::Functions' => 0,
'File::Spec::Unix' => 0,
'File::Find' => 0,
'Module::Build' => 0,
'Module::Build::Compat' => 0,
'FindBin' => 0, # As per L</SYNOPSIS>
# The following are actually requirements for tests:
'File::Temp' => 0, # for tempdir() in My::Tests::Below
'Fatal' => 0, # Used to cause tests to die early if fixturing
# fails, see sample in this module's test suite
# (at the bottom of this file)
);
}
inc/My/Module/Build.pm view on Meta::CPAN
# Parse shebang line to set taintedness properly:
local *TEST;
open(TEST, $files_to_test[0]) or die
"Can't open $files_to_test[0]. $!\n";
my $shebang = <TEST>;
close(TEST) or print "Can't close $files_to_test[0]. $!\n";
my $taint = ( $shebang =~ /^#!.*\bperl.*\s-\w*([Tt]+)/ );
my ($perl) = ($^X =~ m/^(.*)$/); # Untainted
system($perl, "-d",
($taint ? ("-T") : ()),
(map { ("-I" => $_) } @inc),
$files_to_test[0], "-emacs");
return;
}
# Localize stuff in order to fool our superclass for fun & profit
local %ENV = $self->customize_env(%ENV);
local $self->{FORCE_find_test_files_result}; # See L</find_test_files>
$self->{FORCE_find_test_files_result} = \@files_to_test if
@files_to_test;
# DWIM for ->{verbose} (see POD)
local $self->{properties} = { %{$self->{properties}} };
if (@files_to_test == 1) {
$self->{properties}->{verbose} = 1 if
(! defined $self->{properties}->{verbose});
}
# use_blib feature, cont'd:
no warnings "once";
local *blib = sub {
my $self = shift;
return File::Spec->curdir if ! $self->use_blib;
return $self->SUPER::blib(@_);
};
$self->SUPER::ACTION_test(@_);
}
=item I<ACTION_distmeta>
Overloaded to ensure that .pm modules in inc/ don't get indexed and
that the C<add_to_no_index> parameter to L</new> is honored.
=cut
sub ACTION_distmeta {
my $self = shift;
eval { require YAML } or die ($@ . <<"MESSAGE");
YAML is required for distmeta to produce accurate results. Please
install it and re-run this command.
MESSAGE
# Steals a reference to the YAML object that will be constructed
# by the parent class (duhh)
local our $orig_yaml_node_new = \&YAML::Node::new;
local our $node;
no warnings "redefine";
local *YAML::Node::new = sub {
$node = $orig_yaml_node_new->(@_);
};
my $retval = $self->SUPER::ACTION_distmeta;
die "Failed to steal the YAML node" unless defined $node;
$node->{no_index} = $self->{properties}->{add_to_no_index} || {};
$node->{no_index}->{directory} ||= [];
unshift(@{$node->{no_index}->{directory}}, qw(examples inc t),
(map { File::Spec::Unix->catdir("lib", split m/::/) }
(@{$node->{no_index}->{namespace} || []})));
foreach my $package (keys %{$node->{provides}}) {
delete $node->{provides}->{$package} if
(grep {$package =~ m/^\Q$_\E/}
@{$node->{no_index}->{namespace} || []});
delete $node->{provides}->{$package} if
(grep {$package eq $_}
@{$node->{no_index}->{package} || []});
}
my $metafile =
$self->can("metafile") ? # True as of Module::Build 0.2805
$self->metafile() : $self->{metafile};
# YAML API changed after version 0.30
my $yaml_sub =
($YAML::VERSION le '0.30' ? \&YAML::StoreFile : \&YAML::DumpFile);
$yaml_sub->($metafile, $node)
or die "Could not write to $metafile: $!";
;
}
=item I<customize_env(%env)>
Returns a copy of %env, an environment hash, modified in a
package-specific fashion. To be used typically as
local %ENV = $self->customize_env(%ENV);
The default implementation sets PERL_INLINE_BUILD_NOISY to 1 and also
sets FULL_DEBUGGING if so directed by the command line (see L</
ACTION_test>).
=cut
sub customize_env {
my ($self, %env) = @_;
delete $env{FULL_DEBUGGING};
$env{PERL_INLINE_BUILD_NOISY} = 1;
$env{FULL_DEBUGGING} = 1 if ($self->{args}->{full_debugging});
return %env;
}
=item I<process_pm_files>
inc/My/Module/Build.pm view on Meta::CPAN
=cut
sub process_pm_files {
no warnings "once";
local *copy_if_modified = \*process_pm_file_if_modified;
my $self = shift;
return $self->SUPER::process_pm_files(@_);
}
=item I<process_pm_file_if_modified(%args)>
Does the same as L<copy_file_if_modified> (which it actually replaces
while L<process_pm_files> runs), except that the L</new_pm_filter> is
applied instead of performing a vanilla copy as L<Module::Build> does.
=cut
sub process_pm_file_if_modified {
my ($self, %args) = @_;
my ($from, $to) = @args{qw(from to)};
return if $self->up_to_date($from, $to); # Already fresh
mkpath(dirname($to), 0, 0777);
# Do a filtering copy
print "$from -> $to\n" if $args{verbose};
die "Cannot open $from for reading: $!\n" unless
(my $fromfd = new IO::File($from, "r"));
die "Cannot open $to for writing: $!\n" unless
(my $tofd = new IO::File($to, "w"));
my $filter = $self->new_pm_filter;
while(my $line = <$fromfd>) {
my $moretext = $filter->filter($line);
if (defined($moretext) && length($moretext)) {
$tofd->print($moretext) or
die "Cannot write to $to: $!\n";
}
last if $filter->eof_reached();
}
$tofd->close() or die "Cannot close to $to: $!\n";
}
=item I<new_pm_filter>
Creates and returns a fresh filter object (see
L</My::Module::Build::PmFilter Ancillary Class>) that will be used by
L</process_pm_file_if_modified> to process the text of the .pm files.
Subclasses may find it convenient to overload I<new_pm_filter> in
order to provide a different filter. The filter object should obey
the API set forth in L</My::Module::Build::PmFilter Ancillary Class>,
although it need not inherit from same.
=cut
sub new_pm_filter { My::Module::Build::PmFilter->new }
=item I<find_test_files()>
Overloaded from parent class to treat all .pm files in C<lib/> and
C<t/lib/> as unit tests if they use L<My::Tests::Below>, to look for
C<.t> files in C<examples/>, and to retain C<.t> test files in
C<t/maintainer> if and only if L</maintainer_mode_enabled> is true.
=cut
sub find_test_files {
my $self = shift;
# Short-cut activated by L</ACTION_test>:
return $self->{FORCE_find_test_files_result} if
(defined $self->{FORCE_find_test_files_result});
my @tests = @{$self->SUPER::find_test_files(@_)};
# Short-cut activated by putting a 'test_files' key in the constructor
# arguments:
return @tests if $self->{test_files};
@tests = grep { ! m/^t.maintainer/ } @tests unless
($self->maintainer_mode_enabled());
File::Find::find
({no_chdir => 1, wanted => sub {
push(@tests, $_) if $self->find_test_files_predicate();
}}, $self->find_test_files_in_directories);
return \@tests;
}
=item I<find_test_files_predicate()>
=item I<find_test_files_in_directories()>
Those two methods are used as callbacks by L</find_test_files>;
subclasses of I<My::Module::Build> may therefore find it convenient to
overload them. I<find_test_files_in_directories> should return a list
of the directories in which to search for test files.
I<find_test_files_predicate> gets passed the name of each file found
in these directories in the same way as a L<File::Find> C<wanted> sub
would (that is, using $_ and B<not> the argument list); it should
return a true value iff this file is a test file.
=cut
sub find_test_files_predicate {
my ($self) = @_;
return 1 if m/My.Tests.Below\.pm$/;
return if m/\b[_.]svn\b/; # Subversion metadata
return 1 if m/\.t$/;
my $module = catfile($self->base_dir, $_);
local *MODULE;
unless (open(MODULE, "<", $module)) {
warn "Cannot open $module: $!";
return;
}
return 1 if grep {
m/^require\s+My::Tests::Below\s+unless\s+caller/
} (<MODULE>);
return;
}
inc/My/Module/Build.pm view on Meta::CPAN
package My::Module::Build::HowAreYouGentlemen;
our @ISA=qw(Module::Build::Compat); # Do not explicitly load it because
# Makefile.PL will set up us the Module::Build::Compat itself (and
# also we want to take off every zig of bloat when
# My::Module::Build is loaded from elsewhere). Moreover, "use
# base" is not yet belong to us at this time.
sub fake_makefile {
my $self = shift;
return $self->SUPER::fake_makefile(@_). <<'MAIN_SCREEN_TURN_ON';
# In 2101 AD war was beginning...
your:
@echo
@echo -n " All your codebase"
time:
@echo " are belong to us !"
@echo
MAIN_SCREEN_TURN_ON
}
}
=head2 Overloaded Internal Methods
Yeah I know, that's a pretty stupid thing to do, but that's the best I
could find to get Module::Build to do my bidding.
=over
=item I<subclass(%named_arguments)>
Overloaded from L<Module::Build::Base> to set @ISA at compile time and
to the correct value in the sub-classes generated from the C<< code >>
named argument. We need @ISA to be set up at compile-time so that the
method attributes work correctly; also we work around a bug present in
Module::Build 0.26 and already fixed in the development branch whence,
ironically, ->subclass does not work from a subclass.
=cut
sub subclass {
my ($pack, %opts) = @_;
$opts{code} = <<"KLUDGE_ME_UP" if defined $opts{code};
# Kludge inserted by My::Module::Build to work around some brokenness
# in the \@ISA setup code above:
use base "My::Module::Build";
our \@ISA;
BEGIN { our \@ISAorig = \@ISA; }
\@ISA = our \@ISAorig;
$opts{code}
KLUDGE_ME_UP
return $pack->SUPER::subclass(%opts);
}
=item I<_startperl>
Overloaded from parent to attempt a chdir() into the right place in
./Build during initialization. This is an essential enabler to the
Emacs debugger support (see L</ACTION_test>) because we simply cannot
tell where Emacs will be running us from.
=cut
sub _startperl {
my $self = shift;
my $basedir = $self->base_dir;
$basedir = Win32::GetShortPathName($basedir) if is_win32;
return $self->SUPER::_startperl(@_) . <<"MORE";
# Hack by My::Module::Build to give the Emacs debugger one
# more chance to work:
use Cwd;
BEGIN {
\$My::Module::Build::initial_cwd = \$My::Module::Build::initial_cwd =
Cwd::cwd;
chdir("$basedir") || 1;
}
MORE
}
=item I<_packages_inside($file)>
Returns a list of Perl packages to be found inside $file. Overloaded
from the parent class so as to refrain from parsing after the __END__
marker.
=cut
sub _packages_inside {
# Copied 'n modified from the parent class, doubleplusshame on me!
my ($self, $file) = @_;
my $fh = IO::File->new($file) or die "Can't read $file: $!";
my @packages;
while(my (undef, $p) = $self->_next_code_line
($fh, qr/^(?:__END__$|__DATA__$|[\s\{;]*package\s+([\w:]+))/)) {
last if ! defined $p;
push @packages, $p;
}
return @packages;
}
=back
=head2 Other Private Methods
=over
=item I<_massage_ARGV($ref_to_ARGV)>
Called as part of this module's startup code, in order to debogosify
the @ARGV array (to be passed as a reference) when we are invoked from
Emacs' M-x perldb. L</ACTION_test> will afterwards be able to take
advantage of the Emacs debugger we run under, by bogosifying the
command line back before invoking the script to test.
=cut
_massage_ARGV(\@ARGV);
sub _massage_ARGV {
my ($argvref) = @_;
my @argv = @$argvref;
return unless ($ENV{EMACS} && (grep {$_ eq "-emacs"} @argv));
$running_under_emacs_debugger = 1;
@argv = grep { $_ ne "-emacs" } @argv;
shift @argv if $argv[0] eq "-d"; # Was gratuitously added by former Emacsen
# XEmacs foolishly assumes that the second word in the perldb
# line is a filename and turns it into e.g. "/my/path/test":
(undef, undef, $argv[0]) = File::Spec->splitpath($argv[0]);
@$argvref = @argv;
}
=back
=head2 My::Module::Build::PmFilter Ancillary Class
This ancillary class, serving both as an object-oriented interface and
as a default implementation thereof, is the workhorse behind
L</process_pm_files> and L</process_pm_file_if_modified>. It consists
of a very simple filter API to transform the text of .pm files as they
are copied over from lib/ to blib/ during the build process. The
base-class implementation simply replaces copyright placeholders of
the form "(C) DOMQ" with appropriate legalese, and removes the
L<My::Tests::Below> test suite if one is found.
( run in 0.719 second using v1.01-cache-2.11-cpan-e1769b4cff6 )