line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
|
2
|
|
|
|
|
|
|
=head1 NAME |
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
App::Basis::ConvertText2 |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
=head1 SYNOPSIS |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
TO be used in conjuction with the supplied ct2 script, which is part of this distribution. |
9
|
|
|
|
|
|
|
Not really to be used on its own. |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
=head1 DESCRIPTION |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
This is a perl module and a script that makes use of %TITLE% |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
This is a wrapper for [pandoc] implementing extra fenced code-blocks to allow the |
16
|
|
|
|
|
|
|
creation of charts and graphs etc. |
17
|
|
|
|
|
|
|
Documents may be created a variety of formats. If you want to create nice PDFs |
18
|
|
|
|
|
|
|
then it can use [PrinceXML] to generate great looking PDFs or you can use [wkhtmltopdf] to create PDFs that are almost as good, the default is to use pandoc which, for me, does not work as well. |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
HTML templates can also be used to control the layout of your documents. |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
The fenced code block handlers are implemented as plugins and it is a simple process to add new ones. |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
There are plugins to handle |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
* ditaa |
27
|
|
|
|
|
|
|
* mscgen |
28
|
|
|
|
|
|
|
* graphviz |
29
|
|
|
|
|
|
|
* uml |
30
|
|
|
|
|
|
|
* gnuplot |
31
|
|
|
|
|
|
|
* gle |
32
|
|
|
|
|
|
|
* sparklines |
33
|
|
|
|
|
|
|
* charts |
34
|
|
|
|
|
|
|
* barcodes and qrcodes |
35
|
|
|
|
|
|
|
* and many others |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
See |
38
|
|
|
|
|
|
|
https://github.com/27escape/App-Basis-ConvertText2/blob/master/README.md |
39
|
|
|
|
|
|
|
for more information. |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
=head1 Todo |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
Consider adding plugins for |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
* http://blockdiag.com/en/index.html, |
46
|
|
|
|
|
|
|
* https://metacpan.org/pod/Chart::Strip |
47
|
|
|
|
|
|
|
* https://metacpan.org/pod/Chart::Clicker |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=head1 Public methods |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=over 4 |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
=cut |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
package App::Basis::ConvertText2; |
58
|
|
|
|
|
|
|
$App::Basis::ConvertText2::VERSION = '0.4'; |
59
|
1
|
|
|
1
|
|
121299
|
use 5.10.0; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
83
|
|
60
|
1
|
|
|
1
|
|
8
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
42
|
|
61
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
8
|
|
|
1
|
|
|
|
|
44
|
|
62
|
1
|
|
|
1
|
|
5
|
use feature 'state'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
130
|
|
63
|
1
|
|
|
1
|
|
5902
|
use Moo; |
|
1
|
|
|
|
|
34280
|
|
|
1
|
|
|
|
|
8
|
|
64
|
1
|
|
|
1
|
|
3587
|
use Data::Printer; |
|
1
|
|
|
|
|
1624929
|
|
|
1
|
|
|
|
|
7
|
|
65
|
1
|
|
|
1
|
|
1085
|
use Try::Tiny; |
|
1
|
|
|
|
|
1378
|
|
|
1
|
|
|
|
|
54
|
|
66
|
1
|
|
|
1
|
|
7
|
use Path::Tiny; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
39
|
|
67
|
1
|
|
|
1
|
|
5
|
use Digest::MD5 qw(md5_hex); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
42
|
|
68
|
1
|
|
|
1
|
|
48551
|
use Encode qw(encode_utf8); |
|
1
|
|
|
|
|
26288
|
|
|
1
|
|
|
|
|
125
|
|
69
|
1
|
|
|
1
|
|
1916
|
use Text::Markdown qw(markdown); |
|
1
|
|
|
|
|
56975
|
|
|
1
|
|
|
|
|
169
|
|
70
|
1
|
|
|
1
|
|
528
|
use GD; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
use MIME::Base64; |
72
|
|
|
|
|
|
|
use Furl; |
73
|
|
|
|
|
|
|
use Module::Pluggable |
74
|
|
|
|
|
|
|
require => 1, |
75
|
|
|
|
|
|
|
on_require_error => sub { |
76
|
|
|
|
|
|
|
my ( $plugin, $err ) = @_; |
77
|
|
|
|
|
|
|
warn "$plugin, $err"; |
78
|
|
|
|
|
|
|
}; |
79
|
|
|
|
|
|
|
use App::Basis; |
80
|
|
|
|
|
|
|
use App::Basis::ConvertText2::Support; |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
83
|
|
|
|
|
|
|
# this contents string is to be replaced with the body of the markdown file |
84
|
|
|
|
|
|
|
# when it has been converted |
85
|
|
|
|
|
|
|
use constant CONTENTS => '_CONTENTS_'; |
86
|
|
|
|
|
|
|
use constant PANDOC => 'pandoc'; |
87
|
|
|
|
|
|
|
use constant PRINCE => 'prince'; |
88
|
|
|
|
|
|
|
use constant WKHTML => 'wkhtmltopdf'; |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
my %valid_tags; |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
93
|
|
|
|
|
|
|
my $TITLE = "%TITLE%"; |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
has 'name' => ( is => 'ro', ); |
98
|
|
|
|
|
|
|
has 'basedir' => ( is => 'ro', ); |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
has 'use_cache' => ( is => 'rw', default => sub { 0; } ); |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
has 'cache_dir' => ( |
103
|
|
|
|
|
|
|
is => 'ro', |
104
|
|
|
|
|
|
|
default => sub { |
105
|
|
|
|
|
|
|
my $self = shift; |
106
|
|
|
|
|
|
|
return "/tmp/" . get_program() . "/cache/"; |
107
|
|
|
|
|
|
|
}, |
108
|
|
|
|
|
|
|
writer => "_set_cache_dir" |
109
|
|
|
|
|
|
|
); |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
has 'template' => ( |
112
|
|
|
|
|
|
|
is => 'rw', |
113
|
|
|
|
|
|
|
default => sub { |
114
|
|
|
|
|
|
|
" |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
$TITLE |
118
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
%TITLE% |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
%_CONTENTS_% |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
\n"; |
128
|
|
|
|
|
|
|
}, |
129
|
|
|
|
|
|
|
); |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
has 'replace' => ( |
132
|
|
|
|
|
|
|
is => 'ro', |
133
|
|
|
|
|
|
|
default => sub { {} }, |
134
|
|
|
|
|
|
|
); |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
has 'verbose' => ( |
137
|
|
|
|
|
|
|
is => 'ro', |
138
|
|
|
|
|
|
|
default => sub {0}, |
139
|
|
|
|
|
|
|
); |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
has '_output' => ( |
142
|
|
|
|
|
|
|
is => 'ro', |
143
|
|
|
|
|
|
|
default => sub {""}, |
144
|
|
|
|
|
|
|
init_arg => 0 |
145
|
|
|
|
|
|
|
); |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
has '_input' => ( |
148
|
|
|
|
|
|
|
is => 'ro', |
149
|
|
|
|
|
|
|
writer => '_set_input', |
150
|
|
|
|
|
|
|
default => sub {""}, |
151
|
|
|
|
|
|
|
init_arg => 0 |
152
|
|
|
|
|
|
|
); |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
has '_md5id' => ( |
155
|
|
|
|
|
|
|
is => 'ro', |
156
|
|
|
|
|
|
|
writer => '_set_md5id', |
157
|
|
|
|
|
|
|
default => sub {""}, |
158
|
|
|
|
|
|
|
init_arg => 0 |
159
|
|
|
|
|
|
|
); |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
has 'embed' => ( |
162
|
|
|
|
|
|
|
is => 'ro', |
163
|
|
|
|
|
|
|
default => sub {0}, |
164
|
|
|
|
|
|
|
); |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=item new |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
Create a new instance of a of a data formating object |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
B passed in a HASH |
173
|
|
|
|
|
|
|
name - name of this formatting action - required |
174
|
|
|
|
|
|
|
basedir - root directory of document being processed |
175
|
|
|
|
|
|
|
cache_dir - place to store cache files - optional |
176
|
|
|
|
|
|
|
use_cache - decide if you want to use a cache or not |
177
|
|
|
|
|
|
|
template - HTML template to use, must contain %_CONTENTS_% |
178
|
|
|
|
|
|
|
replace - hashref of extra keywords to use as replaceable variables |
179
|
|
|
|
|
|
|
verbose - be verbose |
180
|
|
|
|
|
|
|
embed - embed images, do not create links to them |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
=cut |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
sub BUILD { |
185
|
|
|
|
|
|
|
my $self = shift; |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
die "No name provided" if ( !$self->name() ); |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
if ( $self->use_cache() ) { |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
# need to add the name to the cache dirname to make it distinct |
192
|
|
|
|
|
|
|
$self->_set_cache_dir( fix_filename( $self->cache_dir() . "/" . $self->name() ) ); |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
if ( !-d $self->cache_dir() ) { |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
# create the cache dir if needed |
197
|
|
|
|
|
|
|
try { |
198
|
|
|
|
|
|
|
path( $self->cache_dir() )->mkpath; |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
catch {}; |
201
|
|
|
|
|
|
|
die "Could not create cache dir " . $self->cache_dir() if ( !-d $self->cache_dir() ); |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
# work out what plugins do what |
206
|
|
|
|
|
|
|
foreach my $plug ( $self->plugins() ) { |
207
|
|
|
|
|
|
|
my $obj = $plug->new(); |
208
|
|
|
|
|
|
|
if ( !$obj ) { |
209
|
|
|
|
|
|
|
warn "Plugin $plug does not instantiate"; |
210
|
|
|
|
|
|
|
next; |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
# the process method does the work for all the tag handlers |
214
|
|
|
|
|
|
|
if ( !$obj->can('process') ) { |
215
|
|
|
|
|
|
|
warn "Plugin $plug does not provide a process method"; |
216
|
|
|
|
|
|
|
next; |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
foreach my $h ( @{ $obj->handles } ) { |
219
|
|
|
|
|
|
|
$h = lc($h); |
220
|
|
|
|
|
|
|
if ( $h eq 'buffer' ) { |
221
|
|
|
|
|
|
|
die "Plugin $plug cannot provide a handler for $h, as this is already provided for internally"; |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
if ( $valid_tags{$h} ) { |
224
|
|
|
|
|
|
|
die "Plugin $plug cannot provide a handler for $h, as this is already provided by $valid_tags{ $h }"; |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
# all handlers are lower case |
228
|
|
|
|
|
|
|
$valid_tags{$h} = $obj; |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
# buffer is a special internal handler |
233
|
|
|
|
|
|
|
$valid_tags{buffer} = 1; |
234
|
|
|
|
|
|
|
} |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
sub _append_output { |
239
|
|
|
|
|
|
|
my $self = shift; |
240
|
|
|
|
|
|
|
my $str = shift; |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
$self->{output} .= $str if ($str); |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
246
|
|
|
|
|
|
|
# store a file to the cache |
247
|
|
|
|
|
|
|
# if the contents are empty then any existing cache file will be removed |
248
|
|
|
|
|
|
|
sub _store_cache { |
249
|
|
|
|
|
|
|
my $self = shift; |
250
|
|
|
|
|
|
|
my ( $filename, $contents ) = @_; |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
# don't do any cleanup if we are not using a cache |
253
|
|
|
|
|
|
|
return if ( !$self->use_cache() ); |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
# for some reason sometimes the full cache dir is not created or |
256
|
|
|
|
|
|
|
# something deletes part of it, cannot figure it out |
257
|
|
|
|
|
|
|
path( $self->cache_dir() )->mkpath if ( !-d $self->cache_dir() ); |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
# make sure we are working in the right dir |
260
|
|
|
|
|
|
|
my $f = $self->cache_dir() . "/" . path($filename)->basename; |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
if ( !$contents && -f $f ) { |
263
|
|
|
|
|
|
|
unlink($f); |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
else { |
266
|
|
|
|
|
|
|
path($f)->spew_raw($contents); |
267
|
|
|
|
|
|
|
} |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
271
|
|
|
|
|
|
|
# get a file from the cache |
272
|
|
|
|
|
|
|
sub _get_cache { |
273
|
|
|
|
|
|
|
my $self = shift; |
274
|
|
|
|
|
|
|
my ($filename) = @_; |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
# don't do any cleanup if we are not using a cache |
277
|
|
|
|
|
|
|
return if ( !$self->use_cache() ); |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
# make sure we are working in the right dir |
280
|
|
|
|
|
|
|
my $f = $self->cache_dir() . "/" . path($filename)->basename; |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
my $result; |
283
|
|
|
|
|
|
|
$result = path($f)->slurp_raw if ( -f $f ); |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
return $result; |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
=item clean_cache |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
Remove all files from the cache |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
=cut |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
sub clean_cache { |
297
|
|
|
|
|
|
|
my $self = shift; |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
# don't do any cleanup if we are not using a cache |
300
|
|
|
|
|
|
|
return if ( !$self->use_cache() ); |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
try { path( $self->cache_dir() )->remove_tree } catch {}; |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
# and make it fresh again |
305
|
|
|
|
|
|
|
path( $self->cache_dir() )->mkpath(); |
306
|
|
|
|
|
|
|
} |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
309
|
|
|
|
|
|
|
# _extract_args |
310
|
|
|
|
|
|
|
sub _extract_args { |
311
|
|
|
|
|
|
|
my $buf = shift; |
312
|
|
|
|
|
|
|
my ( %attr, $eaten ); |
313
|
|
|
|
|
|
|
return \%attr if ( !$buf ); |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
while ( $buf =~ s|^\s?(([a-zA-Z][a-zA-Z0-9\.\-_]*)\s*)|| ) { |
316
|
|
|
|
|
|
|
$eaten .= $1; |
317
|
|
|
|
|
|
|
my $attr = lc $2; |
318
|
|
|
|
|
|
|
my $val; |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
# The attribute might take an optional value (first we |
321
|
|
|
|
|
|
|
# check for an unquoted value) |
322
|
|
|
|
|
|
|
if ( $buf =~ s|(^=\s*([^\"\'>\s][^>\s]*)\s*)|| ) { |
323
|
|
|
|
|
|
|
$eaten .= $1; |
324
|
|
|
|
|
|
|
$val = $2; |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
# or quoted by " or ' |
327
|
|
|
|
|
|
|
} |
328
|
|
|
|
|
|
|
elsif ( $buf =~ s|(^=\s*([\"\'])(.*?)\2\s*)||s ) { |
329
|
|
|
|
|
|
|
$eaten .= $1; |
330
|
|
|
|
|
|
|
$val = $3; |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
# truncated just after the '=' or inside the attribute |
333
|
|
|
|
|
|
|
} |
334
|
|
|
|
|
|
|
elsif ($buf =~ m|^(=\s*)$| |
335
|
|
|
|
|
|
|
or $buf =~ m|^(=\s*[\"\'].*)|s ) |
336
|
|
|
|
|
|
|
{ |
337
|
|
|
|
|
|
|
$buf = "$eaten$1"; |
338
|
|
|
|
|
|
|
last; |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
else { |
341
|
|
|
|
|
|
|
# assume attribute with implicit value |
342
|
|
|
|
|
|
|
$val = $attr; |
343
|
|
|
|
|
|
|
} |
344
|
|
|
|
|
|
|
$attr{$attr} = $val; |
345
|
|
|
|
|
|
|
} |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
return \%attr; |
348
|
|
|
|
|
|
|
} |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
351
|
|
|
|
|
|
|
# add into the replacements list |
352
|
|
|
|
|
|
|
sub _add_replace { |
353
|
|
|
|
|
|
|
my $self = shift; |
354
|
|
|
|
|
|
|
my ( $key, $val ) = @_; |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
$self->{replace}->{ uc($key) } = $val; |
357
|
|
|
|
|
|
|
} |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
360
|
|
|
|
|
|
|
sub _do_replacements { |
361
|
|
|
|
|
|
|
my $self = shift; |
362
|
|
|
|
|
|
|
my ($content) = @_; |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
foreach my $k ( keys %{ $self->replace() } ) { |
365
|
|
|
|
|
|
|
next if ( !$self->{replace}->{$k} ); |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
# in the text the variables to be replaced are surrounded by % |
368
|
|
|
|
|
|
|
# zero width look behind to make sure the variable name has |
369
|
|
|
|
|
|
|
# not been escaped _%VARIABLE% should be left alone |
370
|
|
|
|
|
|
|
$content =~ s/(?{replace}->{$k}/gsm; |
371
|
|
|
|
|
|
|
} |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
return $content; |
374
|
|
|
|
|
|
|
} |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
377
|
|
|
|
|
|
|
sub _call_function { |
378
|
|
|
|
|
|
|
my $self = shift; |
379
|
|
|
|
|
|
|
my ( $block, $params, $content, $linepos ) = @_; |
380
|
|
|
|
|
|
|
my $out; |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
if ( !$valid_tags{$block} ) { |
383
|
|
|
|
|
|
|
debug( "ERROR:", "no valid handler for $block" ); |
384
|
|
|
|
|
|
|
} |
385
|
|
|
|
|
|
|
else { |
386
|
|
|
|
|
|
|
try { |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
# buffer is a special construct to allow us to hold output of content |
389
|
|
|
|
|
|
|
# for later, allows multiple use of content or adding things to |
390
|
|
|
|
|
|
|
# markdown tables that otherwise we could not do |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
# over-ride content with buffered content |
393
|
|
|
|
|
|
|
my $from = $params->{from} || $params->{from_buffer}; |
394
|
|
|
|
|
|
|
if ($from) { |
395
|
|
|
|
|
|
|
$content = $self->{replace}->{ uc($from) }; |
396
|
|
|
|
|
|
|
} |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
my $to = $params->{to} || $params->{to_buffer}; |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
if ( $block eq 'buffer' ) { |
401
|
|
|
|
|
|
|
if ($to) { |
402
|
|
|
|
|
|
|
$self->_add_replace( $to, $content ); |
403
|
|
|
|
|
|
|
} |
404
|
|
|
|
|
|
|
} |
405
|
|
|
|
|
|
|
else { |
406
|
|
|
|
|
|
|
# do any replacements we know about in the content block |
407
|
|
|
|
|
|
|
$content = $self->_do_replacements($content); |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
# run the plugin with the data we have |
410
|
|
|
|
|
|
|
$out = $valid_tags{$block}->process( $block, $content, $params, $self->cache_dir() ); |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
if ( !$out ) { |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
# if we could not generate any output, lets put the block back together |
415
|
|
|
|
|
|
|
$out .= "~~~~{.$block " . join( " ", map {"$_='$params->{$_}'"} keys %{$params} ) . " }\n" . "~~~~\n"; |
416
|
|
|
|
|
|
|
} |
417
|
|
|
|
|
|
|
elsif ($to) { |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
# do we want to buffer the output? |
420
|
|
|
|
|
|
|
$self->_add_replace( $to, $out ); |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
# option not to show the output |
423
|
|
|
|
|
|
|
$out = "" if ( $params->{no_output} ); |
424
|
|
|
|
|
|
|
} |
425
|
|
|
|
|
|
|
} |
426
|
|
|
|
|
|
|
$self->_append_output("$out\n") if ( defined $out ); |
427
|
|
|
|
|
|
|
} |
428
|
|
|
|
|
|
|
catch { |
429
|
|
|
|
|
|
|
debug( "ERROR", "failed processing $block near line $linepos, $_" ); |
430
|
|
|
|
|
|
|
warn "Issue processing $block around line $linepos"; |
431
|
|
|
|
|
|
|
$out = "~~~~{.$block " . join( " ", map {"$_='$params->{$_}'"} keys %{$params} ) . " }\n" . "~~~~\n"; |
432
|
|
|
|
|
|
|
$self->_append_output($out); |
433
|
|
|
|
|
|
|
}; |
434
|
|
|
|
|
|
|
} |
435
|
|
|
|
|
|
|
} |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
438
|
|
|
|
|
|
|
### _parse_lines |
439
|
|
|
|
|
|
|
# parse the passed data |
440
|
|
|
|
|
|
|
sub _parse_lines { |
441
|
|
|
|
|
|
|
my $self = shift; |
442
|
|
|
|
|
|
|
my $lines = shift; |
443
|
|
|
|
|
|
|
my $count = 0; |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
return if ( !$lines ); |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
my ( $class, $block, $content, $attributes ); |
448
|
|
|
|
|
|
|
my ( $buildline, $simple ); |
449
|
|
|
|
|
|
|
try { |
450
|
|
|
|
|
|
|
foreach my $line ( @{$lines} ) { |
451
|
|
|
|
|
|
|
$count++; |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
# header lines may have been removed |
454
|
|
|
|
|
|
|
next if ( !defined $line ); |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
if ( defined $simple ) { |
457
|
|
|
|
|
|
|
if ( $line =~ /^~{4,}\s?$/ ) { |
458
|
|
|
|
|
|
|
$self->_append_output("~~~~\n$simple\n~~~~\n"); |
459
|
|
|
|
|
|
|
$simple = undef; |
460
|
|
|
|
|
|
|
} |
461
|
|
|
|
|
|
|
else { |
462
|
|
|
|
|
|
|
$simple .= "$line\n"; |
463
|
|
|
|
|
|
|
} |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
next; |
466
|
|
|
|
|
|
|
} |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
# we may need to add successive lines together to get a completed fenced code block |
469
|
|
|
|
|
|
|
if ( !$block && $buildline ) { |
470
|
|
|
|
|
|
|
$buildline .= " $line"; |
471
|
|
|
|
|
|
|
if ( $line =~ /\}\s*$/ ) { |
472
|
|
|
|
|
|
|
$line = $buildline; |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
# make sure to clear the builder |
475
|
|
|
|
|
|
|
$buildline = undef; |
476
|
|
|
|
|
|
|
} |
477
|
|
|
|
|
|
|
else { |
478
|
|
|
|
|
|
|
# continue to build the line |
479
|
|
|
|
|
|
|
next; |
480
|
|
|
|
|
|
|
} |
481
|
|
|
|
|
|
|
} |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
# a simple block does not have an identifying {.tag} |
484
|
|
|
|
|
|
|
if ( $line =~ /^~{4,}\s?$/ && !$block ) { |
485
|
|
|
|
|
|
|
$simple = ""; |
486
|
|
|
|
|
|
|
next; |
487
|
|
|
|
|
|
|
} |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
if ( $line =~ /^~{4,}/ ) { |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
# does the fenced line wrap before its ended |
492
|
|
|
|
|
|
|
if ( !$block && $line !~ /\}\s*$/ ) { |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
# we need to start adding lines till its completed |
495
|
|
|
|
|
|
|
$buildline = $line; |
496
|
|
|
|
|
|
|
next; |
497
|
|
|
|
|
|
|
} |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
if ( $line =~ /\{(.*?)\.(\w+)\s*(.*?)\}\s*$/ ) { |
500
|
|
|
|
|
|
|
$class = $1; |
501
|
|
|
|
|
|
|
$block = lc($2); |
502
|
|
|
|
|
|
|
$attributes = $3; |
503
|
|
|
|
|
|
|
} |
504
|
|
|
|
|
|
|
elsif ( $line =~ /\{\.(\w+)\s?\}\s*$/ ) { |
505
|
|
|
|
|
|
|
$block = lc($1); |
506
|
|
|
|
|
|
|
$attributes = {}; |
507
|
|
|
|
|
|
|
} |
508
|
|
|
|
|
|
|
else { |
509
|
|
|
|
|
|
|
my $params = _extract_args($attributes); |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
# must have reached the end of a block |
512
|
|
|
|
|
|
|
if ( $block && $valid_tags{$block} ) { |
513
|
|
|
|
|
|
|
chomp $content; |
514
|
|
|
|
|
|
|
$self->_call_function( $block, $params, $content, $count ); |
515
|
|
|
|
|
|
|
} |
516
|
|
|
|
|
|
|
else { |
517
|
|
|
|
|
|
|
if ( !$block ) { |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
# put it back |
520
|
|
|
|
|
|
|
$content ||= ""; |
521
|
|
|
|
|
|
|
$self->_append_output("~~~~\n$content\n~~~~\n"); |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
} |
524
|
|
|
|
|
|
|
else { |
525
|
|
|
|
|
|
|
$content ||= ""; |
526
|
|
|
|
|
|
|
$attributes ||= ""; |
527
|
|
|
|
|
|
|
$block ||= ""; |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
# put it back |
530
|
|
|
|
|
|
|
$self->_append_output("~~~~{ $class .$block $attributes}\n$content\n~~~~\n"); |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
} |
534
|
|
|
|
|
|
|
$content = ""; |
535
|
|
|
|
|
|
|
$attributes = ""; |
536
|
|
|
|
|
|
|
$block = ""; |
537
|
|
|
|
|
|
|
} |
538
|
|
|
|
|
|
|
} |
539
|
|
|
|
|
|
|
else { |
540
|
|
|
|
|
|
|
if ($block) { |
541
|
|
|
|
|
|
|
$content .= "$line\n"; |
542
|
|
|
|
|
|
|
} |
543
|
|
|
|
|
|
|
else { |
544
|
|
|
|
|
|
|
$self->_append_output("$line\n"); |
545
|
|
|
|
|
|
|
} |
546
|
|
|
|
|
|
|
} |
547
|
|
|
|
|
|
|
} |
548
|
|
|
|
|
|
|
} |
549
|
|
|
|
|
|
|
catch { |
550
|
|
|
|
|
|
|
die "Issue at line $count $_"; |
551
|
|
|
|
|
|
|
}; |
552
|
|
|
|
|
|
|
} |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
555
|
|
|
|
|
|
|
# fetch any img references and copy into the cache, if the image is already |
556
|
|
|
|
|
|
|
# in the cache then nothing will happen, will rewrite other img uri's |
557
|
|
|
|
|
|
|
sub _rewrite_imgsrc { |
558
|
|
|
|
|
|
|
my $self = shift; |
559
|
|
|
|
|
|
|
my ( $pre, $img, $post, $want_size ) = @_; |
560
|
|
|
|
|
|
|
my $ext; |
561
|
|
|
|
|
|
|
if ( $img =~ /\.(\w+)$/ ) { |
562
|
|
|
|
|
|
|
$ext = $1; |
563
|
|
|
|
|
|
|
} |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
# if its an image we have generated then it may already be here |
566
|
|
|
|
|
|
|
# check to see if we have this in the cache |
567
|
|
|
|
|
|
|
my $cachefile = cachefile( $self->cache_dir, $img ); |
568
|
|
|
|
|
|
|
if ( !-f $cachefile ) { |
569
|
|
|
|
|
|
|
my $id = md5_hex($img); |
570
|
|
|
|
|
|
|
$id .= ".$ext"; |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
# this is what it will be named in the cache |
573
|
|
|
|
|
|
|
$cachefile = cachefile( $self->cache_dir, $id ); |
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
# not in the cache so we must fetch it and store it local to the cache |
576
|
|
|
|
|
|
|
# if we are a local file |
577
|
|
|
|
|
|
|
if ( $img !~ m|^\w+://| || $img =~ m|^file://| ) { |
578
|
|
|
|
|
|
|
$img =~ s|^file://||; |
579
|
|
|
|
|
|
|
$img = fix_filename($img); |
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
if ( $img !~ m|/| ) { |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
# if file is relative, then we need to add the basedir |
584
|
|
|
|
|
|
|
$img = $self->basedir . "/$img"; |
585
|
|
|
|
|
|
|
} |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
# copy it to the cache location |
588
|
|
|
|
|
|
|
try { |
589
|
|
|
|
|
|
|
path($img)->copy($cachefile); |
590
|
|
|
|
|
|
|
} |
591
|
|
|
|
|
|
|
catch { |
592
|
|
|
|
|
|
|
debug( "ERROR", "failed to copy $img to $cachefile" ); |
593
|
|
|
|
|
|
|
}; |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
$img = $cachefile if ( -f $cachefile ); |
596
|
|
|
|
|
|
|
} |
597
|
|
|
|
|
|
|
else { |
598
|
|
|
|
|
|
|
if ( $img =~ m|^(\w+)://(.*)| ) { |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
my $furl = Furl->new( |
601
|
|
|
|
|
|
|
agent => get_program(), |
602
|
|
|
|
|
|
|
timeout => 0.2, |
603
|
|
|
|
|
|
|
); |
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
my $res = $furl->get($img); |
606
|
|
|
|
|
|
|
if ( $res->is_success ) { |
607
|
|
|
|
|
|
|
path($cachefile)->spew_raw( $res->content ); |
608
|
|
|
|
|
|
|
$img = $cachefile; |
609
|
|
|
|
|
|
|
} |
610
|
|
|
|
|
|
|
else { |
611
|
|
|
|
|
|
|
debug( "ERROR", "unknown could not fetch $img" ); |
612
|
|
|
|
|
|
|
} |
613
|
|
|
|
|
|
|
} |
614
|
|
|
|
|
|
|
else { |
615
|
|
|
|
|
|
|
debug( "ERROR", "unknown protocol for $img" ); |
616
|
|
|
|
|
|
|
} |
617
|
|
|
|
|
|
|
} |
618
|
|
|
|
|
|
|
} |
619
|
|
|
|
|
|
|
else { |
620
|
|
|
|
|
|
|
$img = $cachefile; |
621
|
|
|
|
|
|
|
} |
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
# make sure we add the image size if its not already there |
624
|
|
|
|
|
|
|
if ( $want_size && $pre !~ /width=|height=/i && $post !~ /width=|height=/i ) { |
625
|
|
|
|
|
|
|
my $image = GD::Image->new($img); |
626
|
|
|
|
|
|
|
if ($image) { |
627
|
|
|
|
|
|
|
$post =~ s/\/>$//; |
628
|
|
|
|
|
|
|
$post .= " height='" . $image->height() . "' width='" . $image->width() . "' />"; |
629
|
|
|
|
|
|
|
} |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
# do we need to embed the images, if we do this then libreoffice may be pants |
633
|
|
|
|
|
|
|
# however 'prince' is happy |
634
|
|
|
|
|
|
|
if ( $self->embed() ) { |
635
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
# we encode the image as base64 so that the HTML document can be moved with all images |
637
|
|
|
|
|
|
|
# intact |
638
|
|
|
|
|
|
|
my $base64 = MIME::Base64::encode( path($img)->slurp_raw ); |
639
|
|
|
|
|
|
|
$img = "data:image/$ext;base64,$base64"; |
640
|
|
|
|
|
|
|
} |
641
|
|
|
|
|
|
|
return $pre . $img . $post; |
642
|
|
|
|
|
|
|
} |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
645
|
|
|
|
|
|
|
# grab all the h2/h3 elements and make them toc items |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
sub _build_toc { |
648
|
|
|
|
|
|
|
my $html = shift; |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
my @items = ( $html =~ m|(.*?)|gsm ); |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
my $toc = " Contents \n |
653
|
|
|
|
|
|
|
for ( my $i = 0; $i < scalar(@items); $i += 2 ) { |
654
|
|
|
|
|
|
|
my $ref = $items[$i]; |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
my $h = $items[ $i + 1 ]; |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
# remove any href inside the header title |
659
|
|
|
|
|
|
|
$h =~ s/<\/?a.*?>//g; |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
if ( $h =~ /^\d+\./ ) { |
662
|
|
|
|
|
|
|
$h = " $h"; |
663
|
|
|
|
|
|
|
} |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
# make sure reference is in lower case |
666
|
|
|
|
|
|
|
$toc .= " $h\n"; |
667
|
|
|
|
|
|
|
} |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
$toc .= "\n"; |
670
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
return $toc; |
672
|
|
|
|
|
|
|
} |
673
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
675
|
|
|
|
|
|
|
# rewrite the headers so that they are nice for the TOC |
676
|
|
|
|
|
|
|
sub _rewrite_hdrs { |
677
|
|
|
|
|
|
|
state $counters = { 2 => 0, 3 => 0, 4 => 0 }; |
678
|
|
|
|
|
|
|
state $last_lvl = 0; |
679
|
|
|
|
|
|
|
my ( $head, $txt, $tail ) = @_; |
680
|
|
|
|
|
|
|
my $pre; |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
my ($lvl) = ( $head =~ /
|
683
|
|
|
|
|
|
|
my $ref = $txt; |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
if ( $lvl < $last_lvl ) { |
686
|
|
|
|
|
|
|
debug( "ERROR", "something odd happening in _rewrite_hdrs" ); |
687
|
|
|
|
|
|
|
} |
688
|
|
|
|
|
|
|
elsif ( $lvl > $last_lvl ) { |
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
# if we are stepping back up a level then we need to reset the counter below |
691
|
|
|
|
|
|
|
if ( $lvl == 3 ) { |
692
|
|
|
|
|
|
|
$counters->{4} = 0; |
693
|
|
|
|
|
|
|
} |
694
|
|
|
|
|
|
|
elsif ( $lvl == 2 ) { |
695
|
|
|
|
|
|
|
$counters->{3} = 0; |
696
|
|
|
|
|
|
|
$counters->{4} = 0; |
697
|
|
|
|
|
|
|
} |
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
} |
700
|
|
|
|
|
|
|
$counters->{$lvl}++; |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
if ( $lvl == 2 ) { $pre = "$counters->{2}"; } |
703
|
|
|
|
|
|
|
elsif ( $lvl == 3 ) { $pre = "$counters->{2}.$counters->{3}"; } |
704
|
|
|
|
|
|
|
elsif ( $lvl == 4 ) { $pre = "$counters->{2}.$counters->{3}.$counters->{4}"; } |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
$ref =~ s/\s/_/gsm; |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
# remove things we don't like from the reference |
709
|
|
|
|
|
|
|
$ref =~ s/[\s'"\(\)\[\]<>]//g; |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
my $out = "$head$pre $txt$tail"; |
712
|
|
|
|
|
|
|
return $out; |
713
|
|
|
|
|
|
|
} |
714
|
|
|
|
|
|
|
|
715
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
716
|
|
|
|
|
|
|
# use pandoc to parse markdown into nice HTML |
717
|
|
|
|
|
|
|
# pandoc has extra features over and above markdown, eg syntax highlighting |
718
|
|
|
|
|
|
|
# and tables |
719
|
|
|
|
|
|
|
# pandoc must be in user path |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
sub _pandoc_html { |
722
|
|
|
|
|
|
|
my $input = shift; |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
my $resp = execute_cmd( |
725
|
|
|
|
|
|
|
command => PANDOC . " --email-obfuscation=none -S -R --normalize -t html5 --highlight-style='kate'", |
726
|
|
|
|
|
|
|
timeout => 30, |
727
|
|
|
|
|
|
|
child_stdin => $input |
728
|
|
|
|
|
|
|
); |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
my $html; |
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
debug( "Pandoc: " . $resp->{stderr} ) if ( $resp->{stderr} ); |
733
|
|
|
|
|
|
|
if ( !$resp->{exit_code} ) { |
734
|
|
|
|
|
|
|
$html = $resp->{stdout}; |
735
|
|
|
|
|
|
|
} |
736
|
|
|
|
|
|
|
else { |
737
|
|
|
|
|
|
|
debug( "ERROR", "Could not parse with pandoc, using markdown" ); |
738
|
|
|
|
|
|
|
warn "Could not parse with pandoc, using markdown"; |
739
|
|
|
|
|
|
|
$html = markdown($input); |
740
|
|
|
|
|
|
|
} |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
return $html; |
743
|
|
|
|
|
|
|
} |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
746
|
|
|
|
|
|
|
# use pandoc to convert HTML into another format |
747
|
|
|
|
|
|
|
# pandoc must be in user path |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
sub _pandoc_format { |
750
|
|
|
|
|
|
|
my ( $input, $output ) = @_; |
751
|
|
|
|
|
|
|
my $status = 1; |
752
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
my $resp = execute_cmd( |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
command => PANDOC . " $input -o $output", |
756
|
|
|
|
|
|
|
timeout => 30, |
757
|
|
|
|
|
|
|
); |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
debug( "Pandoc: " . $resp->{stderr} ) if ( $resp->{stderr} ); |
760
|
|
|
|
|
|
|
if ( !$resp->{exit_code} ) { |
761
|
|
|
|
|
|
|
$status = 0; |
762
|
|
|
|
|
|
|
} |
763
|
|
|
|
|
|
|
else { |
764
|
|
|
|
|
|
|
debug( "ERROR", "Could not parse with pandoc" ); |
765
|
|
|
|
|
|
|
$status = 1; |
766
|
|
|
|
|
|
|
} |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
return $status; |
769
|
|
|
|
|
|
|
} |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
772
|
|
|
|
|
|
|
# convert_file |
773
|
|
|
|
|
|
|
# convert the file to a different format from HTML |
774
|
|
|
|
|
|
|
# parameters |
775
|
|
|
|
|
|
|
# file - file to re-convert |
776
|
|
|
|
|
|
|
# format - format to convert to |
777
|
|
|
|
|
|
|
# pdfconvertor - use prince/wkhtmltopdf rather than pandoc to convert to PDF |
778
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
sub _convert_file { |
780
|
|
|
|
|
|
|
my $self = shift ; |
781
|
|
|
|
|
|
|
my ( $file, $format, $pdfconvertor ) = @_; |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
# we work on the is that pandoc should be in your PATH |
784
|
|
|
|
|
|
|
my $fmt_str = $format; |
785
|
|
|
|
|
|
|
my ( $outfile, $exit ); |
786
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
$outfile = $file; |
788
|
|
|
|
|
|
|
$outfile =~ s/\.(\w+)$/.pdf/; |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
# we can use prince to do PDF conversion, its faster and better, but not free for commercial use |
791
|
|
|
|
|
|
|
# you would have to ignore the P symbol on the resultant document |
792
|
|
|
|
|
|
|
if ( $format =~ /pdf/i && $pdfconvertor ) { |
793
|
|
|
|
|
|
|
my $cmd; |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
if ( $pdfconvertor =~ /^prince/i ) { |
796
|
|
|
|
|
|
|
$cmd = PRINCE . " " ; |
797
|
|
|
|
|
|
|
$cmd.= "--pdf-title='$self->{replace}->{TITLE}' " if ($self->{replace}->{TITLE}) ; |
798
|
|
|
|
|
|
|
$cmd.= "--pdf-subject='$self->{replace}->{SUBJECT}' " if ($self->{replace}->{SUBJECT}) ; |
799
|
|
|
|
|
|
|
$cmd.= "--pdf-creator='$self->{replace}->{AUTHOR}' " if ($self->{replace}->{AUTHOR}) ; |
800
|
|
|
|
|
|
|
$cmd.= "--pdf-keywords='$self->{replace}->{KEYWORDS}' " if ($self->{replace}->{KEYWORDS}) ; |
801
|
|
|
|
|
|
|
$cmd .= " --media=print $file -o $outfile"; |
802
|
|
|
|
|
|
|
} |
803
|
|
|
|
|
|
|
elsif ( $pdfconvertor =~ /^wkhtmltopdf/i ) { |
804
|
|
|
|
|
|
|
$cmd = WKHTML . " -q --print-media-type " ; |
805
|
|
|
|
|
|
|
$cmd.= "--title '$self->{replace}->{TITLE}' " if ($self->{replace}->{TITLE}) ; |
806
|
|
|
|
|
|
|
# do we want to specify the size |
807
|
|
|
|
|
|
|
$cmd .= "--page-size $self->{replace}->{PAGE_SIZE} " if( $self->{replace}->{PAGE_SIZE}) ; |
808
|
|
|
|
|
|
|
$cmd .= "$file $outfile"; |
809
|
|
|
|
|
|
|
} |
810
|
|
|
|
|
|
|
else { |
811
|
|
|
|
|
|
|
warn "Unknown PDF converter ($pdfconvertor), using pandoc"; |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
# otherwise lets use pandoc to create the file in the other formats |
814
|
|
|
|
|
|
|
$exit = _pandoc_format( $file, $outfile ); |
815
|
|
|
|
|
|
|
} |
816
|
|
|
|
|
|
|
if ($cmd) { |
817
|
|
|
|
|
|
|
my ( $out, $err ); |
818
|
|
|
|
|
|
|
try { |
819
|
|
|
|
|
|
|
# say "$cmd" ; |
820
|
|
|
|
|
|
|
( $exit, $out, $err ) = run_cmd($cmd); |
821
|
|
|
|
|
|
|
} |
822
|
|
|
|
|
|
|
catch { |
823
|
|
|
|
|
|
|
$err = "run_cmd($cmd) died - $_"; |
824
|
|
|
|
|
|
|
$exit = 1; |
825
|
|
|
|
|
|
|
}; |
826
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
debug( "ERROR", $err ) if ($err); # only debug if return code is not 0 |
828
|
|
|
|
|
|
|
} |
829
|
|
|
|
|
|
|
} |
830
|
|
|
|
|
|
|
else { |
831
|
|
|
|
|
|
|
# otherwise lets use pandoc to create the file in the other formats |
832
|
|
|
|
|
|
|
$exit = _pandoc_format( $file, $outfile ); |
833
|
|
|
|
|
|
|
} |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
# if we failed to convert, then clear the filename |
836
|
|
|
|
|
|
|
return $exit == 0 ? $outfile : undef; |
837
|
|
|
|
|
|
|
} |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
=item parse |
842
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
parse the markup into HTML and return it, HTML is also stored internally |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
B |
846
|
|
|
|
|
|
|
markdown text |
847
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
=cut |
849
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
sub parse { |
851
|
|
|
|
|
|
|
my $self = shift; |
852
|
|
|
|
|
|
|
my ($data) = @_; |
853
|
|
|
|
|
|
|
|
854
|
|
|
|
|
|
|
die "Nothing to parse" if ( !$data ); |
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
my $id = md5_hex( encode_utf8($data) ); |
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
# my $id = md5_hex( $data ); |
859
|
|
|
|
|
|
|
$self->_set_md5id($id); |
860
|
|
|
|
|
|
|
$self->_set_input($data); |
861
|
|
|
|
|
|
|
|
862
|
|
|
|
|
|
|
my $cachefile = cachefile( $self->cache_dir, "$id.html" ); |
863
|
|
|
|
|
|
|
if ( -f $cachefile ) { |
864
|
|
|
|
|
|
|
my $cache = path($cachefile)->slurp_utf8; |
865
|
|
|
|
|
|
|
$self->{output} = $cache; # put cached item into output |
866
|
|
|
|
|
|
|
} |
867
|
|
|
|
|
|
|
else { |
868
|
|
|
|
|
|
|
$self->{output} = ""; # blank the output |
869
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
my @lines = split( /\n/, $data ); |
871
|
|
|
|
|
|
|
|
872
|
|
|
|
|
|
|
# process top 20 lines for keywords |
873
|
|
|
|
|
|
|
# maybe replace this with some YAML processor? |
874
|
|
|
|
|
|
|
for ( my $i = 0; $i < 20; $i++ ) { |
875
|
|
|
|
|
|
|
## if there is no keyword separator then we must have done the keywords |
876
|
|
|
|
|
|
|
last if ( $lines[$i] !~ /:/ ); |
877
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
# allow keywords to be :keyword or keyword: |
879
|
|
|
|
|
|
|
my ( $k, $v ) = ( $lines[$i] =~ /^:?(\w+):?\s+(.*?)\s?$/ ); |
880
|
|
|
|
|
|
|
next if ( !$k ); |
881
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
$self->_add_replace( $k, $v ); |
883
|
|
|
|
|
|
|
$lines[$i] = undef; # essentially remove the line |
884
|
|
|
|
|
|
|
} |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
# parse the data find all fenced blocks we can handle |
887
|
|
|
|
|
|
|
$self->_parse_lines( \@lines ); |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
# store the markdown before parsing |
890
|
|
|
|
|
|
|
$self->_store_cache( $self->cache_dir() . "/$id.md", encode_utf8( $self->{output} ) ); |
891
|
|
|
|
|
|
|
|
892
|
|
|
|
|
|
|
# fixup any markdown simple tables | ------ | -> |---------| |
893
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
# my @tmp = split( /\n/, $self->{_output} ); |
895
|
|
|
|
|
|
|
# my $done = 0; |
896
|
|
|
|
|
|
|
# for ( my $i = 0; $i < scalar @tmp; $i++ ) { |
897
|
|
|
|
|
|
|
# if ( $tmp[$i] =~ /^\|[\s\|\-\+]+$/ ) { |
898
|
|
|
|
|
|
|
# $tmp[$i] =~ s/\s/-/g; |
899
|
|
|
|
|
|
|
# $done++; |
900
|
|
|
|
|
|
|
# } |
901
|
|
|
|
|
|
|
# } |
902
|
|
|
|
|
|
|
# $self->{_output} = join( "\n", @tmp ) if ($done); |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
# we have created something so we can cache it, if use_cache is off |
905
|
|
|
|
|
|
|
# then this will not happen lower down |
906
|
|
|
|
|
|
|
# now we convert the parsed output into HTML |
907
|
|
|
|
|
|
|
my $pan = _pandoc_html( $self->{output} ); |
908
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
# add the converted markdown into the template |
910
|
|
|
|
|
|
|
my $html = $self->template; |
911
|
|
|
|
|
|
|
my $rep = "%" . CONTENTS . "%"; |
912
|
|
|
|
|
|
|
$html =~ s/$rep/$pan/gsm; |
913
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
# if the user has not used :title, the we need to grab the title from the page so far |
915
|
|
|
|
|
|
|
if ( !$self->{replace}->{TITLE} ) { |
916
|
|
|
|
|
|
|
my (@h1) = ( $html =~ m|(.*?)|gsmi ); |
917
|
|
|
|
|
|
|
|
918
|
|
|
|
|
|
|
# find the first header that does not contain %TITLE% |
919
|
|
|
|
|
|
|
# I failed to get the zero width look-behind wotking |
920
|
|
|
|
|
|
|
# my ($h) = ( $html =~ m|.*?(?|gsmi ); |
921
|
|
|
|
|
|
|
foreach my $h (@h1) { |
922
|
|
|
|
|
|
|
if ( $h !~ /%TITLE/ ) { |
923
|
|
|
|
|
|
|
$self->{replace}->{TITLE} = $h; |
924
|
|
|
|
|
|
|
last; |
925
|
|
|
|
|
|
|
} |
926
|
|
|
|
|
|
|
} |
927
|
|
|
|
|
|
|
} |
928
|
|
|
|
|
|
|
|
929
|
|
|
|
|
|
|
# do we need to add a table of contents |
930
|
|
|
|
|
|
|
if ( $html =~ /%TOC%/ ) { |
931
|
|
|
|
|
|
|
$html =~ s|()(.*?)()|_rewrite_hdrs( $1, $2, $3)|egsi; |
932
|
|
|
|
|
|
|
$self->{replace}->{TOC} = _build_toc($html); |
933
|
|
|
|
|
|
|
} |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
# replace things we have saved |
936
|
|
|
|
|
|
|
$html = $self->_do_replacements($html); |
937
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
# and remove any uppercased %word% things that are not processed |
939
|
|
|
|
|
|
|
$html =~ s/(?
|
940
|
|
|
|
|
|
|
$html =~ s/_(%.*?%)/$1/gsm; |
941
|
|
|
|
|
|
|
|
942
|
|
|
|
|
|
|
# fetch any images and store to the cache, make sure they have sizes too |
943
|
|
|
|
|
|
|
$html =~ s/()/$self->_rewrite_imgsrc( $1, $2, $3, 1)/egs; |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
# write any css url images and store to the cache |
946
|
|
|
|
|
|
|
$html =~ s/(url\s*\(['"]?)(.*?)(['"]?\))/$self->_rewrite_imgsrc( $1, $2, $3, 0)/egs; |
947
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
# strip out any HTML comments that may have come in from template |
949
|
|
|
|
|
|
|
$html =~ s///gsm; |
950
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
$self->{output} = $html; |
952
|
|
|
|
|
|
|
$self->_store_cache( $cachefile, $html ); |
953
|
|
|
|
|
|
|
} |
954
|
|
|
|
|
|
|
return $self->{output}; |
955
|
|
|
|
|
|
|
} |
956
|
|
|
|
|
|
|
|
957
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
958
|
|
|
|
|
|
|
|
959
|
|
|
|
|
|
|
=item save_to_file |
960
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
save the created html to a named file |
962
|
|
|
|
|
|
|
|
963
|
|
|
|
|
|
|
B |
964
|
|
|
|
|
|
|
filename filename to store/convert stored HTML into |
965
|
|
|
|
|
|
|
pdfconvertor indicate that we should use prince or wkhtmltopdf to create PDF |
966
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
=cut |
968
|
|
|
|
|
|
|
|
969
|
|
|
|
|
|
|
sub save_to_file { |
970
|
|
|
|
|
|
|
state $counter = 0; |
971
|
|
|
|
|
|
|
my $self = shift; |
972
|
|
|
|
|
|
|
my ( $filename, $pdfconvertor ) = @_; |
973
|
|
|
|
|
|
|
my ($format) = ( $filename =~ /\.(\w+)$/ ); # get last thing after a '.' |
974
|
|
|
|
|
|
|
if ( !$format ) { |
975
|
|
|
|
|
|
|
warn "Could not determine outpout file format, using PDF"; |
976
|
|
|
|
|
|
|
$format = '.pdf'; |
977
|
|
|
|
|
|
|
} |
978
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
my $f = $self->_md5id() . ".html"; |
980
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
# have we got the parsed data |
982
|
|
|
|
|
|
|
my $cf = cachefile( $self->cache_dir, $f ); |
983
|
|
|
|
|
|
|
if ( !$self->{output} ) { |
984
|
|
|
|
|
|
|
die "parse has not been run yet"; |
985
|
|
|
|
|
|
|
} |
986
|
|
|
|
|
|
|
|
987
|
|
|
|
|
|
|
if ( !-f $cf ) { |
988
|
|
|
|
|
|
|
if ( !$self->use_cache() ) { |
989
|
|
|
|
|
|
|
|
990
|
|
|
|
|
|
|
# create a file name to store the output to |
991
|
|
|
|
|
|
|
$cf = "/tmp/" . get_program() . "$$." . $counter++; |
992
|
|
|
|
|
|
|
} |
993
|
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
# either update the cache, or create temp file |
995
|
|
|
|
|
|
|
path($cf)->spew_utf8( encode_utf8( $self->{output} ) ); |
996
|
|
|
|
|
|
|
} |
997
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
my $outfile = $cf; |
999
|
|
|
|
|
|
|
$outfile =~ s/\.html$/.$format/i; |
1000
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
# if the marked-up file is more recent than the converted one |
1002
|
|
|
|
|
|
|
# then we need to convert it again |
1003
|
|
|
|
|
|
|
if ( $format !~ /html/i ) { |
1004
|
|
|
|
|
|
|
|
1005
|
|
|
|
|
|
|
# as we can generate PDF using a number of convertors we should |
1006
|
|
|
|
|
|
|
# always regenerate PDF output incase the convertor used is different |
1007
|
|
|
|
|
|
|
if ( !-f $outfile || $format =~ /pdf/i || ( ( stat($cf) )[9] > ( stat($outfile) )[9] ) ) { |
1008
|
|
|
|
|
|
|
$outfile = $self->_convert_file( $cf, $format, $pdfconvertor ); |
1009
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
# if we failed to convert, then clear the filename |
1011
|
|
|
|
|
|
|
if ( !$outfile || !-f $outfile ) { |
1012
|
|
|
|
|
|
|
$outfile = undef; |
1013
|
|
|
|
|
|
|
debug( "ERROR", "failed to create output file from cached file $cf" ); |
1014
|
|
|
|
|
|
|
} |
1015
|
|
|
|
|
|
|
} |
1016
|
|
|
|
|
|
|
} |
1017
|
|
|
|
|
|
|
|
1018
|
|
|
|
|
|
|
my $status = 0; |
1019
|
|
|
|
|
|
|
|
1020
|
|
|
|
|
|
|
# now lets copy it to its final resting place |
1021
|
|
|
|
|
|
|
if ($outfile) { |
1022
|
|
|
|
|
|
|
try { |
1023
|
|
|
|
|
|
|
$status = path($outfile)->copy($filename); |
1024
|
|
|
|
|
|
|
} |
1025
|
|
|
|
|
|
|
catch { |
1026
|
|
|
|
|
|
|
say STDERR "$_ "; |
1027
|
|
|
|
|
|
|
debug( "ERROR", "failed to copy $outfile to $filename" ); |
1028
|
|
|
|
|
|
|
}; |
1029
|
|
|
|
|
|
|
} |
1030
|
|
|
|
|
|
|
return $status; |
1031
|
|
|
|
|
|
|
} |
1032
|
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
=back |
1034
|
|
|
|
|
|
|
|
1035
|
|
|
|
|
|
|
=cut |
1036
|
|
|
|
|
|
|
|
1037
|
|
|
|
|
|
|
# ---------------------------------------------------------------------------- |
1038
|
|
|
|
|
|
|
|
1039
|
|
|
|
|
|
|
1; |
1040
|
|
|
|
|
|
|
|
1041
|
|
|
|
|
|
|
__END__ |