Alien-Selenium

 view release on metacpan or  search on metacpan

inc/My/Module/Build.pm  view on Meta::CPAN

#!perl -wT
# Copyright Dominique Quatravaux 2006 - Licensed under the same terms as Perl itself

use strict;
use warnings;
use 5.006; # "our" keyword

=head1 NAME

My::Module::Build - Helper for releasing my (DOMQ's) code to CPAN

=head1 SYNOPSIS

This module works mostly like L<Module::Build> with a few differences
highlighted below. Put this in Build.PL:

=for My::Tests::Below "synopsis" begin

  use strict;
  use warnings;

  ## Replace
  # use Module::Build;
  ## with
  use FindBin; use lib "$FindBin::Bin/inc";
  use My::Module::Build;

  ## Replace
  # my $builder = Module::Build->new(
  ## With
  my $builder = My::Module::Build->new(
     ## ... Use ordinary Module::Build arguments here ...
     build_requires =>    {
           'Acme::Pony'    => 0,
           My::Module::Build->requires_for_build(),
     },
     add_to_no_index => { namespace => [ "My::Private::Stuff" ] },
  );

  ## The remainder of the script works like with stock Module::Build

=for My::Tests::Below "synopsis" end

=head1 DESCRIPTION

DOMQ is a guy who releases CPAN packages from time to time - you are
probably frobbing into one of them right now.

This module is a subclass to L<Module::Build> by Ken Williams, and a
helper that supports DOMQ's coding style for Perl modules so as to
facilitate relasing my code to the world.

=head2 How to use My::Module::Build for a new CPAN package

This part of the documentation is probably only useful to myself,
but hey, you never know - Feel free to share and enjoy!

=over

=item 1.

If not already done, prepare a skeletal CPAN module that uses
L<Module::Build> as its build support class. L<Module::Starter> and
its companion command C<module-starter(1)> is B<highly> recommended
for this purpose, e.g.

   module-starter --mb --module=Main::Screen::Turn::On \
     --author='Dominique Quatravaux' --email='domq@cpan.org' --force

=item 2.

create an C<inc/> subdirectory at the CPAN module's top level and drop
this file there. (While you are there, you could put the rest of the
My:: stuff along with it, and the t/maintainer/ test cases - see L<SEE
ALSO>.)

=item 3.

Amend the Build.PL as highlighted in the L</SYNOPSIS>.

=item 4.

B<VERY IMPORTANT!> Arrange for My::Module::Build and friends to
B<not> be indexed on the CPAN, lest the Perl deities' wrath fall upon
you. This is done by adding the following lines to the META.yml file:

inc/My/Module/Build.pm  view on Meta::CPAN

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

sub find_test_files_in_directories {
    grep { -d } ("lib", catdir("t", "lib"), "examples");
}

=back

=begin internals

=head1 INTERNAL DOCUMENTATION

This section describes how My::Module::Build works internally. It
should be useful only to people who intend to modify it.

=over

=item I<My::Module::Build::do_create_makefile_pl>

=item I<My::Module::Build::HowAreYouGentlemen::fake_makefile>

Overloaded respectively from L<Module::Build::Base> and
L<Module::Build::Compat> so that typing

=for My::Tests::Below "great justice" begin

   perl Makefile.PL
   make your time

=for My::Tests::Below "great justice" end

produces a helpful message in packages that have a Makefile.PL (see
L<Module::Build/create_makefile_pl> for how to do that). You won't get
signal if you use a "traditional" style Makefile.PL (but on the other
hand the rest of I<My::Module::Build> will not work either, so don't
do that).

This easter egg was a feature of an old GNU-make based build framework
that I created in a former life.  So there.

=cut

sub do_create_makefile_pl {
  my ($self, %args) = @_;
  warn("Cannot take off any Zig, sorry"),
      return $self->SUPER::do_create_makefile_pl(%args) if ($args{fh});
  $args{file} ||= 'Makefile.PL';
  my $retval = $self->SUPER::do_create_makefile_pl(%args);
  my $MakefilePL = read_file($args{file});
  $MakefilePL = <<'PREAMBLE' . $MakefilePL;
use FindBin qw($Bin);
use lib "$Bin/inc";
PREAMBLE
  $MakefilePL =~ s|Module::Build::Compat->write_makefile|My::Module::Build::HowAreYouGentlemen->write_makefile|;
  write_file($args{file}, $MakefilePL);
  return $retval;
}

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

inc/My/Module/Build.pm  view on Meta::CPAN

copy(catfile($Bin, $Script),
            "$fakemoduledir/inc/My/Module/Build.pm");
write_file(catfile($fakemoduledir, qw(lib My Private Stuff Indeed.pm)),
           <<"BOGON");
#!perl -w

package My::Private::Stuff::Indeed;
use strict;

1;

BOGON

my ($perl) = ($^X =~ m/^(.*)$/); # Untainted
chdir($fakemoduledir);

my $pipe = new IO::Pipe();
$pipe->reader($perl, "$fakemoduledir/Build.PL");
my $log = join('', <$pipe>);
$pipe->close(); is($?, 0, "Running Build.PL");
like($log, qr/version.*0.42/, "Build.PL found the version string");

SKIP: {
    skip "Not testing Build distmeta (YAML not available)", 2
        unless eval { require YAML };

    my $snippet = My::Tests::Below->pod_data_snippet("distmeta");
    my $errfile = "$fakemoduledir/meta-yml-error.log";
    my $script = <<"SCRIPT";
exec > "$errfile" 2>&1
set -x
cd "$fakemoduledir"
$snippet
SCRIPT
    system($script);
    is($?, 0, "creating META.yml using documented procedure")
        or diag($script . read_file($errfile));
    my $META_yml = read_file("$fakemoduledir/META.yml");
    my $excerpt = My::Tests::Below->pod_data_snippet("META.yml excerpt");
    $excerpt =~ s/\n+/\n/gs; $excerpt =~ s/^\n//s;
    like($META_yml, qr/\Q$excerpt\E/,
        "META.yml contains provisions against indexing My::* modules");
    like($META_yml, qr|My\b.*\bPrivate\b.*\bStuff|,
        "these provisions can be customized");
    like($META_yml, qr/\bFake::Module\b/,
        "Fake::Module is indexed");
    like($META_yml, qr/\bFake::Module::Ancillary::Class\b/,
        "Fake::Module::Ancillary::Class is indexed");
    unlike($META_yml, qr/This::Package::Should::Not::Be::Reported/,
        "META.yml should not index stuff that is after __END__");
    unlike($META_yml, qr/Indeed/,
        "META.yml should not index stuff that is in add_to_no_index");
}

# You have no chance to survive...
test_Makefile_PL_your_time($_) for
    ($sample_Build_PL, <<'SUBCLASSED_BUILD_PL');
use strict;
use warnings;

use FindBin; use lib "$FindBin::Bin/inc";
use My::Module::Build;

my $subclass = My::Module::Build->subclass(code => "");

my $builder = $subclass->new(
      module_name         => 'Fake::Module',
      license             => 'perl',
      dist_author         => 'Octave Hergebelle <hector@tdlgb.org>',
      dist_version_from   => 'lib/Fake/Module.pm',
      dist_abstract       => 'required for Module::Build 0.2805, sheesh',
      requires            => {
        'Module::Build' => 0,
      },
      create_makefile_pl  => 'passthrough',

   build_requires =>    {
#         'Acme::Pony'    => 0,
         My::Module::Build->requires_for_build(),
   },
);

$builder->create_build_script();
1;


SUBCLASSED_BUILD_PL

sub test_Makefile_PL_your_time {
    my ($Build_PL_contents) = @_;
    write_file("$fakemoduledir/Build.PL", $Build_PL_contents);
    system($perl, "$fakemoduledir/Build.PL");
    is($?, 0, "Running Build.PL");
    system("$fakemoduledir/Build", "dist");
    is($?, 0, "Running Build dist");
    unlink("$fakemoduledir/Fake-Module-0.42.tar.gz");
    write_file("$fakemoduledir/test.sh",
           <<"PREAMBLE",
set -e
cd $fakemoduledir
PREAMBLE
               My::Tests::Below->pod_data_snippet("great justice"));
    $pipe = new IO::Pipe;
    $pipe->reader("/bin/sh", "$fakemoduledir/test.sh");
    my $text = join('', <$pipe>);
    $pipe->close();
    is($?, 0, "You are on the way to destruction")
        or warn $text;
    like($text, qr/belong/, "Still first hit on Google, after all these years!");
}