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