Crazy stuff here
__W__ Crazy stuff here __NEXT__ strip scripts __H__benevolent text
__W__ benevolent text END_TESTS sub runtests { my %arg = @_; $arg{wrap_in_html} = 1; $arg{base_uri} ||= 'http://www.test.com'; my $minimal = $arg{minimal} || 0; my $data = $arg{data} || ''; $data .= entity_tests() . $more_tests unless $minimal; my @tests = split /__NEXT__\n/, $data; my $numtests = @tests; #$numtests += 1 unless $minimal; # file test plan tests => $numtests; # Delete unrecognized HTML::WikiConverter options delete $arg{$_} for qw/ data minimal /; my $wc = new HTML::WikiConverter(%arg); foreach my $test ( @tests ) { $test =~ s/^(.*?)\n//; my $name = $1; my( $html, $wiki ) = split /__W__\n/, $test; $html =~ s/__H__\n//; $name =~ s{\s*\:\:(\w+\([^\)]*?\))}{ my $method_call = $1; eval "\$wc->$method_call;"; die "Failed test call ($name): $@" if $@; ''; }ge; for( $html, $wiki ) { s/^\n+//; s/\n+$// } is( $wc->html2wiki($html), $wiki, $name ); } #file_test($wc) unless $minimal; } sub entity_tests { my $tmpl = "__NEXT__\n%s\n__H__\n%s\n__W__\n%s\n"; # test-name, html-input, expected-wiki-output my $data = ''; my @chars = ( '<', '>', '&' ); foreach my $char ( @chars ) { ( my $charname = e($char) ) =~ s/[&;]//g; $data .= sprintf $tmpl, "literal ($charname)", $char, e($char) . sprintf $tmpl, "encode ($charname)", e($char), e($char) . sprintf $tmpl, "meta ($charname)", e(e($char)), e(e($char)); } return $data; } sub _slurp { my $path = shift; open H, $path or die "couldn't open $path: $!"; local $/; my $c =thing |
one |
two |
Table with alignment | ||
---|---|---|
right | center | left |
left | right | center |
xxxxxxxxxxxx | xxxxxxxxxxxx | xxxxxxxxxxxx |
Heading 1 | Heading 2 | Heading 3 |
---|---|---|
Row 1 Col 1 | Row 1 Col 2 | Row 1 Col 3 |
Row 2 Col 1 | some colspan (note the double pipe) | |
Row 3 Col 1 | Row 2 Col 2 | Row 2 Col 3 |
name | foo |
---|---|
age | 3.14 |
odd | true |
one__W__ > one __NEXT__ blockquote (nested) __H__
__W__ >> two __NEXT__ blockquote (multi-line) __H__two
span single line__W__ > span single line __NEXT__ blockquote (nested multi-line) __H__
__W__ >> span single line __NEXT__ blockquote (markup) __H__span single line
with fancy markup that spans multiple lines__W__ > **with** //fancy markup// that __spans multiple lines__ __NEXT__ blockquote (nested continuous) __H__
one__W__ > one >> two __NEXT__ blockquote (doubly nested continuous) __H__two
one__W__ > one >> two >>> three __NEXT__ blockquote (linebreak) __H__twothree
line__W__ > line\\ break __NEXT__ blockquote (full) __H__
break
No we shouldn't
Well, I say we should
Really?
Yes!
__W__ > No we shouldn't >> Well, I say we should > Really? >> Yes! >>> Then lets do it! __NEXT__ internal link (lcase) __H__ test __W__ [[test]] __NEXT__ internal link (ucase) __H__ TEST __W__ [[TEST]] __NEXT__ internal link (camel case) __H__ tEsT __W__ tEsT __NEXT__ external link (anonymous) __H__ http://www.test.com __W__ http://www.test.com __NEXT__ external link (named) __H__ test __W__ [[http://www.test.com|test]] __NEXT__ external link (fragment) __H__ this Section __W__ [[syntax#internal|this Section]] __NEXT__ linebreak __H__ lineThen lets do it!
CamelCase links are fun.
into this DokuWiki markup: CamelCase links are fun. Disabling CamelCase links (the default) would convert that HTML into [[CamelCase]] links are fun. =cut sub attributes { { camel_case => { default => 0 } } } sub rules { my %rules = ( b => { start => '**', end => '**' }, strong => { alias => 'b' }, i => { start => '//', end => '//' }, em => { alias => 'i' }, u => { start => '__', end => '__' }, tt => { start => '"', end => '"' }, code => { alias => 'tt' }, a => { replace => \&_link }, img => { replace => \&_image }, pre => { line_format => 'blocks', line_prefix => ' ', block => 1 }, blockquote => { start => "\n", line_prefix => '>', block => 1, line_format => 'multi', trim => 'leading' }, p => { block => 1, trim => 'both', line_format => 'multi' }, br => { replace => "\\\\ " }, hr => { replace => "\n----\n" }, sup => { preserve => 1 }, sub => { preserve => 1 }, del => { preserve => 1 }, ul => { line_format => 'multi', block => 1, line_prefix => ' ' }, ol => { alias => 'ul' }, li => { line_format => 'multi', start => \&_li_start, trim => 'leading' }, table => { block => 1 }, tr => { start => "\n", line_format => 'single' }, td => { start => \&_td_start, end => \&_td_end, trim => 'both' }, th => { alias => 'td' }, ); for( 1..5 ) { my $str = ( '=' ) x (7 - $_ ); $rules{"h$_"} = { start => "$str ", end => " $str", block => 1, trim => 'both', line_format => 'single' }; } $rules{h6} = { start => '== ', end => ' ==', block => 1, trim => 'both', line_format => 'single' }; return \%rules; } sub postprocess_output { my( $self, $outref ) = @_; $$outref =~ s~^>+\s+~~gm; # rm empty blockquote prefixes $$outref =~ s~^(>+)~$1 ~gm; # add space after prefix for clarity } sub _li_start { my( $self, $node, $rules ) = @_; my @parent_lists = $node->look_up( _tag => qr/ul|ol/ ); my $bullet = ''; $bullet = '*' if $node->parent->tag eq 'ul'; $bullet = '-' if $node->parent->tag eq 'ol'; return "\n$bullet "; } sub _link { my( $self, $node, $rules ) = @_; my $url = $node->attr('href') || ''; my $text = $self->get_elem_contents($node) || ''; if( my $title = $self->get_wiki_page($url) ) { # [[MiXed cAsE]] ==> MiXed cAsE $title =~ s/_/ /g; return $text if $self->camel_case and lc $title eq lc $text and $self->is_camel_case($text); return "[[$text]]" if lc $text eq lc $title; return "[[$title|$text]]"; } else { return $url if $url eq $text; return "[[$url|$text]]"; } } sub _image { my( $self, $node, $rules ) = @_; my $src = $node->attr('src') || ''; return '' unless $src; my $w = $node->attr('width') || 0; my $h = $node->attr('height') || 0; if( $w and $h ) { $src .= "?${w}x${h}"; } elsif( $w ) { $src .= "?${w}"; } my $class = $node->attr('class') || ''; my $padleft = $class eq 'mediaright' || $class eq 'mediacenter' ? ' ' : ''; my $padright = $class eq 'medialeft' || $class eq 'mediacenter' ? ' ' : ''; $src = "$padleft$src$padright"; # All images considered external my $caption = $node->attr('title') || $node->attr('alt') || ''; return "{{$src|$caption}}" if $caption; return "{{$src}}"; } sub _td_start { my( $self, $node, $rules ) = @_; my $prefix = $node->tag eq 'th' ? '^' : '|'; $prefix .= ' '; my $class = $node->attr('class') || ''; $prefix .= ' ' if $class eq 'rightalign' or $class eq 'centeralign'; return $prefix; } sub _td_end { my( $self, $node, $rules ) = @_; my $end = ' '; my $class = $node->attr('class') || ''; $end .= ' ' if $class eq 'leftalign' or $class eq 'centeralign'; my $colspan = $node->attr('colspan') || 1; my @right_cells = grep { $_->tag && $_->tag =~ /th|td/ } $node->right; return $end if $colspan == 1 and @right_cells; my $suffix = $node->tag eq 'th' ? '^' : '|'; $suffix = ( $suffix ) x $colspan; return $end.$suffix; } =head1 AUTHOR David J. Iberri, C<<