[Cpan-forum-commit] rev 160 - in trunk: . t t/markup t/other

svn at pti.co.il svn at pti.co.il
Fri Aug 25 18:14:21 IDT 2006


Author: gabor
Date: 2006-08-25 18:14:20 +0300 (Fri, 25 Aug 2006)
New Revision: 160

Added:
   trunk/t/markup/
   trunk/t/markup/010-markup.t
   trunk/t/other/
   trunk/t/other/pod-coverage.t
   trunk/t/other/pod.t
Removed:
   trunk/t/010-markup.t
   trunk/t/pod-coverage.t
   trunk/t/pod.t
Modified:
   trunk/
   trunk/Build.PL
   trunk/MANIFEST
   trunk/t/011-register.t
   trunk/t/100-auth.t
Log:
reorganize test files



Property changes on: trunk
___________________________________________________________________
Name: svk:merge
   - 8c4c90e1-83eb-0310-96eb-e7cb62807872:/local/cpan-forum:10980
   + 8c4c90e1-83eb-0310-96eb-e7cb62807872:/local/cpan-forum:10981

Modified: trunk/Build.PL
===================================================================
--- trunk/Build.PL	2006-08-25 15:14:12 UTC (rev 159)
+++ trunk/Build.PL	2006-08-25 15:14:20 UTC (rev 160)
@@ -9,12 +9,13 @@
 
 #my $builder = CPAN::Forum::Build->new(
 my $builder = Module::Build->new(
-    module_name         => 'CPAN::Forum',
-    license             => 'perl',
-    dist_version_from   => 'lib/CPAN/Forum.pm',
-    create_readme       => 1,
-    create_makefile_pl => 'traditional',
-    requires            => {
+    module_name          => 'CPAN::Forum',
+    license              => 'perl',
+    dist_version_from    => 'lib/CPAN/Forum.pm',
+    create_readme        => 1,
+    create_makefile_pl   => 'traditional',
+    recursive_test_files => 1,
+    requires             => {
         'HTML::Template'                        => 2.6,
         'CGI'                                   => 0,
         'CGI::Application'                      => 3.31,

Modified: trunk/MANIFEST
===================================================================
--- trunk/MANIFEST	2006-08-25 15:14:12 UTC (rev 159)
+++ trunk/MANIFEST	2006-08-25 15:14:20 UTC (rev 160)
@@ -24,14 +24,15 @@
 t/CONFIG
 t/000-load.t
 t/001-users.t
-t/010-markup.t
 t/011-register.t
 t/100-auth.t
-t/pod-coverage.t
-t/pod.t
 t/02packages.details.txt
 t/lib/CPAN/Forum/Test.pm
 
+t/markup/010-markup.t
+t/other/pod-coverage.t
+t/other/pod.t
+
 templates/change_password.tmpl
 templates/help.tmpl
 templates/pwreminder.tmpl

Deleted: trunk/t/010-markup.t
===================================================================
--- trunk/t/010-markup.t	2006-08-25 15:14:12 UTC (rev 159)
+++ trunk/t/010-markup.t	2006-08-25 15:14:20 UTC (rev 160)
@@ -1,146 +0,0 @@
-#!/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 . '&lt;' . $END,
-	'apple<code><code></code>' => $TEXT . 'apple' . $END . $CODE . '&lt;code&gt;' . $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 . '&lt;STD&gt;' . $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 . '&lt;' . $END,
-	'<code> $x < $y </code>'   => $CODE . ' $x &lt; $y ' . $END,
-	'<code><STD></code>'       => $CODE . '&lt;STD&gt;' . $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,
-	'&lt;'                     => $TEXT . '&lt;' . $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 . '&lt;P&gt;' . $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 at b.c>addr</a>' => $TEXT . '<a href="mailto:a at 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 &lt;img&gt; in the text 
-or if there is an opening tag withou a closing tag
-or just a single &lt; mark somewhere
-

Modified: trunk/t/011-register.t
===================================================================
--- trunk/t/011-register.t	2006-08-25 15:14:12 UTC (rev 159)
+++ trunk/t/011-register.t	2006-08-25 15:14:20 UTC (rev 160)
@@ -17,64 +17,64 @@
 use CGI::Application::Test;
 use CPAN::Forum;
 my $cat = CGI::Application::Test->new({
-			class   => "CPAN::Forum", 
-			cookie  => "cpanforum", 
-			app     => {
-				TMPL_PATH => "$ROOT/templates",
-				PARAMS => {
-					ROOT => $ROOT,
-				},
-			}});
+            class   => "CPAN::Forum", 
+            cookie  => "cpanforum", 
+            app     => {
+                TMPL_PATH => "$ROOT/templates",
+                PARAMS => {
+                    ROOT => $ROOT,
+                },
+            }});
 
 
 {
-	my $r = $cat->cgiapp(path_info => '/');
-	like($r, qr{CPAN Forum});
+    my $r = $cat->cgiapp(path_info => '/');
+    like($r, qr{CPAN Forum});
 }
 
 {
-	my $r = $cat->cgiapp(path_info => '/register');
-	like($r, qr{Registration Page});
+    my $r = $cat->cgiapp(path_info => '/register');
+    like($r, qr{Registration Page});
 }
 
 {
-	my $r = $cat->cgiapp(path_info => '/', params => {rm => 'register_process', nickname => '', email => ''});
-	like($r, qr{Registration Page});
-	like($r, qr{Need both nickname and password});
+    my $r = $cat->cgiapp(path_info => '/', params => {rm => 'register_process', nickname => '', email => ''});
+    like($r, qr{Registration Page});
+    like($r, qr{Need both nickname and password});
 }
 
 {
-	my $r = $cat->cgiapp(path_info => '/',  params => {rm => 'register_process', nickname => '', email => 'some at email'});
-	like($r, qr{Registration Page});
-	like($r, qr{Need both nickname and password});
+    my $r = $cat->cgiapp(path_info => '/',  params => {rm => 'register_process', nickname => '', email => 'some at email'});
+    like($r, qr{Registration Page});
+    like($r, qr{Need both nickname and password});
 }
 
 {
-	my $r = $cat->cgiapp(path_info => '/', params => {rm => 'register_process', nickname => 'xyz', email => ''});
-	like($r, qr{Registration Page});
-	like($r, qr{Need both nickname and password});
+    my $r = $cat->cgiapp(path_info => '/', params => {rm => 'register_process', nickname => 'xyz', email => ''});
+    like($r, qr{Registration Page});
+    like($r, qr{Need both nickname and password});
 }
 
 {
-	my $r = $cat->cgiapp(path_info => '/', 
-			params => {rm => 'register_process', nickname => 'xyzqwertyuiqwertyuiopqwert', email => 'a at com'});
-	like($r, qr{Registration Page});
-	like($r, qr{Nickname must be lower case alphanumeric between 1-25 characters});
+    my $r = $cat->cgiapp(path_info => '/', 
+            params => {rm => 'register_process', nickname => 'xyzqwertyuiqwertyuiopqwert', email => 'a at com'});
+    like($r, qr{Registration Page});
+    like($r, qr{Nickname must be lower case alphanumeric between 1-25 characters});
 }
 
 # reject bad usernames
 foreach my $username ("ab.c", "Abcde", "asd'er", "ab cd") {
-	my $r = $cat->cgiapp(path_info => '/', 
-			params => {rm => 'register_process', nickname => $username, email => 'a at com'});
-	like($r, qr{Registration Page});
-	like($r, qr{Nickname must be lower case alphanumeric between 1-25 characters});
+    my $r = $cat->cgiapp(path_info => '/', 
+            params => {rm => 'register_process', nickname => $username, email => 'a at com'});
+    like($r, qr{Registration Page});
+    like($r, qr{Nickname must be lower case alphanumeric between 1-25 characters});
 }
 
 # reject bad usernames
 foreach my $email ("adb-?", "Abcde", "asd'er", "ab cd") {
-	my $r = $cat->cgiapp(path_info => '/', params => {rm => 'register_process', nickname => "abcde", email => $email});
-	like($r, qr{Registration Page});
-	like($r, qr{Email must be a valid address writen in lower case letters});
+    my $r = $cat->cgiapp(path_info => '/', params => {rm => 'register_process', nickname => "abcde", email => $email});
+    like($r, qr{Registration Page});
+    like($r, qr{Email must be a valid address writen in lower case letters});
 }
 
 my $pw;
@@ -82,47 +82,47 @@
 my $sendmail_count;
 # register user
 {
-	no warnings;
-	sub CPAN::Forum::sendmail {
-		my %mail = @_;
-		#use Data::Dumper;
-		#print STDERR Dumper \%mail;
-		#print STDERR 
-		if ($mail{Message} =~ /your password is: (\w+)/) {
-			$password = $1;
-		}
-		$sendmail_count++;
-	}
-	use warnings;
+    no warnings;
+    sub CPAN::Forum::sendmail {
+        my %mail = @_;
+        #use Data::Dumper;
+        #print STDERR Dumper \%mail;
+        #print STDERR 
+        if ($mail{Message} =~ /your password is: (\w+)/) {
+            $password = $1;
+        }
+        $sendmail_count++;
+    }
+    use warnings;
 }
 # TODO: check if the call to submail contains the correct values
 {
-	$sendmail_count = 0;
-	$password = '';
-	my $r = $cat->cgiapp(path_info => '/', 
-			params => {rm => 'register_process', nickname => $users[0]{username}, email => $users[0]{email}});
-	like($r, qr{Registration Page});
-	like($r, qr{Thank you for registering});
-	like($password, qr{\w{5}});
+    $sendmail_count = 0;
+    $password = '';
+    my $r = $cat->cgiapp(path_info => '/', 
+            params => {rm => 'register_process', nickname => $users[0]{username}, email => $users[0]{email}});
+    like($r, qr{Registration Page});
+    like($r, qr{Thank you for registering});
+    like($password, qr{\w{5}});
 
-	is($sendmail_count, 2);
-	$pw = $password;
+    is($sendmail_count, 2);
+    $pw = $password;
 }
 
 # try to register the same user again and see it fails
 {
-	$sendmail_count = 0;
-	$password = '';
-	my $r = $cat->cgiapp(path_info => '/', 
-			params => {rm => 'register_process', nickname => $users[0]{username}, email => $users[0]{email}});
-	like($r, qr{Registration Page});
-	like($r, qr{Nickname or e-mail already in use});
-	is($sendmail_count, 0);
-	is($password, "");
+    $sendmail_count = 0;
+    $password = '';
+    my $r = $cat->cgiapp(path_info => '/', 
+            params => {rm => 'register_process', nickname => $users[0]{username}, email => $users[0]{email}});
+    like($r, qr{Registration Page});
+    like($r, qr{Nickname or e-mail already in use});
+    is($sendmail_count, 0);
+    is($password, "");
 }
 
 
-	
+    
 
 
 

Modified: trunk/t/100-auth.t
===================================================================
--- trunk/t/100-auth.t	2006-08-25 15:14:12 UTC (rev 159)
+++ trunk/t/100-auth.t	2006-08-25 15:14:20 UTC (rev 160)
@@ -7,7 +7,7 @@
 my $url = $ENV{CPAN_FORUM_URL};
 
 SKIP: {
-	skip "Need to have CPAN_FORUM_URL to run these tests. See readme", 3 if not defined $url;
+    skip "Need to have CPAN_FORUM_URL to run these tests. See readme", 3 if not defined $url;
 
 my $mech = Test::WWW::Mechanize->new();
 

Added: trunk/t/markup/010-markup.t
===================================================================
--- trunk/t/markup/010-markup.t	2006-08-25 15:14:12 UTC (rev 159)
+++ trunk/t/markup/010-markup.t	2006-08-25 15:14:20 UTC (rev 160)
@@ -0,0 +1,146 @@
+#!/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 . '&lt;' . $END,
+	'apple<code><code></code>' => $TEXT . 'apple' . $END . $CODE . '&lt;code&gt;' . $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 . '&lt;STD&gt;' . $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 . '&lt;' . $END,
+	'<code> $x < $y </code>'   => $CODE . ' $x &lt; $y ' . $END,
+	'<code><STD></code>'       => $CODE . '&lt;STD&gt;' . $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,
+	'&lt;'                     => $TEXT . '&lt;' . $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 . '&lt;P&gt;' . $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 at b.c>addr</a>' => $TEXT . '<a href="mailto:a at 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 &lt;img&gt; in the text 
+or if there is an opening tag withou a closing tag
+or just a single &lt; mark somewhere
+

Added: trunk/t/other/pod-coverage.t
===================================================================
--- trunk/t/other/pod-coverage.t	2006-08-25 15:14:12 UTC (rev 159)
+++ trunk/t/other/pod-coverage.t	2006-08-25 15:14:20 UTC (rev 160)
@@ -0,0 +1,5 @@
+use Test::More tests => 1;
+#eval "use Test::Pod::Coverage 0.08";
+#plan skip_all => "Test::Pod::Coverage 0.08 required for testing POD coverage" if $@;
+#all_pod_coverage_ok();
+ok(1);

Added: trunk/t/other/pod.t
===================================================================
--- trunk/t/other/pod.t	2006-08-25 15:14:12 UTC (rev 159)
+++ trunk/t/other/pod.t	2006-08-25 15:14:20 UTC (rev 160)
@@ -0,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();

Deleted: trunk/t/pod-coverage.t
===================================================================
--- trunk/t/pod-coverage.t	2006-08-25 15:14:12 UTC (rev 159)
+++ trunk/t/pod-coverage.t	2006-08-25 15:14:20 UTC (rev 160)
@@ -1,5 +0,0 @@
-use Test::More tests => 1;
-#eval "use Test::Pod::Coverage 0.08";
-#plan skip_all => "Test::Pod::Coverage 0.08 required for testing POD coverage" if $@;
-#all_pod_coverage_ok();
-ok(1);

Deleted: trunk/t/pod.t
===================================================================
--- trunk/t/pod.t	2006-08-25 15:14:12 UTC (rev 159)
+++ trunk/t/pod.t	2006-08-25 15:14:20 UTC (rev 160)
@@ -1,4 +0,0 @@
-use Test::More;
-eval "use Test::Pod 1.00";
-plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
-all_pod_files_ok();



More information about the Cpan-forum-commit mailing list