line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Markup::Unified; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# ABSTRACT: A simple, unified interface for Textile, Markdown and BBCode. |
4
|
|
|
|
|
|
|
|
5
|
5
|
|
|
5
|
|
97788
|
use warnings; |
|
5
|
|
|
|
|
11
|
|
|
5
|
|
|
|
|
175
|
|
6
|
5
|
|
|
5
|
|
24
|
use strict; |
|
5
|
|
|
|
|
11
|
|
|
5
|
|
|
|
|
196
|
|
7
|
5
|
|
|
5
|
|
9592
|
use overload ('fallback' => 1, '""' => 'formatted'); |
|
5
|
|
|
|
|
6231
|
|
|
5
|
|
|
|
|
33
|
|
8
|
|
|
|
|
|
|
|
9
|
5
|
|
|
5
|
|
7730
|
use Module::Load::Conditional qw/can_load/; |
|
5
|
|
|
|
|
159026
|
|
|
5
|
|
|
|
|
5348
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $VERSION = "1.000000"; |
12
|
|
|
|
|
|
|
$VERSION = eval $VERSION; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=head1 NAME |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
Markup::Unified - A simple, unified interface for Textile, Markdown and BBCode. |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=head1 SYNOPSIS |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
use Markup::Unified; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
my $o = Markup::Unified->new(); |
23
|
|
|
|
|
|
|
my $text = 'h1. A heading'; |
24
|
|
|
|
|
|
|
$o->format($text, 'textile'); |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
print $o->formatted; # produces "A heading" |
27
|
|
|
|
|
|
|
print $o->unformatted; # produces "h1. A heading" |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# you can also just say: |
30
|
|
|
|
|
|
|
print $o; # same as "print $o->formatted;" |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
=head1 DESCRIPTION |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
This module provides a simple, unified interface for the L, |
35
|
|
|
|
|
|
|
L and L markup languages modules. This module is |
36
|
|
|
|
|
|
|
primarily meant to provide a simple way for application developers to deal |
37
|
|
|
|
|
|
|
with texts that use different markup languages, for example, a message |
38
|
|
|
|
|
|
|
board where users have the ability to post with their preferred markup language. |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
Please note that this module expects your texts to be UTF-8. |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
In order for this module to be useful at any way, at least one of the three |
43
|
|
|
|
|
|
|
parsing modules (L, L or L) |
44
|
|
|
|
|
|
|
must be installed. None of these are required, but if you try to parse |
45
|
|
|
|
|
|
|
a text formatted in any of these markup languages without the respective |
46
|
|
|
|
|
|
|
module being installed on your system, then the text will be returned |
47
|
|
|
|
|
|
|
unformatted, and no errors will be raised. |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=head1 METHODS |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=head2 new() |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
Creates a new, empty instance of Markup::Unified. |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=cut |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub new { |
58
|
0
|
|
|
0
|
1
|
|
my $self = {}; |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
# attempt to load Text::Textile |
61
|
0
|
0
|
|
|
|
|
if (can_load(modules => { 'Text::Textile' => '2.12' })) { |
62
|
0
|
|
|
|
|
|
$self->{t} = Text::Textile->new; |
63
|
0
|
|
|
|
|
|
$self->{t}->charset('utf-8'); |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
# attempt to load Text::Markdown |
67
|
0
|
0
|
|
|
|
|
if (can_load(modules => { 'Text::Markdown' => '1.0.25' })) { |
68
|
0
|
|
|
|
|
|
$self->{m} = Text::Markdown->new; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
# attempt to load HTML::BBCode |
72
|
0
|
0
|
|
|
|
|
if (can_load(modules => { 'HTML::BBCode' => '2.06' })) { |
73
|
0
|
|
|
|
|
|
$self->{b} = HTML::BBCode->new({ stripscripts => 1, linebreaks => 1 }); |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
# attempt to load HTML::Truncate |
77
|
0
|
0
|
|
|
|
|
$self->{trunc} = can_load(modules => { 'HTML::Truncate' => '0.20' }) ? 1 : undef; |
78
|
|
|
|
|
|
|
|
79
|
0
|
|
|
|
|
|
return bless $self, shift; |
80
|
|
|
|
|
|
|
} |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=head2 format( $text, $markup_lang ) |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
Formats the provided text with the provided markup language. |
85
|
|
|
|
|
|
|
C<$markup_lang> must be one of 'bbcode', 'textile' or 'markdown' (case |
86
|
|
|
|
|
|
|
insensitive); otherwise the text will remain unprocessed (which is also |
87
|
|
|
|
|
|
|
true if the appropriate markup module is not installed on your system). |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
=cut |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
sub format { |
92
|
0
|
|
|
0
|
1
|
|
my ($self, $text, $markup_lang) = @_; |
93
|
|
|
|
|
|
|
|
94
|
0
|
|
|
|
|
|
$self->{value} = $text; # keep unformatted text |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
# format according to the formatter |
97
|
0
|
0
|
0
|
|
|
|
if ($markup_lang && $markup_lang =~ m/^bbcode/i) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
98
|
0
|
|
|
|
|
|
$self->{fvalue} = $self->_bbcode($text); |
99
|
|
|
|
|
|
|
} elsif ($markup_lang && $markup_lang =~ m/^textile/i) { |
100
|
0
|
|
|
|
|
|
$self->{fvalue} = $self->_textile($text); |
101
|
|
|
|
|
|
|
} elsif ($markup_lang && $markup_lang =~ m/^markdown/i) { |
102
|
0
|
|
|
|
|
|
$self->{fvalue} = $self->_markdown($text); |
103
|
|
|
|
|
|
|
} else { |
104
|
|
|
|
|
|
|
# either no markup language given or unrecognized language |
105
|
|
|
|
|
|
|
# so formatted = unformatted |
106
|
0
|
|
|
|
|
|
$self->{fvalue} = $text; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
0
|
|
|
|
|
|
return $self; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=head2 formatted() |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
Returns the formatted text of the object, with whatever markup language |
115
|
|
|
|
|
|
|
it was set. |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
This module also provides the ability to print the formatted version of |
118
|
|
|
|
|
|
|
an object without calling C explicitly, so you can just use |
119
|
|
|
|
|
|
|
C. |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
=cut |
122
|
|
|
|
|
|
|
|
123
|
0
|
|
|
0
|
1
|
|
sub formatted { $_[0]->{fvalue} } |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
=head2 unformatted() |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
Returns the unformatted text of the object. |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
=cut |
130
|
|
|
|
|
|
|
|
131
|
0
|
|
|
0
|
1
|
|
sub unformatted { $_[0]->{value} } |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
=head2 truncate([ $length_str, $ellipsis ]) |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
NOTE: This feature requires the presence of the L module. |
136
|
|
|
|
|
|
|
If it is not installed, this method will simply return the output of the |
137
|
|
|
|
|
|
|
L method without raising any errors. |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
This method returns the formatted text of the object, truncated according to the |
140
|
|
|
|
|
|
|
provided length string. This string should be a number followed by one |
141
|
|
|
|
|
|
|
of the characters 'c' or '%'. For example, C<$length_str = '250c'> will |
142
|
|
|
|
|
|
|
return 250 characters from the object's text. C<$length_str = '10%'> will |
143
|
|
|
|
|
|
|
return 10% of the object's text (characterwise). If a length string is |
144
|
|
|
|
|
|
|
not provided, the text will be truncated to 250 characters by default. |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
This is useful when you wish to display just a sample of the text, such |
147
|
|
|
|
|
|
|
as in a list of blog posts, where every listing displays a portion of the |
148
|
|
|
|
|
|
|
post's text with a "Read More" link to the full text in the end. |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
If an C<$ellipsis> is provided, it will be used as the text that will be |
151
|
|
|
|
|
|
|
appended to the truncated HTML (i.e. "Read More"). Read L's |
152
|
|
|
|
|
|
|
documentation for more info. Defaults to … (HTML entity for the |
153
|
|
|
|
|
|
|
'...' ellipsis character). |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=cut |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
sub truncate { |
158
|
0
|
|
|
0
|
1
|
|
my ($self, $length_str, $ellipsis) = @_; |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
# make sure HTML::Truncate is loaded, otherwise just return the |
161
|
|
|
|
|
|
|
# formatted text in its entirety |
162
|
0
|
0
|
|
|
|
|
return $self->formatted unless $self->{trunc}; |
163
|
|
|
|
|
|
|
|
164
|
0
|
|
|
|
|
|
my $ht = HTML::Truncate->new(utf8_mode => 1, on_space => 1); |
165
|
|
|
|
|
|
|
|
166
|
0
|
0
|
|
|
|
|
$length_str =~ m/^(\d+)c$/i ? $ht->chars($1) : |
|
|
0
|
|
|
|
|
|
167
|
|
|
|
|
|
|
m/^(\d+)%$/ ? $ht->percent($1) : $ht->chars(250); |
168
|
|
|
|
|
|
|
|
169
|
0
|
0
|
|
|
|
|
$ht->ellipsis($ellipsis) if $ellipsis; |
170
|
|
|
|
|
|
|
|
171
|
0
|
|
|
|
|
|
return $ht->truncate($self->formatted); |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
=head2 supports( $markup_lang ) |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
Returns a true value if the requested markup language is supported by |
177
|
|
|
|
|
|
|
this module (which basically means the appropriate module is installed |
178
|
|
|
|
|
|
|
and loaded). C<$markup_lang> must be one of 'textile', 'bbcode' or 'markdown' |
179
|
|
|
|
|
|
|
(case insensitive). |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
Returns a false value if the requested language is not supported. |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=cut |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
sub supports { |
186
|
0
|
|
|
0
|
1
|
|
my ($self, $markup_lang) = @_; |
187
|
|
|
|
|
|
|
|
188
|
0
|
0
|
0
|
|
|
|
if ($markup_lang =~ m/^textile$/i && $self->{t}) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
0
|
|
|
|
|
189
|
0
|
|
|
|
|
|
return 1; |
190
|
|
|
|
|
|
|
} elsif ($markup_lang =~ m/^markdown$/i && $self->{m}) { |
191
|
0
|
|
|
|
|
|
return 1; |
192
|
|
|
|
|
|
|
} elsif ($markup_lang =~ m/^bbcode$/i && $self->{b}) { |
193
|
0
|
|
|
|
|
|
return 1; |
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
0
|
|
|
|
|
|
return; |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
################################################## |
200
|
|
|
|
|
|
|
# INTERNAL METHODS # |
201
|
|
|
|
|
|
|
################################################## |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
# format BBCode |
204
|
|
|
|
|
|
|
sub _bbcode { |
205
|
0
|
|
|
0
|
|
|
my ($self, $text) = @_; |
206
|
|
|
|
|
|
|
|
207
|
0
|
0
|
|
|
|
|
return $self->{b} ? $self->{b}->parse($text) : $text; |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
# format Textile |
211
|
|
|
|
|
|
|
sub _textile { |
212
|
0
|
|
|
0
|
|
|
my ($self, $text) = @_; |
213
|
|
|
|
|
|
|
|
214
|
0
|
0
|
|
|
|
|
return $self->{t} ? $self->{t}->textile($text) : $text; |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
# format Markdown |
218
|
|
|
|
|
|
|
sub _markdown { |
219
|
0
|
|
|
0
|
|
|
my ($self, $text) = @_; |
220
|
|
|
|
|
|
|
|
221
|
0
|
0
|
|
|
|
|
return $self->{m} ? $self->{m}->markdown($text) : $text; |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
=head1 DIAGNOSTICS |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
This module does not throw any exceptions (by itself). |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
=head1 CONFIGURATION AND ENVIRONMENT |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
C requires no configuration files or environment variables. |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=head1 DEPENDENCIES |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
C B on the following CPAN modules: |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
=over |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
=item * L |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=back |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
C B one or more of these modules to actually be |
243
|
|
|
|
|
|
|
of any function: |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=over |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
=item * L |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
=item * L |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
=item * L |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
=item * L |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
=back |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
=head1 INCOMPATIBILITIES WITH OTHER MODULES |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
None reported. |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
=head1 BUGS AND LIMITATIONS |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
No bugs have been reported. |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
Please report any bugs or feature requests to |
266
|
|
|
|
|
|
|
C, or through the web interface at |
267
|
|
|
|
|
|
|
L. |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
=head1 AUTHOR |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
Ido Perlmuter |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
Copyright (c) 2009-2015, Ido Perlmuter C<< ido at ido50 dot net >>. |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
This module is free software; you can redistribute it and/or |
278
|
|
|
|
|
|
|
modify it under the same terms as Perl itself, either version |
279
|
|
|
|
|
|
|
5.8.1 or any later version. See L |
280
|
|
|
|
|
|
|
and L. |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
The full text of the license can be found in the |
283
|
|
|
|
|
|
|
LICENSE file included with this module. |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
=head1 DISCLAIMER OF WARRANTY |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY |
288
|
|
|
|
|
|
|
FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN |
289
|
|
|
|
|
|
|
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES |
290
|
|
|
|
|
|
|
PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER |
291
|
|
|
|
|
|
|
EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED |
292
|
|
|
|
|
|
|
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE |
293
|
|
|
|
|
|
|
ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH |
294
|
|
|
|
|
|
|
YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL |
295
|
|
|
|
|
|
|
NECESSARY SERVICING, REPAIR, OR CORRECTION. |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING |
298
|
|
|
|
|
|
|
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR |
299
|
|
|
|
|
|
|
REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE |
300
|
|
|
|
|
|
|
LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, |
301
|
|
|
|
|
|
|
OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE |
302
|
|
|
|
|
|
|
THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING |
303
|
|
|
|
|
|
|
RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A |
304
|
|
|
|
|
|
|
FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF |
305
|
|
|
|
|
|
|
SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF |
306
|
|
|
|
|
|
|
SUCH DAMAGES. |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
=cut |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
1; |
311
|
|
|
|
|
|
|
__END__ |