1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
#!/usr/bin/perl
use v5.12;
use warnings;
use Encode qw/decode_utf8/;
use HTML::Entities qw/encode_entities/;
use Text::ParseWords qw/quotewords/;
# 1 Definitions
# 1.1 Global program state
my $empty = ''; # currently buffered empty lines
my $close = ''; # buffered closing tag for currently opened block element
my $postclose = ''; # buffered extra closing tag for opened contiguous element
my $opel = ''; # currently opened block element
# 1.2 Elements
# 1.2.1 Contiguous elements
my %ctels = (
Qp => '<blockquote>{<p>%</p>}</blockquote>',
);
# 1.2.2 Block elements
my %blels = (
Hh => '<h\\$1>%</h\\$1>',
Pp => '<p>%</p>',
Pr => '<pre>%</pre>',
Sh => '<h3>%</h3>',
Ti => '<title>%</title>',
);
# 1.2.3 Inline elements
my %inels = (
Au => '<meta name="author" content="\\$1"/>',
Bd => '\\$3<b>\\$1</b>\\$2',
br => '<br/>',
Cd => '\\$3<code>\\$1</code>\\$2',
Cs => '<meta http-equiv="Content-Type" content="text/html; charset=\\$1"/>',
Da => '<meta name="created" content="\\$1"/>',
Em => '\\$3<em>\\$1</em>\\$2',
Hy => '\\$4<a href="\\$2">\\$1</a>\\$3',
Im => '<img src="\\$1" alt="\\$2"/>',
It => '\\$3<i>\\$1</i>\\$2',
St => '\\$3<strong>\\$1</strong>\\$2',
Tt => '\\$3<tt>\\$1</tt>\\$2',
Ul => '\\$3<u>\\$1</u>\\$2',
);
# 1.3 Subroutines
# 1.3.1 Handle element request
sub request {
my ($el, $args) = @_;
my @argv = quotewords('\s+', 0, $args);
my $n = @argv;
if (exists $blels{$el} or exists $ctels{$el}) {
# Clear empty line buffer
$empty = '';
# Close currently open block element, open new
my ($base, $prestart, $newpostclose) = ('', '', '');
if (exists $ctels{$el}) {
$base = $ctels{$el};
$prestart = prestart($base);
$newpostclose = postclose($base);
$base = inner($base);
} else {
$base = $blels{$el};
}
my $start = start($base);
my $newclose = interpol(_close($base), @argv) . "\n";
print $close;
$close = $newclose;
print $postclose if $el ne $opel;
$postclose = $newpostclose;
print $prestart if $el ne $opel;
print interpol($start, @argv) . "\n";
$opel = $el;
} elsif (exists $inels{$el}) {
print interpol($inels{$el}, @argv) . "\n";
} else {
print STDERR "Error: $el/$n not implemented\n";
exit 1;
}
}
# 1.3.2 Interpolate \$n parameters
sub interpol {
my $s = shift;
no warnings qw/uninitialized/;
$s =~ s/\\\$(\d+)/$_[$1-1]/g;
return $s;
}
# 1.3.3 Retrieve opening tag of block element string
sub start {
return (split '%', shift)[0];
}
# 1.3.4 Retrieve closing tag of block element string
sub _close {
return (split '%', shift)[1];
}
# 1.3.5 Retrieve extra opening tag of block element string
sub prestart {
return (split '{', shift)[0];
}
# 1.3.6 Retrieve extra closing tag of block element string
sub postclose {
return (split '}', shift)[-1];
}
# 1.3.7 Retrieve inner block of contiguous tag
sub inner {
my $s = shift;
$s =~ s/^.*?\{//;
$s =~ s/}.*?$//;
return $s
}
# 2 Program
# 2.1 Translate source text to HTML
while (<>) {
chomp;
if (/^\.([A-Za-z][a-z])\s*(.*)/) {
request($1, $2);
} elsif ($_ eq '') {
$empty .= "\n";
} else {
print $empty; $empty = '';
print encode_entities(decode_utf8($_)) . "\n";
}
}
# 2.2 Close currently open block element
print $close;
|