[Cpan-forum-commit] rev 49 - in trunk: . lib/CPAN lib/CPAN/Forum t

[svn at pti.co.il]

Author: gabor
Date: 2005-02-01 22:25:21 +0200 (Tue, 01 Feb 2005)
New Revision: 49

Modified:
   trunk/Build.PL
   trunk/lib/CPAN/Forum.pm
   trunk/lib/CPAN/Forum/Markup.pm
   trunk/parse.pl
   trunk/t/010-markup.t
Log:
replace hand-made parsing with one with Parse::RecDescent

Modified: trunk/Build.PL
===================================================================
--- trunk/Build.PL	2005-01-25 22:33:46 UTC (rev 48)
+++ trunk/Build.PL	2005-02-01 20:25:21 UTC (rev 49)
@@ -34,6 +34,7 @@
 		'XML::RSS::SimpleGen'                   => 0,  # for, well RSS generation
 		'Mail::Sendmail'                        => 0,  
 		'CGI::Session::SQLite'                  => 0,
+		'Parse::RecDescent'                     => 0,
 	},
 	build_requires => {
 		'Test::WWW::Mechanize'       => 0.02,

Modified: trunk/lib/CPAN/Forum/Markup.pm
===================================================================
--- trunk/lib/CPAN/Forum/Markup.pm	2005-01-25 22:33:46 UTC (rev 48)
+++ trunk/lib/CPAN/Forum/Markup.pm	2005-02-01 20:25:21 UTC (rev 49)
@@ -2,63 +2,54 @@
 use strict;
 use warnings;
 
-use CGI qw(escapeHTML);
+use CGI qw();
+use Parse::RecDescent;
 
 sub new {
 	my ($class) = @_;
-	bless {}, $class;
-}
+	my $self = bless {}, $class;
+	
+	$self->{grammar} = q {
+	entry      : chunk(s) eodata                  { $item[1] }
+	chunk      : marked_html | marked_code        { $item[1] }
 
+	marked_html: html(s)                          { qq(<div class="text">) . join("", @{$item[1]}) . qq(</div>); }
+	html       : text                             { $item[1] } 
+	           | open_b text close_b              { join "", @item[1..$#item] }
+	           | open_i text close_i              { join "", @item[1..$#item] }
+	open_b     : m{<b>}
+	close_b    : m{</b>}
+	open_i     : m{<i>}
+	close_i    : m{</i>}
+	text       : m{[\t\n -;=?-~]+}                {$item[1] }
 
-# will someone simplify this code ??
-sub posting_process {
-	my ($self, $t) = @_;
+	marked_code: open_code code close_code        { join("", @item[1..$#item]) }
+	open_code  : m{<code>}                        { qq(<div class="code">) }
+	close_code : m{</code>}                       { qq(</div>) }
+	code       : m{[\t\n -~]+?(?=</code>)}        { CGI::escapeHTML($item[1]) }
 
-	my ($text, $rest) = split /<code>/, $t, 2;
-	my $ret = $self->text_proc($text);
-	if (not $rest) {
-		if ($t =~ /<code>/) {
-			die "ERR open_code_without_closing\n";
-		} else {
-			return $ret;
-		}
-	}
+	eodata     : m{^\Z}
+	};
 
-	die "ERR open_code_without_closing\n" if $rest !~ m{</code>};
-	my ($code, $more) = split /<\/code>/, $rest, 2;
-	$ret .= $self->code_proc($code);
-	$ret .= $self->posting_process($more) if $more;
-	return $ret;
+	$Parse::RecDescent::skip = '';
+
+	return $self;
 }
 
-
-sub text_proc {
+sub posting_process {
 	my ($self, $text) = @_;
-	die "ERR no_less_sign\n" if $text =~ /</;
-	$self->line_width($text);
-	$text = escapeHTML $text;
-	return qq(<div class="text">$text</div>\n);
-}
 
-sub code_proc {
-	my ($self, $code) = @_;
-	$self->line_width($code);
-	#$code =~ s/</&lt;/g;
-	$code = escapeHTML $code;
-	return qq(<div class="code">$code</div>\n);
+	my $parser = new Parse::RecDescent ($self->{grammar});
+	if (not $parser) {
+		warn "Bad Grammar\n";
+		return;
+	}
+	my $out = $parser->entry($text);
+	return if not defined $out;
+	return join("",@$out);
 }
 
-sub line_width {
-	my ($self, $str) = @_;
-	my @lines = split /\n/, $str;
-	#foreach my $line (@lines) {
-	#	die "ERR line_too_long\n" if length $line > 70;
-	#}
-	return 1;
-}
 
 
-
-
 1;
 

Modified: trunk/lib/CPAN/Forum.pm
===================================================================
--- trunk/lib/CPAN/Forum.pm	2005-01-25 22:33:46 UTC (rev 48)
+++ trunk/lib/CPAN/Forum.pm	2005-02-01 20:25:21 UTC (rev 49)
@@ -1274,10 +1274,8 @@
 	# When the editor first displayed and every time if an error was caught this button will be hidden.
 
 	my $markup = CPAN::Forum::Markup->new();
-	eval {
-		$markup->posting_process($new_text) ;
-	};
-	if ($@) {
+	my $result = $markup->posting_process($new_text) ;
+	if (not defined $result) {
 		push @errors, "text_format";
 		return $self->posts(\@errors);
 	}
@@ -1358,9 +1356,9 @@
 
 	return "" if not $text;
 	my $markup = CPAN::Forum::Markup->new();
-	my $html = eval { $markup->posting_process($text) };
-	if ($@) {
-		warn "Error displaying already accepted text: '$text' $@";
+	my $html = $markup->posting_process($text);
+	if (not defined $html) {
+		warn "Error displaying already accepted text: '$text'";
 		return "Internal Error";
 	}
 	return $html;

Modified: trunk/parse.pl
===================================================================
--- trunk/parse.pl	2005-01-25 22:33:46 UTC (rev 48)
+++ trunk/parse.pl	2005-02-01 20:25:21 UTC (rev 49)
@@ -69,6 +69,7 @@
 	'a<b>c</i>'                => undef,
 	'a<b>c'                    => undef,
 	'a<i>c'                    => undef,
+	'apple<'                   => undef,
 );
 use Data::Dumper;
 

Modified: trunk/t/010-markup.t
===================================================================
--- trunk/t/010-markup.t	2005-01-25 22:33:46 UTC (rev 48)
+++ trunk/t/010-markup.t	2005-02-01 20:25:21 UTC (rev 49)
@@ -45,7 +45,9 @@
 }
 
 foreach my $c (sort keys %fails) {
-	throws_ok {f($c)} $fails{$c}, "OK";
+	my $ret = eval {f($c)};
+	ok(not(defined $ret), "OK");
+	#throws_ok {f($c)} $fails{$c}, "OK";
 }