use DevHelp::HTML;
use Carp 'confess';
-our $VERSION = "1.006";
+our $VERSION = "1.011";
use constant DEBUG => 0;
# markers to avoid inserting a <p> or </p>
use constant NO_P => "\x02";
use constant NO_CP => "\x03";
+use constant TO_NL => "\x04";
# block tags replaced in some common location
# other block tags with their own replacement should be moved into this too
my @block_tags = qw(div address blockquote article section header footer aside nav figure figcaption);
my $block_tags = join "|", @block_tags;
-my @all_block_tags = ( @block_tags, qw(h1 h2 h3 h4 h5 h6 p) );
+my @all_block_tags = ( @block_tags, qw(h1 h2 h3 h4 h5 h6 p li ol ul) );
my $all_block_tags = join "|", @all_block_tags;
# make a UL
sub _format_bullets {
- my ($text) = @_;
+ my ($self, $text, $extras) = @_;
$text =~ s/^\s+|\s+$//g;
my @points = split /(?:\r?\n)? *\*\*\s*/, $text;
$point =~ s!\n *$!!
and $point = "<p>$point</p>";
}
- return "<ul><li>".join("</li><li>", @points)."</li></ul>";
+ return "\n\n" . NO_P . $self->_tag_with_attrs("ul", $extras) .
+ "<li>".join("</li><li>", @points)."</li></ul>" . NO_CP . "\n\n";
}
# make a OL
sub _format_ol {
- my ($text, $type, $code) = @_;
+ my ($self, $text, $type, $code, $extras) = @_;
print STDERR "_format_ol(..., $type, $code)\n" if DEBUG;
print STDERR "text: ",unpack("H*", $text),"\n" if DEBUG;
$point =~ s!\n *$!!
and $point = "<p>$point</p>";
}
- my $ol = "<ol";
- $ol .= qq! type="$type"! if $type;
- $ol .= ">";
- return "$ol<li>".join("</li><li>", @points)."</li></ol>";
+ my $ol = $self->_tag_with_attrs("ol", $extras);
+ $ol =~ s!>$! type="$type">! if $type;
+ return "\n\n" . NO_P . "$ol<li>".join("</li><li>", @points)."</li></ol>" . NO_CP . "\n\n";
}
sub _format_lists {
- my ($text) = @_;
+ my ($self, $text, $extras) = @_;
my $out = '';
while (length $text) {
if ($text =~ s(^((?: *\#\#[^\n]+(?:\n(?!\*\*|\#\#|\%\%)[^\n]+)*(?:\n *|$)\n?[^\S\n]*)+)\n?)()) {
- $out .= _format_ol($1);
+ $out .= $self->_format_ol($1, undef, undef, $extras);
}
elsif ($text =~ s(^((?: *\*\*[^\n]+(?:\n(?!\*\*|\#\#|\%\%)[^\n]+)*(?:\n *|$)\n?[^\S\n]*)+)\n?)()) {
- $out .= _format_bullets($1);
+ $out .= $self->_format_bullets($1, $extras);
}
elsif ($text =~ s(^((?: *%%[^\n]+(?:\n(?!\*\*|\#\#|\%\%)[^\n]+)*(?:\n *|$)\n?[^\S\n]*)+)\n?)()) {
- $out .= _format_ol($1, 'a', '%%');
+ $out .= $self->_format_ol($1, 'a', '%%', $extras);
}
else {
$out .= $text;
qq/<a href="/ . $self->rewrite_url($url, $text, $type) . qq("$extras>$text</a>)
}
+sub _inline_html {
+ my ($self, $text) = @_;
+
+ $text =~ s/\n/ TO_NL /ge;
+
+ return unescape_html($text);
+}
+
sub replace_char {
my ($self, $rpart) = @_;
$$rpart =~ s#(acronym|abbr|dfn|cite)\[(?:\r?\n)?([^|\]\[]+)\|([^\]\[]+)\|([^\]\[]+?)(?:\r?\n)?\]#
$$rpart =~ s#poplink\[([^|\]\[]+)\]#
$self->link($1, $2, "poplink", qq/ target="_blank"/)#eig
and return 1;
- $$rpart =~ s#^link\[([^|\]\[]+)\|([^\]\[]*\n\s*\n[^\]\[]*)\]$#
- "\n\n" . NO_P . $self->link($1, $self->_blockify($2), "link") . NO_CP . "\n\n" #eigm
+ $$rpart =~ s#link\[([^|\]\[]+)\|([^\]\[]*\n\s*\n[^\]\[]*)\]#
+ "\n\n" . NO_P . $self->link($1, $self->_blockify($2), "link") . NO_CP . "\n\n" #eig
and return 1;
$$rpart =~ s#link\[([^|\]\[]+)\|([^\]\[]+)\]#
$self->link($1, $2, "link")#eig
$$rpart =~ s#fontcolor\[([^|\]\[]+)\|([^\]\[]+)\|([^\]\[]+)\]#
$self->_fix_spanned(qq/<font size="$1" color="$2">/, "</font>", $3)#egi
and return 1;
+ $$rpart =~ s#(\n\r?|\A)html\[([^\]\[]*)\](\n\r?|\z)#
+ $1 . NO_P . $self->_inline_html($2) . NO_CP . $3 #eg
+ and return 1;
+ $$rpart =~ s#\s?\bhtml\[([^\]\[]*)\]# $self->_inline_html($1) #eg
+ and return 1;
$$rpart =~ s!(?<=\W)\[([^\]\[]+)\]![$1]!g
and return 1;
$body = $self->escape($body);
my $out = '';
- for my $part (split /((?:html\[(?:[^\[\]]*(?:(?:\[[^\[\]]*\])[^\[\]]*)*)\])
+ for my $part (split /((?:raw\[(?:[^\[\]]*(?:(?:\[[^\[\]]*\])[^\[\]]*)*)\])
|embed\[(?:[^,\[\]]*)(?:,(?:[^,\[\]]*)){0,2}\]
|pre\[(?:[^\[\]]*(?:(?:\[[^\[\]]*\])[^\[\]]*)*)\])/ix, $body) {
#print STDERR "Part is $part\n";
- if ($part =~ /^html\[([^\[\]]*(?:(?:\[[^\[\]]*\])[^\[\]]*)*)\]$/i) {
+ if ($part =~ /^raw\[([^\[\]]*(?:(?:\[[^\[\]]*\])[^\[\]]*)*)\]$/i) {
$out .= _make_html($1);
}
elsif ($part =~ /^embed\[([^,\[\]]*),([^,\[\]]*),([^,\[\]]*)\]$/i) {
and next TRY;
$self->replace_char(\$part)
and next TRY;
+ $part =~ s#image\[([^\]\[]+)\]# $self->image($1) #ige
+ and next TRY;
+ $part =~ s#class\[([^\]\[\|]+)\|([^\]\[]+)\]#
+ $self->_fix_spanned(qq/<span class="$1">/, "</span>", $2)#eig
+ and next TRY;
+ $part =~ s#style\[([^\]\[\|]+)\|([^\]\[]+)\]#
+ $self->_fix_spanned(qq/<span style="$1">/, "</span>", $2)#eig
+ and next TRY;
$part =~ s#pre\[([^\]\[]+)\]#<pre>$1</pre>#ig
and next TRY;
$part =~ s#h([1-6])\[([^\[\]\|]+)\|([^\[\]]+)\](?:\r?\n)?#
and next TRY;
$part =~ s#table\[([^\]\[]+)\|([^\]\[|]+)\]#_make_table($1, "|$2")#ieg
and next TRY;
+ $part =~ s# ?\blist\[([^\]\[\|]*)\|\s*(\S[^\]\[]+)\]#
+ "\n\n" . $self->_format_lists($2, $1) #eg
+ and next TRY;
#print STDERR "step: ",unpack("H*", $part),"\n$part\n";
+ $part =~ s#indent\[([^\]\[]+)\]#\n\n\x02<div class="indent">$1</div>\x03\n\n#ig
+ and next TRY;
+ $part =~ s#center\[([^\]\[]+)\]#<center>$1</center>#ig
+ and next TRY;
+ $part =~ s#hrcolor\[([^|\]\[]+)\|([^\]\[]+)\|([^\]\[]+)\]#<table width="$1" height="$2" border="0" bgcolor="$3" cellpadding="0" cellspacing="0"><tr><td><img src="/images/trans_pixel.gif" width="1" height="1" alt="" /></td></tr></table>#ig
+ and next TRY;
$part =~ s((?:^|\n+|\G)
( # capture
(?: # an item
[^\S\n]* # and any extra non-newline whitespace
)
+ # one or more times
- )(\n|$)?)("\n\n"._format_lists($1)."\n\n")egx
- and next TRY;
- $part =~ s#indent\[([^\]\[]+)\]#<ul>$1</ul>#ig
- and next TRY;
- $part =~ s#center\[([^\]\[]+)\]#<center>$1</center>#ig
- and next TRY;
- $part =~ s#hrcolor\[([^|\]\[]+)\|([^\]\[]+)\|([^\]\[]+)\]#<table width="$1" height="$2" border="0" bgcolor="$3" cellpadding="0" cellspacing="0"><tr><td><img src="/images/trans_pixel.gif" width="1" height="1" alt="" /></td></tr></table>#ig
- and next TRY;
- $part =~ s#image\[([^\]\[]+)\]# $self->image($1) #ige
- and next TRY;
- $part =~ s#class\[([^\]\[\|]+)\|([^\]\[]+)\]#
- $self->_fix_spanned(qq/<span class="$1">/, "</span>", $2)#eig
- and next TRY;
- $part =~ s#style\[([^\]\[\|]+)\|([^\]\[]+)\]#
- $self->_fix_spanned(qq/<span style="$1">/, "</span>", $2)#eig
+ )(\n|$)?)("\n\n".$self->_format_lists($1)."\n\n")egx
and next TRY;
$part =~ s#($block_tags)\[([^\[\]\|]+)\|([^\[\]]+?)\]# $self->_block($self->_tag_with_attrs($1, $2), $3, "</$1>")#eig
and next TRY;
$part =~ s#[\x02\x03]##g;
1 while $part =~ s/<p>(<div(?: [^>]*)?>)/$1\n<p>/g;
1 while $part =~ s!</div></p>!</p>\n</div>!g;
- #1 while $part =~ s/<p>(<address(?: [^>]*)?>)/$1\n<p>/g;
- #1 while $part =~ s!</address></p>!</p>\n</address>!g;
- #1 while $part =~ s/<p>(<blockquote(?: [^>]*)?>)/$1\n<p>/g;
- #1 while $part =~ s!</blockquote></p>!</p>\n</blockquote>!g;
- #1 while $part =~ s/<p>(<article(?: [^>]*)?>)/$1\n<p>/g;
- #1 while $part =~ s!</article></p>!</p>\n</article>!g;
- #1 while $part =~ s/<p>(<section(?: [^>]*)?>)/$1\n<p>/g;
- #1 while $part =~ s!</section></p>!</p>\n</section>!g;
- #1 while $part =~ s/<p>(<header(?: [^>]*)?>)/$1\n<p>/g;
- #1 while $part =~ s!</header></p>!</p>\n</header>!g;
- #1 while $part =~ s/<p>(<footer(?: [^>]*)?>)/$1\n<p>/g;
- #1 while $part =~ s!</footer></p>!</p>\n</footer>!g;
- #1 while $part =~ s/<p>(<aside(?: [^>]*)?>)/$1\n<p>/g;
- #1 while $part =~ s!</aside></p>!</p>\n</aside>!g;
- #1 while $part =~ s/<p>(<nav(?: [^>]*)?>)/$1\n<p>/g;
- #1 while $part =~ s!</nav></p>!</p>\n</nav>!g;
- #1 while $part =~ s/<p>(<figure(?: [^>]*)?>)/$1\n<p>/g;
- #1 while $part =~ s!</figure></p>!</p>\n</figure>!g;
- #1 while $part =~ s/<p>(<figcaption(?: [^>]*)?>)/$1\n<p>/g;
- #1 while $part =~ s!</figcaption></p>!</p>\n</figcaption>!g;
- # remove unwanted paras from links spanning blocks
- #1 while $part =~ s!<p>(<a\s[^>]+>)</p>!$1!g;
- #1 while $part =~ s!<p></a></p>!</a>!g;
- #1 while $part =~ s! ?(<a\s[^>]+>)</p>!</p>\n$1!g;
- # wrap links spanning paras
- #1 while $part =~ s!<p>(<a\s[^>]+>)(.*?)</p>!$1<p>$2</p>!g;
- #1 while $part =~ s!<p>(.*?)</a></p>!<p>$1</p></a>!g;
- #1 while $part =~ s#(</(?:$all_block_tags)>)(<(?:h[1-6]|$block_tags))#$1\n$2#g;
+ 1 while $part =~ s!\s+?</p>!</p>!g;
1 while $part =~ s#</($all_block_tags)><#</$1>\n<#g;
1 while $part =~ s#(<(?:$all_block_tags)[^>]*>)(<(?:$all_block_tags)\b)#$1\n$2#g;
1 while $part =~ s#(</a>)(<a\s+[^>]*>)(<(?:$all_block_tags))#$1\n$2\n$3#g;
1 while $part =~ s#(<a\s+[^>]*>)(<(?:$all_block_tags))#$1\n$2#g;
+ 1 while $part =~ s#(</a>)(<(?:$all_block_tags)\b)#$1\n$2#g;
1 while $part =~ s#(>)(<hr\b[^>]*/>)#$1\n$2#g;
1 while $part =~ s#(<hr\b[^>]*/>)(<)#$1\n$2#g;
#$part =~ s!<p>(<hr[^>]*>)</p>!$1!g;
$part =~ s!(</(?:table|ol|ul|center|h[1-6])>)</p>!$1!g;
# attempts to convert class[name|paragraph] into <p class="name">...
# tried to use a negative lookahead but it wouldn't work
- $part =~ s#(<p><span class="([^"<>]+)">(.*?)</span></p>)#
- my ($one, $two, $three)= ($1, $2, $3);
- $3 =~ /<span/ ? $one : qq!<p class="$two">$three</p>!#ge;
- $part =~ s#(<p><span style="([^"<>]+)">(.*?)</span></p>)#
- my ($one, $two, $three)= ($1, $2, $3);
- $3 =~ /<span/ ? $one : qq!<p style="$two">$three</p>!#ge;
+ $part =~ s#<(p\b[^>]*)><span\ class="([^"<>]+)">(.*?)</span></p>
+ #<$1 class="$2">$3</p>#xg;
+ $part =~ s#<(p\b[^>]*)><span\ style="([^"<>]+)">(.*?)</span></p>
+ #<$1 style="$2">$3</p>#xg;
if (my $p_class = $self->tag_class('p')) {
$part =~ s!(<p(?: style="[^"<>]+")?)>!$1 class="$p_class">!g;
}
#$part =~ s!\n!<br />!g;
1 while $part =~ s#(</(?:$all_block_tags)>)(</(?:$all_block_tags))#$1\n$2#g;
+ my $to_nl = TO_NL;
+ $part =~ s/$to_nl/\n/g;
$out .= $part;
}
}
and next TRY;
$part =~ s#table\[([^\]\[]+)\|([^\]\[|]+)\]#_cleanup_table($1, "|$2")#ieg
and next TRY;
+ $part =~ s# ?\blist\[([^\]\[\|]*)\|\s*(\S[^\]\[]+)\]#$2#g
+ and next TRY;
$part =~ s#\*\*([^\n]+)#$1#g
and next TRY;
$part =~ s!##([^\n]+)!$1!g
projects / bse.git / blobdiff