File Coverage

blib/lib/Markup/Unified.pm
Criterion Covered Total %
statement 12 50 24.0
branch 0 34 0.0
condition 0 18 0.0
subroutine 4 13 30.7
pod 6 6 100.0
total 22 121 18.1


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__