#!/usr/bin/env perl
# ====================[ usemod.pl ]====================
use strict;
use v5.10;
AddModuleDescription('usemod.pl', 'Usemod Markup Extension');
our ($q, $bol, %RuleOrder, @MyRules, @MyInitVariables, $PortraitSupportColor, $PortraitSupportColorDiv);
our ($RFCPattern, $ISBNPattern, @HtmlTags, $HtmlTags, $HtmlLinks, $RawHtml,
$UseModSpaceRequired, $UseModExtraSpaceRequired, $UseModMarkupInTitles);
push(@MyRules, \&UsemodRule);
# The ---- rule conflicts with the --- rule in markup.pl and portrait-support.pl
# The == heading rule conflicts with the same rule in portrait-support.pl
# The : indentation rule conflicts with a similar rule in portrait-support.pl
$RuleOrder{\&UsemodRule} = 100;
$RFCPattern = 'RFC\\s?(\\d+)';
$ISBNPattern = 'ISBN:?([0-9- xX]{10,14})';
$HtmlLinks = 0; # 1 = desc is a link
$RawHtml = 0; # 1 = allow environment for raw HTML inclusion
@HtmlTags = (); # List of HTML tags. If not set, determined by $HtmlTags
$HtmlTags = 0; # 1 = allow some 'unsafe' HTML tags
$UseModSpaceRequired = 1; # 1 = require space after * # : ; for lists.
$UseModMarkupInTitles = 0; # 1 = may use links and other markup in ==titles==
$UseModExtraSpaceRequired = 0; # 1 = require space before : in definition lists
# do this later so that the user can customize some vars
push(@MyInitVariables, \&UsemodInit);
sub UsemodInit {
if (not @HtmlTags) { # do not override settings in the config file
if ($HtmlTags) { # allow many tags
@HtmlTags = qw(b i u font big small sub sup h1 h2 h3 h4 h5 h6 cite code
em s strike strong tt var div center blockquote ol ul dl
table caption br p hr li dt dd tr td th);
} else { # only allow a very small subset
@HtmlTags = qw(b i u em strong tt);
}
}
}
my $UsemodHtmlRegExp;
my $rowcount;
sub UsemodRule {
$UsemodHtmlRegExp = join('|',(@HtmlTags)) unless $UsemodHtmlRegExp;
# for monospaced, preformatted and escaped
if ($bol && m/\G<pre>\n?(.*?\n)<\/pre>[ \t]*\n?/cgs) {
return CloseHtmlEnvironments() . $q->pre({-class=>'real'}, $1) . AddHtmlEnvironment('p');
}
# for monospaced and escaped
elsif (m/\G\<code\>(.*?)\<\/code\>/cgis) { return $q->code($1); }
# for escaped
elsif (m/\G\<nowiki\>(.*?)\<\/nowiki\>/cgis) { return $1; }
# whitespace for monospaced, preformatted and escaped, all clean
# note that ([ \t]+(.+\n)*.*) seems to crash very long blocks (2000 lines and more)
elsif ($bol && m/\G(\s*\n)*([ \t]+.+)\n?/cg) {
my $str = $2;
while (m/\G([ \t]+.*)\n?/cg) {
$str .= "\n" . $1;
}
return OpenHtmlEnvironment('pre',1) . $str; # always level 1
}
# unumbered lists using *
elsif ($bol && m/\G(\s*\n)*(\*+)[ \t]{$UseModSpaceRequired,}/cg
or InElement('li') && m/\G(\s*\n)+(\*+)[ \t]{$UseModSpaceRequired,}/cg) {
return CloseHtmlEnvironmentUntil('li') . OpenHtmlEnvironment('ul',length($2))
. AddHtmlEnvironment('li');
}
# numbered lists using #
elsif ($bol && m/\G(\s*\n)*(\#+)[ \t]{$UseModSpaceRequired,}/cg
or InElement('li') && m/\G(\s*\n)+(\#+)[ \t]{$UseModSpaceRequired,}/cg) {
return CloseHtmlEnvironmentUntil('li') . OpenHtmlEnvironment('ol',length($2))
. AddHtmlEnvironment('li');
}
# indented text using : (use blockquote instead?)
elsif ($bol && m/\G(\s*\n)*(\:+)[ \t]{$UseModSpaceRequired,}/cg
or InElement('dd') && m/\G(\s*\n)+(\:+)[ \t]{$UseModSpaceRequired,}/cg) {
return CloseHtmlEnvironmentUntil('dd') . OpenHtmlEnvironment('dl',length($2), 'quote')
. $q->dt() . AddHtmlEnvironment('dd');
}
# definition lists using ;
elsif (($bol and m/\G(\s*\n)*(\;+)[ \t]{$UseModSpaceRequired,}(?=.*[ \t]{$UseModExtraSpaceRequired,}\:)/cg) or
(InElement('dd') and m/\G(\s*\n)+(\;+)[ \t]{$UseModSpaceRequired,}(?=.*[ \t]{$UseModExtraSpaceRequired,}\:)/cg)) {
return CloseHtmlEnvironmentUntil('dd')
.OpenHtmlEnvironment('dl', length($2))
.AddHtmlEnvironment('dt'); # `:' needs special treatment, later
}
elsif (InElement('dt') and m/\G(?<=[ \t]){$UseModExtraSpaceRequired,}:[ \t]*/cg) {
return CloseHtmlEnvironmentUntil('dt')
.CloseHtmlEnvironment()
.AddHtmlEnvironment('dd');
}
# headings using = (with lookahead)
elsif ($bol && $UseModMarkupInTitles
&& m/\G(\s*\n)*(\=+)[ \t]*(?=[^=\n]+=)/cg) {
my $depth = length($2);
$depth = 6 if $depth > 6;
$depth = 2 if $depth < 2;
my $html = CloseHtmlEnvironments() . ($PortraitSupportColorDiv ? '' : '')
. AddHtmlEnvironment('h' . $depth);
$PortraitSupportColorDiv = 0; # after the HTML has been determined.
$PortraitSupportColor = 0;
return $html;
} elsif ($UseModMarkupInTitles
&& (InElement('h1') || InElement('h2') || InElement('h3')
|| InElement('h4') || InElement('h5') || InElement('h6'))
&& m/\G[ \t]*=+\n?/cg) {
return CloseHtmlEnvironments() . AddHtmlEnvironment('p');
} elsif ($bol && !$UseModMarkupInTitles
&& m/\G(\s*\n)*(\=+)[ \t]*(.+?)[ \t]*(=+)[ \t]*\n?/cg) {
my $html = CloseHtmlEnvironments() . ($PortraitSupportColorDiv ? '' : '')
. WikiHeading($2, $3) . AddHtmlEnvironment('p');
$PortraitSupportColorDiv = 0; # after the HTML has been determined.
$PortraitSupportColor = 0;
return $html;
}
# horizontal lines using ----
elsif ($bol && m/\G(\s*\n)*----+[ \t]*\n?/cg) {
my $html = CloseHtmlEnvironments() . ($PortraitSupportColorDiv ? '' : '')
. $q->hr() . AddHtmlEnvironment('p');
$PortraitSupportColorDiv = 0;
$PortraitSupportColor = 0;
return $html;
}
# tables using || -- the first row of a table
elsif ($bol && m/\G(\s*\n)*((\|\|)+)([ \t])*(?=.*\|\|[ \t]*(\n|$))/cg) {
$rowcount = 1;
return OpenHtmlEnvironment('table',1,'user')
. AddHtmlEnvironment('tr', 'class="odd first"')
. AddHtmlEnvironment('td', UsemodTableAttributes(length($2)/2, $4));
}
# tables using || -- end of the row and beginning of the next row
elsif (InElement('td') && m/\G[ \t]*((\|\|)+)[ \t]*\n((\|\|)+)([ \t]*)/cg) {
my $attr = UsemodTableAttributes(length($3)/2, $5);
my $type = ++$rowcount % 2 ? 'odd' : 'even';
$attr = " " . $attr if $attr;
return qq{};
}
# tables using || -- an ordinary table cell
elsif (InElement('td') && m/\G[ \t]*((\|\|)+)([ \t]*)(?!(\n|$))/cg) {
my $attr = UsemodTableAttributes(length($1)/2, $3);
$attr = " " . $attr if $attr;
return "";
}
# tables using || -- since "next row" was taken care of above, this must be the last row
elsif (InElement('td') && m/\G[ \t]*((\|\|)+)[ \t]*/cg) {
return CloseHtmlEnvironments() . AddHtmlEnvironment('p');
}
# RFC
elsif (m/\G$RFCPattern/cg) { return &RFC($1); }
# ISBN -- dirty because the URL translations will change
elsif (m/\G($ISBNPattern)/cg) { Dirty($1); print ISBN($2); return ''; }
# traditional wiki syntax closure for bold italic'''''
elsif (InElement('strong') and InElement('em') and m/\G'''''/cg) { # close both
return CloseHtmlEnvironment('strong').CloseHtmlEnvironment('em');
}
# traditional wiki syntax for '''bold'''
elsif (m/\G'''/cg) { return AddOrCloseHtmlEnvironment('strong'); }
# traditional wiki syntax for ''italic''
elsif (m/\G''/cg ) { return AddOrCloseHtmlEnvironment('em'); }
# for raw html
elsif ($RawHtml && m/\G\<html\>(.*?)\<\/html\>/cgis) {
return UnquoteHtml($1);
}
# miscellaneous html tags
elsif (m/\G\<($UsemodHtmlRegExp)(\s+[^<>]*?)?\>/cgi) {
return AddHtmlEnvironment($1, $2); }
elsif (m/\G\<\/($UsemodHtmlRegExp)\>/cgi) {
return CloseHtmlEnvironment($1); }
elsif (m/\G\<($UsemodHtmlRegExp) *\/\>/cgi) {
return "<$1 />"; }
# text for html links
elsif ($HtmlLinks && m/\G\<a(\s+href="\S+")\>(.*?)\<\/a\>/cgi) {
return "$2";
}
return;
}
sub UsemodTableAttributes {
my ($span, $left, $right) = @_;
my $attr = '';
$attr = "colspan=\"$span\"" if ($span != 1);
m/\G(?=.*?([ \t]*)\|\|)/;
$right = $1;
$attr .= ' ' if ($attr and ($left or $right));
if ($left and $right) { $attr .= 'align="center"' }
elsif ($left ) { $attr .= 'align="right"' }
elsif ($right) { $attr .= 'align="left"' }
return $attr;
}
sub WikiHeading {
my ($depth, $text) = @_;
$depth = length($depth);
$depth = 6 if $depth > 6;
$depth = 2 if $depth < 2;
return "$text";
}
sub RFC {
my $num = shift;
return $q->a({-href=>"http://tools.ietf.org/html/rfc${num}"}, "RFC $num");
}
sub ISBN {
my $rawnum = shift;
my $num = $rawnum;
my $rawprint = $rawnum;
$rawprint =~ s/ +$//;
$num =~ s/[- ]//g;
my $len = length($num);
return "ISBN $rawnum" unless $len == 10 or $len == 13 or $len = 14; # be prepared for 2007-01-01
my $html = $q->a({-href => Ts("https://en.wikipedia.org/wiki/Special:BookSources/%s", $num)},
"ISBN " . $rawprint);
$html .= ' ' if ($rawnum =~ / $/); # Add space if old ISBN had space.
return $html;
}
=head1 COPYRIGHT AND LICENSE
The information below applies to everything in this distribution,
except where noted.
Copyright 2008, 2009, 2010 by Alex Schroeder .
Copyleft 2008 by Brian Curry .
Copyright 2008 by Weakish Jiang .
Copyright 2004, 2005, 2006, 2007 by Alex Schroeder .
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see L.
=cut