Author: ericwilhelm
Date: Sun Apr 15 02:39:23 2007
New Revision: 9414
Modified:
Module-Build/trunk/Changes
Module-Build/trunk/lib/Module/Build/Base.pm
Module-Build/trunk/t/help.t
Log:
t/help.t - finished the =head2 tests
lib/Module/Build/Base.pm - get_action_docs() =head[234] support
Changes - noted
Modified: Module-Build/trunk/Changes
==============================================================================
--- Module-Build/trunk/Changes (original)
+++ Module-Build/trunk/Changes Sun Apr 15 02:39:23 2007
@@ -1,5 +1,7 @@
Revision history for Perl extension Module::Build.
+ - Support get_action_docs() =head2 style. [ewilhelm]
+
- Reworked _detildefy with regexp instead of glob(). [ewilhelm]
- Workaround Test::Pod::Coverage @INC bug. [Eric Wilhelm]
Modified: Module-Build/trunk/lib/Module/Build/Base.pm
==============================================================================
--- Module-Build/trunk/lib/Module/Build/Base.pm (original)
+++ Module-Build/trunk/lib/Module/Build/Base.pm Sun Apr 15 02:39:23 2007
@@ -1881,19 +1881,39 @@
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 /;
+
+ # hmm, head2 is good, but do we need to allow 3,4?
+ if(/^=(item|head[2-4])\s+\Q$action\E\b/) {
+ $style = $1;
+ push @docs, $_;
+ last;
+ }
+ }
+ $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 { # head style
+ # stop at anything equal or greater than the found level
+ my $heads = 'head[1-'. ($style =~ m/(\d)$/)[0] . ']';
+ while (<$fh>) {
+ last if(/^=(?:$heads|back|cut)/);
+ push @docs, $_;
}
- next unless $found;
- push @docs, $_;
- ++$inlist if /^=over/;
- --$inlist if /^=back/;
- ++$found if /^\w/; # Found descriptive text
}
# TODO maybe disallow overriding just pod for an action
# TODO and possibly: @docs and last;
Modified: Module-Build/trunk/t/help.t
==============================================================================
--- Module-Build/trunk/t/help.t (original)
+++ Module-Build/trunk/t/help.t Sun Apr 15 02:39:23 2007
@@ -5,6 +5,8 @@
use MBTest 'no_plan';#tests => 0;
use Cwd ();
+use File::Path ();
+
my $cwd = Cwd::cwd();
my $tmp = File::Spec->catdir($cwd, 't', '_tmp');
@@ -15,8 +17,19 @@
$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]}': $!";
+chdir($dist->dirname) or die "Can't chdir to '@{[$dist->dirname]}': $!";
use_ok 'Module::Build';
@@ -42,7 +55,7 @@
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 seems reasonable, but might be wrong.
+ docs? That almost seems reasonable, but is probably wrong.
=back
@@ -96,7 +109,7 @@
}
}
} # end =item style
-$dist->clean();
+$restart->();
########################################################################
if(0) { # the =item style without spanning =head1 sections
my $mb = Module::Build->subclass(
@@ -148,7 +161,7 @@
is($mb->get_action_docs('baz'), undef, 'no jumping =head1 sections');
} # end =item style without spanning =head1's
-$dist->clean();
+$restart->();
########################################################################
TODO: { # the =item style with 'Actions' not 'ACTIONS'
local $TODO = 'Support capitalized Actions section';
@@ -186,10 +199,9 @@
}
} # end =item style with Actions
-$dist->clean();
+$restart->();
########################################################################
-TODO: { # check the =head2 style
-local $TODO = 'Support =head[234] sections';
+{ # check the =head2 style
my $mb = Module::Build->subclass(
code => join "\n", map {s/^ {4}//; $_} split /\n/, <<' ---',
=head1 ACTIONS
@@ -202,6 +214,10 @@
Does the bar thing.
+ =head3 bears
+
+ Be careful with bears.
+
=cut
sub ACTION_foo { die "fooey" }
@@ -210,11 +226,19 @@
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
+ =head3 baz
Does the baz thing.
+ =head4 What's a baz?
+
+ =head3 not this part
+
+ This is level 3, so the stuff about baz is done.
+
=head1 Thing
=head2 batz
@@ -228,20 +252,28 @@
module_name => $dist->name,
);
-foreach my $action (qw(foo bar baz)) { # typical usage
+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'");
- like($doc || 'undef', qr/^=\w+ $action\n\nDoes the $action thing\./s,
+ 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
-$dist->clean();
########################################################################
# cleanup
+$dist->clean();
chdir( $cwd );
-use File::Path;
-rmtree( $tmp );
+File::Path::rmtree( $tmp );
# vim:ts=2:sw=2:et:sta
