#!/usr/bin/perl
use strict;
use warnings;
use Test::More "no_plan";
use Test::Exception;
use lib "blib/lib";
use CPAN::Forum::Markup;
my $long = "x234567890" x 6 . "qwertyuiop" x 4;
my $long_new = "x234567890" x 6 . "\n" . "+" . "qwertyuiop" x 4;
my $long2 = "x234567890" x 10 . "abcdef" x 20;
my $long2_new = "x234567890" x 6 . "\n" . "+" . "1234567890" x 4 . "\n" . "+" . "abcdef" x 13 . "\n" . "+" . "abcdef" x 7;
is(CPAN::Forum::Markup::split_rows("some text", 60), "some text");
#is(CPAN::Forum::Markup::split_rows($long, 61), $long_new);
#is(CPAN::Forum::Markup::split_rows($long2, 61), $long2_new);
my $markup = CPAN::Forum::Markup->new();
my $TEXT = '<div class="text">';
my $END = '</div>';
my $CODE = '<div class="code">';
my %cases = (
'apple' => $TEXT . 'apple' . $END,
'apple<code><</code>' => $TEXT . 'apple' . $END . $CODE . '<' . $END,
'apple<code><code></code>' => $TEXT . 'apple' . $END . $CODE . '<code>' . $END,
'x234567890' x 7 => $TEXT . 'x234567890' x 7 . $END,
'x234567890' x 100 => $TEXT . 'x234567890' x 100 . $END,
'Hello world' => $TEXT . 'Hello world' . $END,
'<code>program</code>' => $CODE . 'program' . $END,
'<code><STD></code>' => $CODE . '<STD>' . $END,
'Hello world' => $TEXT . 'Hello world' . $END,
' World' => $TEXT . ' World' . $END,
'apple<code>bob</code>' => $TEXT . 'apple' . $END . $CODE . 'bob' . $END,
'<code>program</code>' => $CODE . 'program' . $END,
'apple<code><</code>' => $TEXT . 'apple' . $END . $CODE . '<' . $END,
'<code> $x < $y </code>' => $CODE . ' $x < $y ' . $END,
'<code><STD></code>' => $CODE . '<STD>' . $END,
'some; strange $%^& text' => $TEXT . 'some; strange $%^& text' . $END,
'<b>bold</b> more text' => $TEXT . '<b>bold</b> more text' . $END,
'a<b>c</b><code>x</code>d' => $TEXT . 'a<b>c</b>' . $END . $CODE . 'x' . $END . $TEXT . 'd' . $END,
'a<b>c</b><code>x</code>d<code>y</code>' => $TEXT . 'a<b>c</b>' . $END . $CODE . 'x' . $END . $TEXT . 'd' . $END . $CODE . 'y' . $END,
'a<i>c</i><code>x</code>d<code>y</code>' => $TEXT . 'a<i>c</i>' . $END . $CODE . 'x' . $END . $TEXT . 'd' . $END . $CODE . 'y' . $END,
'a<b>c</b>d<i>x</i>f' => $TEXT . 'a<b>c</b>d<i>x</i>f' . $END,
'a<B>c</B>d<I>x</I>f' => $TEXT . 'a<b>c</b>d<i>x</i>f' . $END,
'<' => $TEXT . '<' . $END,
'<p>text</p>' => $TEXT . '<p>text</p>' . $END,
'<P>text</P>' => $TEXT . '<p>text</p>' . $END,
'<P>text</p>' => $TEXT . '<p>text</p>' . $END,
'<br />' => $TEXT . '<br />' . $END,
'<br />hello' => $TEXT . '<br />hello' . $END,
'<br>hello' => $TEXT . '<br />hello' . $END,
'<BR>hello' => $TEXT . '<br />hello' . $END,
'<code><P></code>' => $CODE . '<P>' . $END,
'<a href=http://bla>text</a>' => $TEXT . '<a href="http://bla">text</a>' . $END,
'<A href=http://blb>text</a>' => $TEXT . '<a href="http://blb">text</a>' . $END,
'<A HREF=http://blc>text</a>' => $TEXT . '<a href="http://blc">text</a>' . $END,
'<A HREF="http://bld">text</a>' => $TEXT . '<a href="http://bld">text</a>' . $END,
'<A HREF=mailto:a@b.c>addr</a>' => $TEXT . '<a href="mailto:a@b.c">addr</a>' . $END,
'<p>bright <b>new</b> world</p>' => $TEXT . '<p>bright <b>new</b> world</p>' . $END,
);
my %fails = (
'apple<B>' => qr(^ERR no_less_sign$),
'apple<b>' => qr(^ERR no_less_sign$),
'apple< sd' => qr(^ERR no_less_sign$),
'apple<' => qr(^ERR no_less_sign$),
'apple<x' => qr(^ERR no_less_sign$),
'<code >xyz</code>' => qr(^ERR no_less_sign$),
# '1234567890' x 7 . "x" => qr(^ERR line_too_long$),
'apple<code>sd' => qr(^ERR open_code_without_closing$),
"<code>" => qr(^ERR open_code_without_closing$),
"Hello<code>" => qr(^ERR open_code_without_closing$),
'<code>' => undef,
'Hello<code>' => undef,
'<code extra><STD></code>' => undef,
'a<b>c</i>' => undef,
'a<b>c' => undef,
'a<i>c' => undef,
'apple<' => undef,
'<p>text' => undef,
'<a href=htt://bla>text</a>' => undef,
'<a href=javascript>text</a>' => undef,
);
foreach my $c (sort keys %cases) {
lives_ok {f($c)} 'Expected to live';
is(f($c), $cases{$c}, $c);
}
foreach my $c (sort keys %fails) {
my $ret = eval {f($c)};
ok(not(defined $ret), "OK");
#throws_ok {f($c)} $fails{$c}, "OK";
}
my $data = join "", <DATA>;
foreach my $code (split /CODE/, $data) {
#print STDERR $code;
my $out = $markup->posting_process($code);
ok(defined($out), "BIG CODE");
ok(length($out) > length ($code)) or print STDERR $out;
}
sub f {
$markup->posting_process(@_);
}
__DATA__
<code>
#!/usr/bin/perl
open my $fh, ">>", "filename";
while (<$fh>) {
print $x . 'sss';
xxl
}
</code>
CODE
some
<code>
#!/usr/bin/perl
while (<qqrq>) {
more todo
}
1;
</code>
CODE
I am using Parse::RecDescent to validate the input on this forum. Right now it can give OK/NOT OK but I'd like to be a bit more specific. E.g.I'd like to give differen error messages
if there is a not approved HTML tag such as <img> in the text
or if there is an opening tag withou a closing tag
or just a single < mark somewhere