Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Make Pod::Walker a role, adjust tests accordingly
  • Loading branch information
@Mouq
Mouq committed Jul 9, 2014
1 parent 0c20315 commit b32599c
Show file tree
Hide file tree
Showing 3 changed files with 79 additions and 104 deletions.
92 changes: 35 additions & 57 deletions lib/Pod/Walker.pm6
View file
Expand Up @@ -2,59 +2,37 @@

use v6;

sub def_callee($text, *@a, *%b) {
$text;
}
role Pod::Walker;

class Walker::Callees {
has %!funcs;
has %!funcs;

has $.debug = False;
has $.debug = False;

submethod BUILD(:$!debug, *%OPTS) {
for <para named comment code declarator table fcode heading item config plain> {
%!funcs{$_} = %OPTS{$_} // &def_callee;
}
}
method debug-ON { $!debug = True; }
method debug-OFF { $!debug = False; }

method new(:$debug = False, :&para, :&named, :&comment, :&code, :&declarator,
:&table, :&fcode, :&heading, :&item, :&config, :&plain) {
self.bless(:$debug, :&para, :&named, :&comment, :&code,
:&declarator, :&table, :&fcode, :&heading,
:&item, :&config, :&plain);
}

method debug-ON { $!debug = True; }
method debug-OFF { $!debug = False; }

method set-para(&f) { %!funcs<para> = &f; }
method set-named(&f) { %!funcs<named> = &f; }
method set-comment(&f) { %!funcs<comment> = &f; }
method set-code(&f) { %!funcs<code> = &f; }
method set-declarator(&f) { %!funcs<declarator> = &f; }
method set-table(&f) { %!funcs<table> = &f; }
method set-fcode(&f) { %!funcs<fcode> = &f; }
method set-heading(&f) { %!funcs<heading> = &f; }
method set-item(&f) { %!funcs<item> = &f; }
method set-config(&f) { %!funcs<config> = &f; }
method set-plain(&f) { %!funcs<plain> = &f; }

method para(|a) { note "Called para" if $!debug; %!funcs<para>\ .(|a) }
method named(|a) { note "Called named" if $!debug; %!funcs<named>\ .(|a) }
method comment(|a) { note "Called comment" if $!debug; %!funcs<comment>\ .(|a) }
method code(|a) { note "Called code" if $!debug; %!funcs<code>\ .(|a) }
method declarator(|a) { note "Called declarator" if $!debug; %!funcs<declarator>.(|a) }
method table(|a) { note "Called table" if $!debug; %!funcs<table>\ .(|a) }
method fcode(|a) { note "Called fcode" if $!debug; %!funcs<fcode>\ .(|a) }
method heading(|a) { note "Called heading" if $!debug; %!funcs<heading>\ .(|a) }
method item(|a) { note "Called item" if $!debug; %!funcs<item>\ .(|a) }
method config(|a) { note "Called config" if $!debug; %!funcs<config>\ .(|a) }
method plain(|a) { note "Called plain" if $!debug; %!funcs<plain>\ .(|a) }
method pod-default($text, *@a, *%b) {
$text;
}
method pod-para(|a) { note "Called para" if $!debug; self.pod-default(|a) }
method pod-named(|a) { note "Called named" if $!debug; self.pod-default(|a) }
method pod-comment(|a) { note "Called comment" if $!debug; self.pod-default(|a) }
method pod-code(|a) { note "Called code" if $!debug; self.pod-default(|a) }
method pod-declarator(|a) { note "Called declarator" if $!debug; self.pod-default(|a) }
method pod-table(|a) { note "Called table" if $!debug; self.pod-default(|a) }
method pod-fcode(|a) { note "Called fcode" if $!debug; self.pod-default(|a) }
method pod-heading(|a) { note "Called heading" if $!debug; self.pod-default(|a) }
method pod-item(|a) { note "Called item" if $!debug; self.pod-default(|a) }
method pod-config(|a) { note "Called config" if $!debug; self.pod-default(|a) }
method pod-plain(|a) { note "Called plain" if $!debug; self.pod-default(|a) }

method pod-walk(|a) {
return pod-walk(self, |a)
}

# I know Pod::Config !~~ Pod::Block, but hopefully you're not using one as a
# top-level node anyway :) .
sub pod-walk(Walker::Callees $wc, Pod::Block $START) is export {
sub pod-walk(Pod::Walker $wc, Pod::Block $START) is export {
return pw-recurse($wc, $START, 0);
}

Expand All @@ -73,43 +51,43 @@ proto sub pw-recurse($wc, $node, $level) {
}

multi sub pw-recurse($wc, Pod::Block::Para $node, $level) {
$wc.para(@*TEXT);
$wc.pod-para(@*TEXT);
}

multi sub pw-recurse($wc, Pod::Block::Named $node, $level) {
$wc.named(@*TEXT, $node.name);
$wc.pod-named(@*TEXT, $node.name);
}

multi sub pw-recurse($wc, Pod::Block::Comment $node, $level) {
$wc.comment(@*TEXT);
$wc.pod-comment(@*TEXT);
}

multi sub pw-recurse($wc, Pod::Block::Code $node, $level) {
$wc.code(@*TEXT);
$wc.pod-code(@*TEXT);
}

multi sub pw-recurse($wc, Pod::Block::Declarator $node, $level) {
$wc.declarator(@*TEXT, $node.WHEREFORE);
$wc.pod-declarator(@*TEXT, $node.WHEREFORE);
}

multi sub pw-recurse($wc, Pod::Block::Table $node, $level) {
$wc.table(@*TEXT, $node.headers, $node.caption);
$wc.pod-table(@*TEXT, $node.headers, $node.caption);
}

multi sub pw-recurse($wc, Pod::FormattingCode $node, $level) {
$wc.fcode(@*TEXT, $node.type, $node.meta);
$wc.pod-fcode(@*TEXT, $node.type, $node.meta);
}

multi sub pw-recurse($wc, Pod::Heading $node, $level) {
$wc.heading(@*TEXT, $node.level // Any);
$wc.pod-heading(@*TEXT, $node.level // Any);
}

multi sub pw-recurse($wc, Pod::Item $node, $level) {
$wc.item(@*TEXT, $node.level // Any);
$wc.pod-item(@*TEXT, $node.level // Any);
}

multi sub pw-recurse($wc, Pod::Config $node, $level) {
$wc.item($node.type, $node.config);
$wc.pod-item($node.type, $node.config);
}

multi sub pw-recurse($wc, @olditems, $level) {
Expand All @@ -120,5 +98,5 @@ multi sub pw-recurse($wc, @olditems, $level) {

# XXX replace with "Stringy $node" when appropriate
multi sub pw-recurse($wc, Str $node, $level) {
$wc.plain($node);
}
$wc.pod-plain($node);
}
51 changes: 26 additions & 25 deletions t/conv_class.t
View file
Expand Up @@ -3,22 +3,23 @@
use v6;
use Test;
use Pod::Walker;
plan 21;

my $def = Walker::Callees.new;
my $def = Pod::Walker.new;

is $def.para("foo"), "foo", "Default &para is the identity function.";
is $def.named("foo"), "foo", "Default &named is the identity function.";
is $def.comment("foo"), "foo", "Default &comment is the identity function.";
is $def.code("foo"), "foo", "Default &code is the identity function.";
is $def.declarator("foo"), "foo", "Default &declarator is the identity function.";
is $def.table("foo"), "foo", "Default &table is the identity function.";
is $def.fcode("foo"), "foo", "Default &fcode is the identity function.";
is $def.heading("foo"), "foo", "Default &heading is the identity function.";
is $def.item("foo"), "foo", "Default &item is the identity function.";
is $def.config("foo"), "foo", "Default &config is the identity function.";
is $def.plain("foo"), "foo", "Default &plain is the identity function.";
is $def.pod-para("foo"), "foo", "Default &para is the identity function.";
is $def.pod-named("foo"), "foo", "Default &named is the identity function.";
is $def.pod-comment("foo"), "foo", "Default &comment is the identity function.";
is $def.pod-code("foo"), "foo", "Default &code is the identity function.";
is $def.pod-declarator("foo"), "foo", "Default &declarator is the identity function.";
is $def.pod-table("foo"), "foo", "Default &table is the identity function.";
is $def.pod-fcode("foo"), "foo", "Default &fcode is the identity function.";
is $def.pod-heading("foo"), "foo", "Default &heading is the identity function.";
is $def.pod-item("foo"), "foo", "Default &item is the identity function.";
is $def.pod-config("foo"), "foo", "Default &config is the identity function.";
is $def.pod-plain("foo"), "foo", "Default &plain is the identity function.";

is $def.para("foo", "bar"), "foo", "Default function eats additional arguments";
is $def.pod-para("foo", "bar"), "foo", "Default function eats additional arguments";

{
class FAKE::ERR {
Expand All @@ -35,17 +36,17 @@ is $def.para("foo", "bar"), "foo", "Default function eats additional arguments";

is $def.debug, False, "Class not set to debug by default.";

$def.para("foo");
$def.pod-para("foo");
is $*ERR.text, '', "Default function does not emit debug info by default.";
$*ERR.clear;

my $d2 = Walker::Callees.new(:debug);
my $d2 = Pod::Walker.new(:debug);

is $d2.debug, True, "New class with :debug successfully set to debug.";

my $out = "Called para\n";

$d2.para("foo", "bar", :baz);
$d2.pod-para("foo", "bar", :baz);
is $*ERR.text, $out, "Default function in debug-based class emits debug info.";
$*ERR.clear;

Expand All @@ -58,14 +59,14 @@ is $def.para("foo", "bar"), "foo", "Default function eats additional arguments";
sub foo($thing, :$debug) { $thing.uc };
sub bar($thing, :$debug) { $thing.lc };

my $d3 = Walker::Callees.new(:para(&foo));
my $d3 = (class :: does Pod::Walker { method pod-para(|a) { foo(|a) } }).new;

is $d3.para("Hello"), "HELLO", "Can assign function to name on initialization.";
is $d3.code("Hello"), "Hello", "Other functions stay at default.";
is $d3.item("Hello"), "Hello", "Other functions stay at default.";
is $d3.pod-para("Hello"), "HELLO", "Can assign function to name on initialization.";
is $d3.pod-code("Hello"), "Hello", "Other functions stay at default.";
is $d3.pod-item("Hello"), "Hello", "Other functions stay at default.";

$d3.set-code(&bar);

is $d3.para("Hello"), "HELLO", "Function assigned at init still there after post-init assignment.";
is $d3.code("Hello"), "hello", "Function assignment post-init works.";
is $d3.item("Hello"), "Hello", "Other functions stay at default.";
#$d3.set-code(&bar);
#
#is $d3.para("Hello"), "HELLO", "Function assigned at init still there after post-init assignment.";
#is $d3.code("Hello"), "hello", "Function assignment post-init works.";
#is $d3.item("Hello"), "Hello", "Other functions stay at default.";
40 changes: 18 additions & 22 deletions t/walker.t
View file
Expand Up @@ -4,6 +4,7 @@ use v6;
use Test;

use Pod::Walker;
plan 1;

my $podblock = Pod::Block::Named.new(
name => "pod",
Expand Down Expand Up @@ -69,31 +70,26 @@ BLOCK[TITLE][
]
EOS

sub namedConv(@text, $name) {
"BLOCK[$name][\n{[~] @text}\n]";
}
my class Pod::To::Bracketed does Pod::Walker {
method pod-named(@text, $name) {
"BLOCK[$name][\n{[~] @text}\n]";
}

sub paraConv(@text) {
"¶[{[~] @text}]";
}
method pod-para(@text) {
"¶[{[~] @text}]";
}

sub headingConv(@text, $level) {
"H[$level][{[~] @text}]\n";
}
method pod-heading(@text, $level) {
"H[$level][{[~] @text}]\n";
}

sub plainConv($text) {
$text;
}
method pod-plain($text) {
$text;
}

sub fcodeConv(@text, $type, @meta) {
"\{$type|{[~] @text}}"
method pod-fcode(@text, $type, @meta) {
"\{$type|{[~] @text}}"
}
}

my $wc = Walker::Callees.new;
$wc.set-named(&namedConv);
$wc.set-para(&paraConv);
$wc.set-heading(&headingConv);
$wc.set-plain(&plainConv);
$wc.set-fcode(&fcodeConv);

is pod-walk($wc, $podblock), $output, "Tree walked successfully.";
is Pod::To::Bracketed.new.pod-walk($podblock), $output, "Tree walked successfully.";

0 comments on commit b32599c

Please sign in to comment.