lib/Module/Build/t/extend.t Module::Build
lib/Module/Build/t/ext.t Module::Build
lib/Module/Build/t/files.t Module::Build
+lib/Module/Build/t/help.t Module::Build
lib/Module/Build/t/install.t Module::Build
lib/Module/Build/t/lib/DistGen.pm Module::Build
lib/Module/Build/t/lib/MBTest.pm Module::Build
lib/Module/Build/t/new_from_context.t Module::Build
lib/Module/Build/t/notes.t Module::Build
lib/Module/Build/t/parents.t Module::Build
+lib/Module/Build/t/par.t Module::Build
lib/Module/Build/t/pod_parser.t Module::Build
lib/Module/Build/t/ppm.t Module::Build
lib/Module/Build/t/runthrough.t Module::Build
use vars qw($VERSION @ISA);
@ISA = qw(Module::Build::Base);
-$VERSION = '0.2807';
+$VERSION = '0.2808';
$VERSION = eval $VERSION;
# Okay, this is the brute-force method of finding out what kind of
sub os_type { $OSTYPES{$^O} }
+sub is_vmsish { return ((os_type() || '') eq 'VMS') }
+sub is_windowsish { return ((os_type() || '') eq 'Windows') }
+sub is_unixish { return ((os_type() || '') eq 'Unix') }
+
1;
__END__
will return C<undef> - there shouldn't be many unknown platforms
though.
+=item is_vmsish()
+
+=item is_windowsish()
+
+=item is_unixish()
+
+Convenience functions that return a boolean value indicating whether
+this platform behaves respectively like VMS, Windows, or Unix. For
+arbitrary reasons other platforms don't get their own such functions,
+at least not yet.
+
+
=item prefix_relpaths()
=item prefix_relpaths($installdirs)
}
$args{ARGV} = \@argv;
+ for ('extra_compiler_flags', 'extra_linker_flags') {
+ $args{$_} = [ $self->split_like_shell($args{$_}) ] if exists $args{$_};
+ }
+
# Hashify these parameters
for ($self->hash_properties, 'config') {
next unless exists $args{$_};
}
+# (bash shell won't expand tildes mid-word: "--foo=~/thing")
+# TODO: handle ~user/foo
sub _detildefy {
my $arg = shift;
my ($files_found, @docs) = (0);
foreach my $class ($self->super_classes) {
(my $file = $class) =~ s{::}{/}g;
+ # NOTE: silently skipping relative paths if any chdir() happened
$file = $INC{$file . '.pm'} or next;
my $fh = IO::File->new("< $file") or next;
$files_found++;
last if /^=head1 ACTIONS\s/;
}
- # Look for our action
- my ($found, $inlist) = (0, 0);
+ # Look for our action and determine the style
+ my $style;
while (<$fh>) {
- if (/^=item\s+\Q$action\E\b/) {
- $found = 1;
- } elsif (/^=(item|back)/) {
- last if $found > 1 and not $inlist;
+ last if /^=head1 /;
+
+ # only item and head2 are allowed (3&4 are not in 5.005)
+ if(/^=(item|head2)\s+\Q$action\E\b/) {
+ $style = $1;
+ push @docs, $_;
+ last;
}
- next unless $found;
- push @docs, $_;
- ++$inlist if /^=over/;
- --$inlist if /^=back/;
- ++$found if /^\w/; # Found descriptive text
}
+ $style or next; # not here
+
+ # and the content
+ if($style eq 'item') {
+ my ($found, $inlist) = (0, 0);
+ while (<$fh>) {
+ if (/^=(item|back)/) {
+ last unless $inlist;
+ }
+ push @docs, $_;
+ ++$inlist if /^=over/;
+ --$inlist if /^=back/;
+ }
+ }
+ else { # head2 style
+ # stop at anything equal or greater than the found level
+ while (<$fh>) {
+ last if(/^=(?:head[12]|cut)/);
+ push @docs, $_;
+ }
+ }
+ # TODO maybe disallow overriding just pod for an action
+ # TODO and possibly: @docs and last;
}
unless ($files_found) {
foreach my $file (keys %$files) {
my $result = $self->copy_if_modified($file, $script_dir, 'flatten') or next;
- $self->fix_shebang_line($result) unless $self->os_type eq 'VMS';
+ $self->fix_shebang_line($result) unless $self->is_vmsish;
$self->make_executable($result);
}
}
sub localize_file_path {
my ($self, $path) = @_;
- $path =~ s/\.\z// if $self->os_type eq 'VMS';
+ $path =~ s/\.\z// if $self->is_vmsish;
return File::Spec->catfile( split m{/}, $path );
}
$shb .= qq{
eval 'exec $interpreter $arg -S \$0 \${1+"\$\@"}'
if 0; # not running under some shell
-} unless $self->os_type eq 'Windows'; # this won't work on win32, so don't
+} unless $self->is_windowsish; # this won't work on win32, so don't
my $FIXOUT = IO::File->new(">$file.new")
or die "Can't create new $file: $!\n";
or die "The 'testpodcoverage' action requires ",
"Test::Pod::Coverage version 1.00";
+ # TODO this needs test coverage!
+
+ # XXX work-around a bug in Test::Pod::Coverage previous to v1.09
+ # Make sure we test the module in blib/
+ local @INC = @INC;
+ my $p = $self->{properties};
+ unshift(@INC,
+ # XXX any reason to include arch?
+ File::Spec->catdir($p->{base_dir}, $self->blib, 'lib'),
+ #File::Spec->catdir($p->{base_dir}, $self->blib, 'arch')
+ );
+
all_pod_coverage_ok();
}
warn "Unknown 'build_class', defaulting to 'Module::Build'\n";
$args{build_class} = 'Module::Build';
}
+ my $class = $args{build_class};
- my $perl = $args{build_class}->find_perl_interpreter;
- my $os_type = $args{build_class}->os_type;
- my $noop = ($os_type eq 'Windows' ? 'rem>nul' :
- $os_type eq 'VMS' ? 'Continue' :
+ my $perl = $class->find_perl_interpreter;
+ my $noop = ($class->is_windowsish ? 'rem>nul' :
+ $class->is_vmsish ? 'Continue' :
'true');
my $Build = 'Build --makefile_env_macros 1';
@ $noop
EOF
- foreach my $action ($args{build_class}->known_actions) {
+ foreach my $action ($class->known_actions) {
next if $action =~ /^(all|realclean|force_do_it)$/; # Don't double-define
$maketext .= <<"EOF";
$action : force_do_it
use Data::Dumper;
use IO::File;
-use Carp; BEGIN{ $SIG{__DIE__} = \&carp::confess }
-
sub new {
my ($class, %args) = @_;
my $file = delete $args{file} or die "Missing required parameter 'file' to new()";
use strict;
use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
-use MBTest tests => 49;
+use MBTest tests => 52;
use Cwd ();
my $cwd = Cwd::cwd;
ok $mb;
is_deeply $mb->extra_compiler_flags, ['-I/foo', '-I/bar'], "Should split shell string into list";
is_deeply $mb->extra_linker_flags, ['-L/foo', '-L/bar'], "Should split shell string into list";
+
+ # Try again with command-line args
+ eval {Module::Build->run_perl_script('Build.PL', [], ['--extra_compiler_flags', '-I/foo -I/bar',
+ '--extra_linker_flags', '-L/foo -L/bar'])};
+ $mb = Module::Build->resume;
+ ok $mb;
+ is_deeply $mb->extra_compiler_flags, ['-I/foo', '-I/bar'], "Should split shell string into list";
+ is_deeply $mb->extra_linker_flags, ['-L/foo', '-L/bar'], "Should split shell string into list";
}
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
+use MBTest 'no_plan';#tests => 0;
+
+use Cwd ();
+use File::Path ();
+
+my $cwd = Cwd::cwd();
+my $tmp = File::Spec->catdir($cwd, 't', '_tmp');
+
+use DistGen;
+
+my $dist = DistGen->new(dir => $tmp);
+
+
+$dist->regen;
+
+my $restart = sub {
+ $dist->clean();
+ chdir( $cwd );
+ File::Path::rmtree( $tmp );
+ # we're redefining the same package as we go, so...
+ delete($::{'MyModuleBuilder::'});
+ delete($INC{'MyModuleBuilder.pm'});
+ $dist->regen;
+ chdir($dist->dirname) or
+ die "Can't chdir to '@{[$dist->dirname]}': $!";
+};
+
+chdir($dist->dirname) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+
+use_ok 'Module::Build';
+
+########################################################################
+{ # check the =item style
+my $mb = Module::Build->subclass(
+ code => join "\n", map {s/^ {4}//; $_} split /\n/, <<' ---',
+ =head1 ACTIONS
+
+ =over
+
+ =item foo
+
+ Does the foo thing.
+
+ =item bar
+
+ Does the bar thing.
+
+ =item help
+
+ Does the help thing.
+
+ You should probably not be seeing this. That is, we haven't
+ overridden the help action, but we're able to override just the
+ docs? That almost seems reasonable, but is probably wrong.
+
+ =back
+
+ =cut
+
+ sub ACTION_foo { die "fooey" }
+ sub ACTION_bar { die "barey" }
+ sub ACTION_baz { die "bazey" }
+
+ # guess we can have extra pod later
+
+ =over
+
+ =item baz
+
+ Does the baz thing.
+
+ =back
+
+ =cut
+
+ ---
+ )->new(
+ module_name => $dist->name,
+ );
+
+ok $mb;
+can_ok($mb, 'ACTION_foo');
+
+foreach my $action (qw(foo bar baz)) { # typical usage
+ my $doc = $mb->get_action_docs($action);
+ ok($doc, "got doc for '$action'");
+ like($doc, qr/^=\w+ $action\n\nDoes the $action thing\./s,
+ 'got the right doc');
+}
+
+{ # user typo'd the action name
+ ok( ! eval {$mb->get_action_docs('batz'); 1}, 'slap');
+ like($@, qr/No known action 'batz'/, 'informative error');
+}
+
+{ # XXX this one needs some thought
+ my $action = 'help';
+ my $doc = $mb->get_action_docs($action);
+ ok($doc, "got doc for '$action'");
+ 0 and warn "help doc >\n$doc<\n";
+ TODO: {
+ local $TODO = 'Do we allow overrides on just docs?';
+ unlike($doc, qr/^=\w+ $action\n\nDoes the $action thing\./s,
+ 'got the right doc');
+ }
+}
+} # end =item style
+$restart->();
+########################################################################
+if(0) { # the =item style without spanning =head1 sections
+my $mb = Module::Build->subclass(
+ code => join "\n", map {s/^ {4}//; $_} split /\n/, <<' ---',
+ =head1 ACTIONS
+
+ =over
+
+ =item foo
+
+ Does the foo thing.
+
+ =item bar
+
+ Does the bar thing.
+
+ =back
+
+ =head1 thbbt
+
+ =over
+
+ =item baz
+
+ Should not see this.
+
+ =back
+
+ =cut
+
+ sub ACTION_foo { die "fooey" }
+ sub ACTION_bar { die "barey" }
+ sub ACTION_baz { die "bazey" }
+
+ ---
+ )->new(
+ module_name => $dist->name,
+ );
+
+ok $mb;
+can_ok($mb, 'ACTION_foo');
+
+foreach my $action (qw(foo bar)) { # typical usage
+ my $doc = $mb->get_action_docs($action);
+ ok($doc, "got doc for '$action'");
+ like($doc, qr/^=\w+ $action\n\nDoes the $action thing\./s,
+ 'got the right doc');
+}
+is($mb->get_action_docs('baz'), undef, 'no jumping =head1 sections');
+
+} # end =item style without spanning =head1's
+$restart->();
+########################################################################
+TODO: { # the =item style with 'Actions' not 'ACTIONS'
+local $TODO = 'Support capitalized Actions section';
+my $mb = Module::Build->subclass(
+ code => join "\n", map {s/^ {4}//; $_} split /\n/, <<' ---',
+ =head1 Actions
+
+ =over
+
+ =item foo
+
+ Does the foo thing.
+
+ =item bar
+
+ Does the bar thing.
+
+ =back
+
+ =cut
+
+ sub ACTION_foo { die "fooey" }
+ sub ACTION_bar { die "barey" }
+
+ ---
+ )->new(
+ module_name => $dist->name,
+ );
+
+foreach my $action (qw(foo bar)) { # typical usage
+ my $doc = $mb->get_action_docs($action);
+ ok($doc, "got doc for '$action'");
+ like($doc || 'undef', qr/^=\w+ $action\n\nDoes the $action thing\./s,
+ 'got the right doc');
+}
+
+} # end =item style with Actions
+$restart->();
+########################################################################
+{ # check the =head2 style
+my $mb = Module::Build->subclass(
+ code => join "\n", map {s/^ {4}//; $_} split /\n/, <<' ---',
+ =head1 ACTIONS
+
+ =head2 foo
+
+ Does the foo thing.
+
+ =head2 bar
+
+ Does the bar thing.
+
+ =head3 bears
+
+ Be careful with bears.
+
+ =cut
+
+ sub ACTION_foo { die "fooey" }
+ sub ACTION_bar { die "barey" }
+ sub ACTION_baz { die "bazey" }
+ sub ACTION_batz { die "batzey" }
+
+ # guess we can have extra pod later
+ # Though, I do wonder whether we should allow them to mix...
+ # maybe everything should have to be head2?
+
+ =head2 baz
+
+ Does the baz thing.
+
+ =head4 What's a baz?
+
+ =head1 not this part
+
+ This is level 1, so the stuff about baz is done.
+
+ =head1 Thing
+
+ =head2 batz
+
+ This is not an action doc.
+
+ =cut
+
+ ---
+ )->new(
+ module_name => $dist->name,
+ );
+
+my %also = (
+ foo => '',
+ bar => "\n=head3 bears\n\nBe careful with bears.\n",
+ baz => "\n=head4 What's a baz\\?\n",
+);
+
+foreach my $action (qw(foo bar baz)) {
+ my $doc = $mb->get_action_docs($action);
+ ok($doc, "got doc for '$action'");
+ my $and = $also{$action};
+ like($doc || 'undef',
+ qr/^=\w+ $action\n\nDoes the $action thing\.\n$and\n$/s,
+ 'got the right doc');
+}
+is($mb->get_action_docs('batz'), undef, 'nothing after uplevel');
+
+} # end =head2 style
+########################################################################
+
+# cleanup
+$dist->clean();
+chdir( $cwd );
+File::Path::rmtree( $tmp );
+
+# vim:ts=2:sw=2:et:sta
--- /dev/null
+#!/usr/bin/perl -w
+
+use strict;
+use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
+use MBTest;
+use Module::Build;
+use Module::Build::ConfigData;
+
+{
+ my ($have_c_compiler, $C_support_feature) = check_compiler();
+ if (! $C_support_feature) {
+ plan skip_all => 'C_support not enabled';
+ } elsif ( ! $have_c_compiler ) {
+ plan skip_all => 'C_support enabled, but no compiler found';
+ } elsif ( ! eval {require PAR::Dist; PAR::Dist->VERSION(0.17)} ) {
+ plan skip_all => "PAR::Dist 0.17 or up not installed to check .par's.";
+ } elsif ( ! eval {require Archive::Zip} ) {
+ plan skip_all => "Archive::Zip required.";
+ } else {
+ plan tests => 3;
+ }
+}
+
+
+use Cwd ();
+my $cwd = Cwd::cwd;
+my $tmp = File::Spec->catdir( $cwd, 't', '_tmp' );
+
+
+use DistGen;
+my $dist = DistGen->new( dir => $tmp, xs => 1 );
+$dist->add_file( 'hello', <<'---' );
+#!perl -w
+print "Hello, World!\n";
+__END__
+
+=pod
+
+=head1 NAME
+
+hello
+
+=head1 DESCRIPTION
+
+Says "Hello"
+
+=cut
+---
+$dist->change_file( 'Build.PL', <<"---" );
+
+my \$build = new Module::Build(
+ module_name => @{[$dist->name]},
+ version => '0.01',
+ license => 'perl',
+ scripts => [ 'hello' ],
+);
+
+\$build->create_build_script;
+---
+$dist->regen;
+
+chdir( $dist->dirname ) or die "Can't chdir to '@{[$dist->dirname]}': $!";
+
+use File::Spec::Functions qw(catdir);
+
+use Module::Build;
+my @installstyle = qw(lib perl5);
+my $mb = Module::Build->new_from_context(
+ verbose => 0,
+ quiet => 1,
+
+ installdirs => 'site',
+);
+
+my $filename = $mb->dispatch('pardist');
+
+ok( -f $filename, '.par distributions exists' );
+my $distname = $dist->name;
+ok( $filename =~ /^\Q$distname\E/, 'Distribution name seems correct' );
+
+my $meta;
+eval { $meta = PAR::Dist::get_meta($filename) };
+
+ok(
+ (not $@ and defined $meta and not $meta eq ''),
+ 'Distribution contains META.yml'
+);
+
+$dist->clean();
+
+chdir( $cwd );
+use File::Path;
+rmtree( $tmp );
+
use strict;
use lib $ENV{PERL_CORE} ? '../lib/Module/Build/t/lib' : 't/lib';
-use MBTest tests => 10;
+use MBTest tests => 14;
use Cwd ();
my $cwd = Cwd::cwd;
$mb = run_sample( install_base => '~/foo' );
is( $mb->install_base, "$ENV{HOME}/foo" );
+ $mb = run_sample( install_base => '~~' );
+ is( $mb->install_base, '~~' );
+
+ TODO: {
+ local $TODO = "Not handling spaces in _detildefy() properly yet";
+
+ $mb = run_sample( install_base => '~ foo' );
+ is( $mb->install_base, '~ foo' );
+
+ # glob() doesn't work on non-existent paths with spaces
+ $mb = run_sample( install_base => '~/ foo' );
+ is( $mb->install_base, "$ENV{HOME}/ foo" );
+
+ $mb = run_sample( install_base => '~/fo o' );
+ is( $mb->install_base, "$ENV{HOME}/fo o" );
+ }
+
$mb = run_sample( install_base => 'foo~' );
is( $mb->install_base, 'foo~' );
SKIP: {
skip( "skipping a Unixish-only tests", 1 )
- unless $mb->os_type eq 'Unix';
+ unless $mb->is_unixish;
$mb->{config}->push(ld => "FOO=BAR ".$mb->config('ld'));
eval {$mb->dispatch('build')};
projects / p5sagit/p5-mst-13.2.git / commitdiff