Codebase list libtext-textile-perl / 3a29876
[svn-inject] Installing original source of libtext-textile-perl Jaldhar H. Vyas 17 years ago
11 changed file(s) with 3811 addition(s) and 0 deletion(s). Raw diff Collapse all Expand all
0
1
2
3
4 The "Artistic License"
5
6 Preamble
7
8 The intent of this document is to state the conditions under which a
9 Package may be copied, such that the Copyright Holder maintains some
10 semblance of artistic control over the development of the package,
11 while giving the users of the package the right to use and distribute
12 the Package in a more-or-less customary fashion, plus the right to make
13 reasonable modifications.
14
15 Definitions:
16
17 "Package" refers to the collection of files distributed by the
18 Copyright Holder, and derivatives of that collection of files
19 created through textual modification.
20
21 "Standard Version" refers to such a Package if it has not been
22 modified, or has been modified in accordance with the wishes
23 of the Copyright Holder as specified below.
24
25 "Copyright Holder" is whoever is named in the copyright or
26 copyrights for the package.
27
28 "You" is you, if you're thinking about copying or distributing
29 this Package.
30
31 "Reasonable copying fee" is whatever you can justify on the
32 basis of media cost, duplication charges, time of people involved,
33 and so on. (You will not be required to justify it to the
34 Copyright Holder, but only to the computing community at large
35 as a market that must bear the fee.)
36
37 "Freely Available" means that no fee is charged for the item
38 itself, though there may be fees involved in handling the item.
39 It also means that recipients of the item may redistribute it
40 under the same conditions they received it.
41
42 1. You may make and give away verbatim copies of the source form of the
43 Standard Version of this Package without restriction, provided that you
44 duplicate all of the original copyright notices and associated disclaimers.
45
46 2. You may apply bug fixes, portability fixes and other modifications
47 derived from the Public Domain or from the Copyright Holder. A Package
48 modified in such a way shall still be considered the Standard Version.
49
50 3. You may otherwise modify your copy of this Package in any way, provided
51 that you insert a prominent notice in each changed file stating how and
52 when you changed that file, and provided that you do at least ONE of the
53 following:
54
55 a) place your modifications in the Public Domain or otherwise make them
56 Freely Available, such as by posting said modifications to Usenet or
57 an equivalent medium, or placing the modifications on a major archive
58 site such as uunet.uu.net, or by allowing the Copyright Holder to include
59 your modifications in the Standard Version of the Package.
60
61 b) use the modified Package only within your corporation or organization.
62
63 c) rename any non-standard executables so the names do not conflict
64 with standard executables, which must also be provided, and provide
65 a separate manual page for each non-standard executable that clearly
66 documents how it differs from the Standard Version.
67
68 d) make other distribution arrangements with the Copyright Holder.
69
70 4. You may distribute the programs of this Package in object code or
71 executable form, provided that you do at least ONE of the following:
72
73 a) distribute a Standard Version of the executables and library files,
74 together with instructions (in the manual page or equivalent) on where
75 to get the Standard Version.
76
77 b) accompany the distribution with the machine-readable source of
78 the Package with your modifications.
79
80 c) give non-standard executables non-standard names, and clearly
81 document the differences in manual pages (or equivalent), together
82 with instructions on where to get the Standard Version.
83
84 d) make other distribution arrangements with the Copyright Holder.
85
86 5. You may charge a reasonable copying fee for any distribution of this
87 Package. You may charge any fee you choose for support of this
88 Package. You may not charge a fee for this Package itself. However,
89 you may distribute this Package in aggregate with other (possibly
90 commercial) programs as part of a larger (possibly commercial) software
91 distribution provided that you do not advertise this Package as a
92 product of your own. You may embed this Package's interpreter within
93 an executable of yours (by linking); this shall be construed as a mere
94 form of aggregation, provided that the complete Standard Version of the
95 interpreter is so embedded.
96
97 6. The scripts and library files supplied as input to or produced as
98 output from the programs of this Package do not automatically fall
99 under the copyright of this Package, but belong to whoever generated
100 them, and may be sold commercially, and may be aggregated with this
101 Package. If such scripts or library files are aggregated with this
102 Package via the so-called "undump" or "unexec" methods of producing a
103 binary executable image, then distribution of such an image shall
104 neither be construed as a distribution of this Package nor shall it
105 fall under the restrictions of Paragraphs 3 and 4, provided that you do
106 not represent such an executable image as a Standard Version of this
107 Package.
108
109 7. C subroutines (or comparably compiled subroutines in other
110 languages) supplied by you and linked into this Package in order to
111 emulate subroutines and variables of the language defined by this
112 Package shall not be considered part of this Package, but are the
113 equivalent of input as in Paragraph 6, provided these subroutines do
114 not change the language in any way that would cause it to fail the
115 regression tests for the language.
116
117 8. Aggregation of this Package with a commercial distribution is always
118 permitted provided that the use of this Package is embedded; that is,
119 when no overt attempt is made to make this Package's interfaces visible
120 to the end user of the commercial distribution. Such use shall not be
121 construed as a distribution of this Package.
122
123 9. The name of the Copyright Holder may not be used to endorse or promote
124 products derived from this software without specific prior written permission.
125
126 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
127 IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
128 WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
129
130 The End
0 2.03 - No changes. Just needed to bump version # for CPAN.
1
2 2.02 - Removed Encode package usage altogether until compatability
3 issues can be ironed out. Modified newline translation to be more
4 cross-platform friendly.
5
6 2.01 - Patches to fix issues with older versions of Perl.
7
8 2.0 - Many, many fixes and improvments.
9
10 - Added 'dl' paragraph block which allows for definition lists.
11
12 - Improved support for embedded HTML.
13
14 - Better processing for multiple inline formatting options within the
15 same line and/or same section of text.
16
17 - Added 'bc.' marker for future 'blockcode' tag (emits a pre, code pair
18 for HTML, XHTML1 output).
19
20 - Added CSS class/id, style, language assignment to markers.
21
22 - Support for alignment for paragraphs, tables, images.
23
24 - ':url' can now be appended to 'hn.', 'bq.', 'p.' to add a 'cite'
25 attribute using the specified URL.
26
27 - Stripped attributes from 'table' tag for Wiki-like markup.
28
29 1.1 - A number of regex updates.
30
31 - If emphasis, strong, etc. shorthand appears at the start of the line,
32 they are now handled properly.
33
34 - Hand-entered HTML entities are preserved for non-'pre' blocks (meaning
35 text that isn't in a 'pre' tag). This is different from 1.0, so please
36 take note. Standalone '&' characters will still be escaped.
37
38 - Additional TLDs were added to the URL regex.
39
40 - A paragraph tag is now used for the content of the 'bq.' marker.
41
42 - Nesting emphasis and strong formats should work better now.
43
44 - Added CSS class support for images.
45
46 - Added link support for images.
47
48 - Added image dimension support for images.
49
50 - Fixed a bug that was causing one of those 'internal server errors'.
51
52 1.0 - Initial release
0 ARTISTIC
1 MANIFEST
2 Makefile.PL
3 README
4 INSTALL
5 Changes
6 lib/Text/Textile.pm
0 use ExtUtils::MakeMaker;
1 WriteMakefile(
2 'NAME' => 'Text::Textile',
3 'VERSION_FROM' => 'lib/Text/Textile.pm',
4 ($] >= 5.005 ?
5 (ABSTRACT_FROM => 'lib/Text/Textile.pm',
6 AUTHOR => 'Brad Choate <brad@bradchoate.com>') : ()),
7 );
0 Text::Textile - a Perl implementation of Textile
1
2
3 DESCRIPTION
4
5 Text::Textile is a Perl impementation of the Textile formatting language.
6
7
8 DOCUMENTATION
9
10 Documentation for this module is available in Textile.pm in POD format.
11
12
13 INSTALLATION
14
15 Traditional Perl module installation applies here:
16
17 perl Makefile.PL
18 make
19 make test
20 make install
21
22
23 CONTACT INFORMATION
24
25 This module was written by Brad Choate (bradchoate.com), based off the hard
26 work of Dean Allen (textism.com).
27
28
29 LICENSE
30
31 This module is released under the Artistic license which allows it to be
32 distributed and/or modified under the same terms as Perl itself.
33
0 # $Id: Textile.pm,v 1.16 2004/02/19 14:52:58 brad Exp $
1
2 package Text::Textile;
3
4 use strict;
5 use Exporter;
6 @Text::Textile::ISA = qw(Exporter);
7 use vars qw(@EXPORT_OK $VERSION $debug);
8 @EXPORT_OK = qw(textile);
9 $VERSION = 2.03;
10
11 $debug = 0;
12
13 sub new {
14 my $class = shift;
15 my %options = @_;
16 $options{filters} ||= {};
17 $options{charset} ||= 'iso-8859-1';
18 $options{char_encoding} = 1 unless exists $options{char_encoding};
19 $options{do_quotes} = 1 unless exists $options{do_quotes};
20 $options{trim_spaces} = 0 unless exists $options{trim_spaces};
21 $options{smarty_mode} = 1 unless exists $options{smarty_mode};
22 $options{preserve_spaces} = 0 unless exists $options{preserve_spaces};
23 $options{head_offset} = 0 unless exists $options{head_offset};
24
25 my $self = bless \%options, $class;
26 if (exists $options{css}) {
27 $self->css($options{css});
28 }
29 $options{macros} ||= $self->default_macros();
30 if (exists $options{flavor}) {
31 $self->flavor($options{flavor});
32 } else {
33 $self->flavor('xhtml1/css');
34 }
35 $self;
36 }
37
38 # getter/setter methods...
39
40 sub set {
41 my $self = shift;
42 my $opt = shift;
43 if (ref $opt eq 'HASH') {
44 $self->set($_, $opt->{$_}) foreach %$opt;
45 } else {
46 my $value = shift;
47 # the following options have special set methods
48 # that activate upon setting:
49 if ($opt eq 'charset') {
50 $self->charset($value);
51 } elsif ($opt eq 'css') {
52 $self->css($value);
53 } elsif ($opt eq 'flavor') {
54 $self->flavor($value);
55 } else {
56 $self->{$opt} = $value;
57 }
58 }
59 }
60
61 sub get {
62 my $self = shift;
63 return $self->{shift} if @_;
64 undef;
65 }
66
67 sub disable_html {
68 my $self = shift;
69 if (@_) {
70 $self->{disable_html} = shift;
71 }
72 $self->{disable_html} || 0;
73 }
74
75 sub head_offset {
76 my $self = shift;
77 if (@_) {
78 $self->{head_offset} = shift;
79 }
80 $self->{head_offset} || 0;
81 }
82
83 sub flavor {
84 my $self = shift;
85 if (@_) {
86 my $flavor = shift;
87 $self->{flavor} = $flavor;
88 if ($flavor =~ m/^xhtml(\d)?(\D|$)/) {
89 if ($1 eq '2') {
90 $self->{_line_open} = '<l>';
91 $self->{_line_close} = '</l>';
92 $self->{_blockcode_open} = '<blockcode>';
93 $self->{_blockcode_close} = '</blockcode>';
94 $self->{css_mode} = 1;
95 } else {
96 # xhtml 1.x
97 $self->{_line_open} = '';
98 $self->{_line_close} = '<br />';
99 $self->{_blockcode_open} = '<pre><code>';
100 $self->{_blockcode_close} = '</code></pre>';
101 $self->{css_mode} = 1;
102 }
103 } elsif ($flavor =~ m/^html/) {
104 $self->{_line_open} = '';
105 $self->{_line_close} = '<br>';
106 $self->{_blockcode_open} = '<pre><code>';
107 $self->{_blockcode_close} = '</code></pre>';
108 $self->{css_mode} = $flavor =~ m/\/css/;
109 }
110 $self->_css_defaults() if $self->{css_mode} && !exists $self->{css};
111 }
112 $self->{flavor};
113 }
114
115 sub css {
116 my $self = shift;
117 if (@_) {
118 my $css = shift;
119 if (ref $css eq 'HASH') {
120 $self->{css} = $css;
121 $self->{css_mode} = 1;
122 } else {
123 $self->{css_mode} = $css;
124 $self->_css_defaults() if $self->{css_mode} && !exists $self->{css};
125 }
126 }
127 $self->{css_mode} ? $self->{css} : 0;
128 }
129
130 sub charset {
131 my $self = shift;
132 if (@_) {
133 $self->{charset} = shift;
134 if ($self->{charset} =~ m/^utf-?8$/i) {
135 $self->char_encoding(0);
136 } else {
137 $self->char_encoding(1);
138 }
139 }
140 $self->{charset};
141 }
142
143 sub docroot {
144 my $self = shift;
145 $self->{docroot} = shift if @_;
146 $self->{docroot};
147 }
148
149 sub trim_spaces {
150 my $self = shift;
151 $self->{trim_spaces} = shift if @_;
152 $self->{trim_spaces};
153 }
154
155 sub filter_param {
156 my $self = shift;
157 $self->{filter_param} = shift if @_;
158 $self->{filter_param};
159 }
160
161 sub preserve_spaces {
162 my $self = shift;
163 $self->{preserve_spaces} = shift if @_;
164 $self->{preserve_spaces};
165 }
166
167 sub filters {
168 my $self = shift;
169 $self->{filters} = shift if @_;
170 $self->{filters};
171 }
172
173 sub char_encoding {
174 my $self = shift;
175 $self->{char_encoding} = shift if @_;
176 $self->{char_encoding};
177 }
178
179 sub handle_quotes {
180 my $self = shift;
181 $self->{do_quotes} = shift if @_;
182 $self->{do_quotes};
183 }
184
185 # end of getter/setter methods
186
187 # a URL discovery regex. This is from Mastering Regex from O'Reilly.
188 # Some modifications by Brad Choate <brad@bradchoate.com>
189 use vars qw($urlre $blocktags $clstyre $clstypadre $clstyfiltre
190 $alignre $valignre $halignre $imgalignre $tblalignre
191 $codere $punct);
192 $urlre = qr{
193 # Must start out right...
194 (?=[a-zA-Z0-9./#])
195 # Match the leading part (proto://hostname, or just hostname)
196 (?:
197 # ftp://, http://, or https:// leading part
198 (?:ftp|https?|telnet|nntp)://(?:\w+(?::\w+)?@)?[-\w]+(?:\.\w[-\w]*)+
199 |
200 (?:mailto:)?[-\+\w]+\@[-\w]+(?:\.\w[-\w]*)+
201 |
202 # or, try to find a hostname with our more specific sub-expression
203 (?i: [a-z0-9] (?:[-a-z0-9]*[a-z0-9])? \. )+ # sub domains
204 # Now ending .com, etc. For these, require lowercase
205 (?-i: com\b
206 | edu\b
207 | biz\b
208 | gov\b
209 | in(?:t|fo)\b # .int or .info
210 | mil\b
211 | net\b
212 | org\b
213 | museum\b
214 | aero\b
215 | coop\b
216 | name\b
217 | pro\b
218 | [a-z][a-z]\b # two-letter country codes
219 )
220 )?
221
222 # Allow an optional port number
223 (?: : \d+ )?
224
225 # The rest of the URL is optional, and begins with / . . .
226 (?:
227 /?
228 # The rest are heuristics for what seems to work well
229 [^.!,?;:"'<>()\[\]{}\s\x7F-\xFF]*
230 (?:
231 [.!,?;:]+ [^.!,?;:"'<>()\[\]{}\s\x7F-\xFF]+ #'"
232 )*
233 )?
234 }x;
235
236 $punct = qr{[\!"#\$%&'()\*\+,\-\./:;<=>\?@\[\\\]\^_`{\|}\~]};
237 $valignre = qr/[\-^~]/;
238 $tblalignre = qr/[<>=]/;
239 $halignre = qr/(?:<>|[<>=])/;
240 $alignre = qr/(?:$valignre|<>$valignre?|$valignre?<>|$valignre?$halignre?|$halignre?$valignre?)(?!\w)/;
241 $imgalignre = qr/(?:[<>]|$valignre){1,2}/;
242
243 $clstypadre = qr/
244 (?:\([A-Za-z0-9_\- \#]+\))
245 |
246 (?:{
247 (?: \( [^)]+ \) | [^}] )+
248 })
249 |
250 (?:\(+? (?![A-Za-z0-9_\-\#]) )
251 |
252 (?:\)+?)
253 |
254 (?: \[ [a-zA-Z\-]+? \] )
255 /x;
256
257 $clstyre = qr!
258 (?:\([A-Za-z0-9_\- \#]+\))
259 |
260 (?:{
261 [A-Za-z0-9_\-](?: \( [^)]+ \) | [^}] )+
262 })
263 |
264 (?: \[ [a-zA-Z\-]+? \] )
265 !x;
266
267 $clstyfiltre = qr/
268 (?:\([A-Za-z0-9_\- \#]+\))
269 |
270 (?:{
271 [A-Za-z0-9_\-](?: \( [^)]+ \) | [^}] )+
272 })
273 |
274 (?:\|[^\|]+\|)
275 |
276 (?:\(+?(?![A-Za-z0-9_\-\#]))
277 |
278 (?:\)+)
279 |
280 (?: \[ [a-zA-Z]+? \] )
281 /x;
282
283 $codere = qr!
284 (?:
285 [\[{]
286 @ # opening
287 (?:\[([A-Za-z0-9]+)\])? # $1: language id
288 (.+?) # $2: code
289 @ # closing
290 [\]}]
291 )
292 |
293 (?:
294 (?:^|(?<=[\s\(]))
295 @ # opening
296 (?:\[([A-Za-z0-9]+)\])? # $3: language id
297 ([^\s].+?[^\s]) # $4: code itself
298 @ # closing
299 (?:$|(?=$punct{1,2}|\s))
300 )
301 !x;
302
303 $blocktags = qr{
304 <
305 (( /? ( h[1-6]
306 | p
307 | pre
308 | div
309 | table
310 | t[rdh]
311 | [ou]l
312 | li
313 | block(?:quote|code)
314 | form
315 | input
316 | select
317 | option
318 | textarea
319 )
320 [ >]
321 )
322 | !--
323 )
324 }x;
325
326 sub process {
327 my $self = shift;
328 $self->textile(@_);
329 }
330
331 sub textile {
332 my $self = shift;
333 my ($str) = @_;
334
335 # disable warnings for the sake of various regex that
336 # have optional matches
337 local $^W = 0;
338
339 if (!ref $self) {
340 # oops -- procedural technique used, so make
341 # set $str to $self and instantiate a new object
342 # for self
343 $str = $self;
344 $self = new Text::Textile;
345 }
346
347 # quick translator for abbreviated block names
348 # to their tag
349 my %macros = ('bq' => 'blockquote');
350
351 # an array to hold any portions of the text to be preserved
352 # without further processing by Textile
353 my @repl;
354
355 # strip out extra newline characters. we're only matching for \n herein
356 #$str =~ s!(?:\r?\n|\r)!\n!g;
357 $str =~ s!(?:\015?\012|\015)!\n!g;
358
359 # optionally remove trailing spaces
360 $str =~ s/ +$//gm if $self->{trim_spaces};
361
362 # preserve contents of the '==', 'pre', 'blockcode' sections
363 $str =~ s{(^|\n\n)==(.+?)==($|\n\n)}
364 {$1."\n\n"._repl(\@repl, $self->format_block(text => $2))."\n\n".$3}ges;
365
366 unless ($self->{disable_html}) {
367 # preserve style, script tag contents
368 $str =~ s!(<(style|script)(?:>| .+?>).*?</\2>)!_repl(\@repl, $1)!ges;
369
370 # preserve HTML comments
371 $str =~ s|(<!--.+?-->)|_repl(\@repl, $1)|ges;
372
373 # preserve pre block contents, encode contents by default
374 my $pre_start = scalar(@repl);
375 $str =~ s{(<pre(?: [^>]*)?>)(.+?)(</pre>)}
376 {"\n\n"._repl(\@repl, $1.$self->encode_html($2, 1).$3)."\n\n"}ges;
377 # fix code tags within pre blocks we just saved.
378 for (my $i = $pre_start; $i < scalar(@repl); $i++) {
379 $repl[$i] =~ s|&lt;(/?)code(.*?)&gt;|<$1code$2>|gs;
380 }
381
382 # preserve code blocks by default, encode contents
383 $str =~ s{(<code(?: [^>]+)?>)(.+?)(</code>)}
384 {_repl(\@repl, $1.$self->encode_html($2, 1).$3)}ges;
385
386 # encode blockcode tag (an XHTML 2 tag) and encode it's
387 # content by default
388 $str =~ s{(<blockcode(?: [^>]+)?>)(.+?)(</blockcode>)}
389 {"\n\n"._repl(\@repl, $1.$self->encode_html($2, 1).$3)."\n\n"}ges;
390
391 # preserve PHPish, ASPish code
392 $str =~ s!(<([\?\%]).*?(\2)>)!_repl(\@repl, $1)!ges;
393 }
394
395 # pass through and remove links that follow this format
396 # [id_without_spaces (optional title text)]url
397 # lines like this are stripped from the content, and can be
398 # referred to using the "link text":id_without_spaces syntax
399 my %links;
400 $str =~ s{(?:\n|^) [ ]* \[ ([^ ]+?) [ ]*? (?:\( (.+?) \) )? \] ((?:(?:ftp|https?|telnet|nntp)://|/)[^ ]+?) [ ]* (\n|$)}
401 {($links{$1} = {url => $3, title => $2}),"$4"}gemx;
402 local $self->{links} = \%links;
403
404 # eliminate starting/ending blank lines
405 $str =~ s/^\n+//s;
406 $str =~ s/\n+$//s;
407
408 # split up text into paragraph blocks, capturing newlines too
409 my @para = split /(\n{2,})/, $str;
410 my ($block, $bqlang, $filter, $class, $sticky, @lines,
411 $style, $stickybuff, $lang, $clear);
412
413 my $out = '';
414
415 foreach my $para (@para) {
416 if ($para =~ m/^\n+$/s) {
417 if ($sticky && defined $stickybuff) {
418 $stickybuff .= $para;
419 } else {
420 $out .= $para;
421 }
422 next;
423 }
424
425 if ($sticky) {
426 $sticky++;
427 } else {
428 $block = undef;
429 $class = undef;
430 $style = '';
431 $lang = undef;
432 }
433
434 my ($id, $cite, $align, $padleft, $padright, @lines, $buffer);
435 if ($para =~ m/^(h[1-6]|p|bq|bc|fn\d+)
436 ((?:$clstyfiltre*|$halignre)*)
437 (\.\.?)
438 (?::(\d+|$urlre))?\ /gx) {
439 if ($sticky) {
440 if ($block eq 'bc') {
441 # close our blockcode section
442 $out =~ s/\n\n$//;
443 $out .= $self->{_blockcode_close}."\n\n";
444 } elsif ($block eq 'bq') {
445 $out =~ s/\n\n$//;
446 $out .= '</blockquote>'."\n\n";
447 } elsif ($block eq 'table') {
448 my $table_out = $self->format_table(text => $stickybuff);
449 $table_out = '' if !defined $table_out;
450 $out .= $table_out;
451 $stickybuff = undef;
452 } elsif ($block eq 'dl') {
453 my $dl_out = $self->format_deflist(text => $stickybuff);
454 $dl_out = '' if !defined $dl_out;
455 $out .= $dl_out;
456 $stickybuff = undef;
457 }
458 $sticky = 0;
459 }
460 # block macros: h[1-6](class)., bq(class)., bc(class)., p(class).
461 #warn "paragraph: [[$para]]\n\tblock: $1\n\tparams: $2\n\tcite: $4";
462 $block = $1;
463 my $params = $2;
464 $cite = $4;
465 if ($3 eq '..') {
466 $sticky = 1;
467 } else {
468 $sticky = 0;
469 $class = undef;
470 $bqlang = undef;
471 $lang = undef;
472 $style = '';
473 $filter = undef;
474 }
475 if ($block =~ m/^h([1-6])$/) {
476 if ($self->{head_offset}) {
477 $block = 'h' . ($1 + $self->{head_offset});
478 }
479 }
480 if ($params =~ m/($halignre+)/) {
481 $align = $1;
482 $params =~ s/$halignre+//;
483 }
484 if (defined $params) {
485 if ($params =~ m/\|(.+)\|/) {
486 $filter = $1;
487 $params =~ s/\|.+?\|//;
488 }
489 if ($params =~ m/{([^}]+)}/) {
490 $style = $1;
491 $style =~ s/\n/ /g;
492 $params =~ s/{[^}]+}//g;
493 }
494 if ($params =~ m/\(([A-Za-z0-9_\-\ ]+?)(?:\#(.+?))?\)/ ||
495 $params =~ m/\(([A-Za-z0-9_\-\ ]+?)?(?:\#(.+?))\)/) {
496 if ($1 || $2) {
497 $class = $1;
498 $id = $2;
499 if ($class) {
500 $params =~ s/\([A-Za-z0-9_\-\ ]+?(#.*?)?\)//g;
501 } elsif ($id) {
502 $params =~ s/\(#.+?\)//g;
503 }
504 }
505 }
506 if ($params =~ m/(\(+)/) {
507 $padleft = length($1);
508 $params =~ s/\(+//;
509 }
510 if ($params =~ m/(\)+)/) {
511 $padright = length($1);
512 $params =~ s/\)+//;
513 }
514 if ($params =~ m/\[(.+?)\]/) {
515 $lang = $1;
516 if ($block eq 'bc') {
517 $bqlang = $lang;
518 $lang = undef;
519 }
520 $params =~ s/\[.+?\]//;
521 }
522 }
523 #warn "settings:\n\tblock: $block\n\tpadleft: $padleft\n\tpadright: $padright\n\tclass: $class\n\tstyle: $style\n\tid: $id\n\tfilter: $filter\n\talign: $align\n\tlang: $lang\n\tsticky: $sticky";
524 $para = substr($para, pos($para));
525 } elsif ($para =~ m|^<textile#(\d+)>$|) {
526 $buffer = $repl[$1-1];
527 } elsif ($para =~ m/^clear([<>]+)?\.$/) {
528 if ($1 eq '<') {
529 $clear = 'left';
530 } elsif ($1 eq '>') {
531 $clear = 'right';
532 } else {
533 $clear = 'both';
534 }
535 next;
536 } elsif ($sticky && (defined $stickybuff) &&
537 ($block eq 'table' || $block eq 'dl')) {
538 $stickybuff .= $para;
539 next;
540 } elsif ($para =~ m/^(?:$halignre|$clstypadre*)*
541 [\*\#]
542 (?:$halignre|$clstypadre*)*
543 \ /x) {
544 # '*', '#' prefix means a list
545 $buffer = $self->format_list(text => $para);
546 } elsif ($para =~ m/^(?:table(?:$tblalignre|$clstypadre*)*
547 (\.\.?)\s+)?
548 (?:_|$alignre|$clstypadre*)*\|/x) {
549 # handle wiki-style tables
550 if (defined $1 && ($1 eq '..')) {
551 $block = 'table';
552 $stickybuff = $para;
553 $sticky = 1;
554 next;
555 } else {
556 $buffer = $self->format_table(text => $para);
557 }
558 } elsif ($para =~ m/^(?:dl(?:$clstyre)*(\.\.?)\s+)/) {
559 # handle definition lists
560 if (defined $1 && ($1 eq '..')) {
561 $block = 'dl';
562 $stickybuff = $para;
563 $sticky = 1;
564 next;
565 } else {
566 $buffer = $self->format_deflist(text => $para);
567 }
568 }
569 if (defined $buffer) {
570 $out .= $buffer;
571 next;
572 }
573 @lines = split /\n/, $para;
574 next unless @lines;
575
576 $block ||= 'p';
577
578 $buffer = '';
579 my $pre = '';
580 my $post = '';
581
582 if ($block eq 'bc') {
583 if ($sticky <= 1) {
584 $pre .= $self->{_blockcode_open};
585 $pre =~ s/>$//s;
586 $pre .= qq{ language="$bqlang"} if $bqlang;
587 if ($align) {
588 my $alignment = _halign($align);
589 if ($self->{css_mode}) {
590 if (($padleft || $padright) &&
591 (($alignment eq 'left') || ($alignment eq 'right'))) {
592 $style .= ';float:'.$alignment;
593 } else {
594 $style .= ';text-align:'.$alignment;
595 }
596 $class .= ' '.$self->{css}{"class_align_$alignment"} || $alignment;
597 } else {
598 $pre .= qq{ align="$alignment"} if $alignment;
599 }
600 }
601 $style .= qq{;padding-left:${padleft}em} if $padleft;
602 $style .= qq{;padding-right:${padright}em} if $padright;
603 $style .= qq{;clear:${clear}} if $clear;
604 $class =~ s/^ // if $class;
605 $pre .= qq{ class="$class"} if $class;
606 $pre .= qq{ id="$id"} if $id;
607 $style =~ s/^;// if $style;
608 $pre .= qq{ style="$style"} if $style;
609 $pre .= qq{ lang="$lang"} if $lang;
610 $pre .= '>';
611 $lang = undef;
612 $bqlang = undef;
613 $clear = undef;
614 }
615 $para =~ s{(?:^|(?<=[\s>])|([{[]))
616 ==(.+?)==
617 (?:$|([\]}])|(?=$punct{1,2}|\s))}
618 {_repl(\@repl, $self->format_block(text => $2, inline => 1, pre => $1, post => $3))}gesx;
619 $buffer .= $self->encode_html_basic($para, 1);
620 $buffer =~ s/&lt;textile#(\d+)&gt;/<textile#$1>/g;
621 if ($sticky == 0) {
622 $post .= $self->{_blockcode_close};
623 }
624 $out .= $pre . $buffer . $post;
625 next;
626 } elsif ($block eq 'bq') {
627 if ($sticky <= 1) {
628 $pre .= '<blockquote';
629 if ($align) {
630 my $alignment = _halign($align);
631 if ($self->{css_mode}) {
632 if (($padleft || $padright) &&
633 (($alignment eq 'left') || ($alignment eq 'right'))) {
634 $style .= ';float:'.$alignment;
635 } else {
636 $style .= ';text-align:'.$alignment;
637 }
638 $class .= ' '.$self->{css}{"class_align_$alignment"} || $alignment;
639 } else {
640 $pre .= qq{ align="$alignment"} if $alignment;
641 }
642 }
643 $style .= qq{;padding-left:${padleft}em} if $padleft;
644 $style .= qq{;padding-right:${padright}em} if $padright;
645 $style .= qq{;clear:${clear}} if $clear;
646 $class =~ s/^ // if $class;
647 $pre .= qq{ class="$class"} if $class;
648 $pre .= qq{ id="$id"} if $id;
649 $style =~ s/^;// if $style;
650 $pre .= qq{ style="$style"} if $style;
651 $pre .= qq{ lang="$lang"} if $lang;
652 $pre .= qq{ cite="} . $self->format_url(url => $cite) . '"' if defined $cite; #'
653 $pre .= '>';
654 $clear = undef;
655 }
656 $pre .= '<p>';
657 } elsif ($block =~ m/fn(\d+)/) {
658 my $fnum = $1;
659 $pre .= '<p';
660 $class .= ' '.$self->{css}{class_footnote} if $self->{css}{class_footnote};
661 if ($align) {
662 my $alignment = _halign($align);
663 if ($self->{css_mode}) {
664 if (($padleft || $padright) &&
665 (($alignment eq 'left') || ($alignment eq 'right'))) {
666 $style .= ';float:'.$alignment;
667 } else {
668 $style .= ';text-align:'.$alignment;
669 }
670 $class .= $self->{css}{"class_align_$alignment"} || $alignment;
671 } else {
672 $pre .= qq{ align="$alignment"};
673 }
674 }
675 $style .= qq{;padding-left:${padleft}em} if $padleft;
676 $style .= qq{;padding-right:${padright}em} if $padright;
677 $style .= qq{;clear:${clear}} if $clear;
678 $class =~ s/^ // if $class;
679 $pre .= qq{ class="$class"} if $class;
680 $pre .= qq{ id="}.($self->{css}{id_footnote_prefix}||'fn').$fnum.'"';
681 $style =~ s/^;// if $style;
682 $pre .= qq{ style="$style"} if $style;
683 $pre .= qq{ lang="$lang"} if $lang;
684 $pre .= '>';
685 $pre .= '<sup>'.$fnum.'</sup> ';
686 # we can close like a regular paragraph tag now
687 $block = 'p';
688 $clear = undef;
689 } else {
690 $pre .= '<' . ($macros{$block} || $block);
691 if ($align) {
692 my $alignment = _halign($align);
693 if ($self->{css_mode}) {
694 if (($padleft || $padright) &&
695 (($alignment eq 'left') || ($alignment eq 'right'))) {
696 $style .= ';float:'.$alignment;
697 } else {
698 $style .= ';text-align:'.$alignment;
699 }
700 $class .= ' '.$self->{css}{"class_align_$alignment"} || $alignment;
701 } else {
702 $pre .= qq{ align="$alignment"};
703 }
704 }
705 $style .= qq{;padding-left:${padleft}em} if $padleft;
706 $style .= qq{;padding-right:${padright}em} if $padright;
707 $style .= qq{;clear:${clear}} if $clear;
708 $class =~ s/^ // if $class;
709 $pre .= qq{ class="$class"} if $class;
710 $pre .= qq{ id="$id"} if $id;
711 $style =~ s/^;// if $style;
712 $pre .= qq{ style="$style"} if $style;
713 $pre .= qq{ lang="$lang"} if $lang;
714 $pre .= qq{ cite="} . $self->format_url(url => $cite) . '"' if defined $cite && $block eq 'bq'; #'
715 $pre .= '>';
716 $clear = undef;
717 }
718
719 $buffer = $self->format_paragraph(text => $para);
720
721 if ($block eq 'bq') {
722 $post .= '</p>' if $buffer !~ m/<p[ >]/;
723 if ($sticky == 0) {
724 $post .= '</blockquote>';
725 }
726 } else {
727 $post .= '</' . $block . '>';
728 }
729
730 if ($buffer =~ m/$blocktags/) {
731 $buffer =~ s/^\n\n//s;
732 $out .= $buffer;
733 } else {
734 $buffer = $self->format_block(text => "|$filter|".$buffer, inline => 1) if defined $filter;
735 $out .= $pre . $buffer . $post;
736 }
737 }
738
739 if ($sticky) {
740 if ($block eq 'bc') {
741 # close our blockcode section
742 $out .= $self->{_blockcode_close}; # . "\n\n";
743 } elsif ($block eq 'bq') {
744 $out .= '</blockquote>'; # . "\n\n";
745 } elsif (($block eq 'table') && ($stickybuff)) {
746 my $table_out = $self->format_table(text => $stickybuff);
747 $out .= $table_out if defined $table_out;
748 } elsif (($block eq 'dl') && ($stickybuff)) {
749 my $dl_out = $self->format_deflist(text => $stickybuff);
750 $out .= $dl_out if defined $dl_out;
751 }
752 }
753
754 # cleanup-- restore preserved blocks
755 my $i = scalar(@repl);
756 $out =~ s!(?:<|&lt;)textile#$i(?:>|&gt;)!$_!, $i-- while $_ = pop @repl;
757
758 # scan for br, hr tags that are not closed and close them
759 # only for xhtml! just the common ones -- don't fret over input
760 # and the like.
761 if ($self->{flavor} =~ m/^xhtml/i) {
762 $out =~ s/(<(?:img|br|hr)[^>]*?(?<!\/))>/$1 \/>/g;
763 }
764
765 $out;
766 }
767
768 sub format_paragraph {
769 my $self = shift;
770 my (%args) = @_;
771 my $buffer = exists $args{text} ? $args{text} : '';
772
773 my @repl;
774 $buffer =~ s{(?:^|(?<=[\s>])|([{[]))
775 ==(.+?)==
776 (?:$|([\]}])|(?=$punct{1,2}|\s))}
777 {_repl(\@repl, $self->format_block(text => $2, inline => 1, pre => $1, post => $3))}gesx;
778
779 my $tokens;
780 if ($buffer =~ m/</ && (!$self->{disable_html})) { # optimization -- no point in tokenizing if we
781 # have no tags to tokenize
782 $tokens = _tokenize($buffer);
783 } else {
784 $tokens = [['text', $buffer]];
785 }
786 my $result = '';
787 foreach my $token (@$tokens) {
788 my $text = $token->[1];
789 if ($token->[0] eq 'tag') {
790 $text =~ s/&(?!amp;)/&amp;/g;
791 $result .= $text;
792 } else {
793 $text = $self->format_inline(text => $text);
794 $result .= $text;
795 }
796 }
797
798 # now, add line breaks for lines that contain plaintext
799 my @lines = split /\n/, $result;
800 $result = '';
801 my $needs_closing = 0;
802 foreach my $line (@lines) {
803 if (($line !~ m/($blocktags)/)
804 && (($line =~ m/^[^<]/ || $line =~ m/>[^<]/)
805 || ($line !~ m/<img /))) {
806 if ($self->{_line_open}) {
807 $result .= "\n" if $result ne '';
808 $result .= $self->{_line_open} . $line . $self->{_line_close};
809 } else {
810 if ($needs_closing) {
811 $result .= $self->{_line_close} ."\n";
812 } else {
813 $needs_closing = 1;
814 $result .= "\n" if $result ne '';
815 }
816 $result .= $line;
817 }
818 } else {
819 if ($needs_closing) {
820 $result .= $self->{_line_close} ."\n";
821 } else {
822 $result .= "\n" if $result ne '';
823 }
824 $result .= $line;
825 $needs_closing = 0;
826 }
827 }
828
829 # at this point, we will restore the \001's to \n's (reversing
830 # the step taken in _tokenize).
831 #$result =~ s/\r/\n/g;
832 $result =~ s/\001/\n/g;
833
834 my $i = scalar(@repl);
835 $result =~ s|<textile#$i>|$_|, $i-- while $_ = pop @repl;
836
837 # quotalize
838 if ($self->{do_quotes}) {
839 $result = $self->process_quotes($result);
840 }
841
842 $result;
843 }
844
845 {
846 my @qtags = (['**', 'b', '(?<!\*)\*\*(?!\*)', '\*'],
847 ['__', 'i', '(?<!_)__(?!_)', '_'],
848 ['??', 'cite', '\?\?(?!\?)', '\?'],
849 ['*', 'strong', '(?<!\*)\*(?!\*)', '\*'],
850 ['_', 'em', '(?<!_)_(?!_)', '_'],
851 ['-', 'del', '(?<!\-)\-(?!\-)', '-'],
852 ['+', 'ins', '(?<!\+)\+(?!\+)', '\+'],
853 ['++', 'big', '(?<!\+)\+\+(?!\+)', '\+\+'],
854 ['--', 'small', '(?<!\-)\-\-(?!\-)', '\-\-'],
855 ['~', 'sub', '(?<!\~)\~(?![\\\/~])', '\~']);
856
857
858 sub format_inline {
859 my $self = shift;
860 my (%args) = @_;
861 my $text = exists $args{text} ? $args{text} : '';
862
863 my @repl;
864
865 $text =~ s!$codere!_repl(\@repl, $self->format_code(text => $2.$4, lang => $1.$3))!gem;
866
867 # images must be processed before encoding the text since they might
868 # have the <, > alignment specifiers...
869
870 # !blah (alt)! -> image
871 $text =~ s!(?:^|(?<=[\s>])|([{[])) # $1: open brace/bracket
872 \! # opening
873 ($imgalignre?) # $2: optional alignment
874 ($clstypadre*) # $3: optional CSS class/id
875 ($imgalignre?) # $4: optional alignment
876 (?:\s*) # space between alignment/css stuff
877 ([^\s\(\!]+) # $5: filename
878 (\s*[^\(\!]*(?:\([^\)]+\))?[^\!]*) # $6: extras (alt text)
879 \! # closing
880 (?::(\d+|$urlre))? # $7: optional URL
881 (?:$|([\]}])|(?=$punct{1,2}|\s))# $8: closing brace/bracket
882 !_repl(\@repl, $self->format_image(pre => $1, src => $5, align => $2||$4, extra => $6, url => $7, clsty => $3, post => $8))!gemx;
883
884 $text =~ s!(?:^|(?<=[\s>])|([{[])) # $1: open brace/bracket
885 \% # opening
886 ($halignre?) # $2: optional alignment
887 ($clstyre*) # $3: optional CSS class/id
888 ($halignre?) # $4: optional alignment
889 (?:\s*) # spacing
890 ([^\%]+?) # $5: text
891 \% # closing
892 (?::(\d+|$urlre))? # $6: optional URL
893 (?:$|([\]}])|(?=$punct{1,2}|\s))# $7: closing brace/bracket
894 !_repl(\@repl, $self->format_span(pre => $1,text => $5,align => $2||$4, cite => $6, clsty => $3, post => $7))!gemx;
895
896 $text = $self->encode_html($text);
897 $text =~ s!&lt;textile#(\d+)&gt;!<textile#$1>!g;
898 $text =~ s!&amp;quot;!&#34;!g;
899 $text =~ s!&amp;(([a-z]+|#\d+);)!&$1!g;
900 $text =~ s!&quot;!"!g; #"
901
902 # These create markup with entities. Do first and 'save' result for later:
903 # "text":url -> hyperlink
904 # links with brackets surrounding
905 my $parenre = qr/\( (?: [^()] )* \)/x;
906 $text =~ s!(
907 [{[]
908 (?:
909 (?:" # quote character
910 ($clstyre*)? # $2: optional CSS class/id
911 ([^"]+?) # $3: link text
912 (?:\( ( (?:[^()]|$parenre)*) \))? # $4: optional link title
913 " # closing quote
914 )
915 |
916 (?:' # open single quote
917 ($clstyre*)? # $5: optional CSS class/id
918 ([^']+?) # $6: link text
919 (?:\( ( (?:[^()]|$parenre)*) \))? # $7: optional link title
920 ' # closing quote
921 )
922 )
923 :(.+?) # $8: URL suffix
924 [\]}]
925 )
926 !_repl(\@repl, $self->format_link(text => $1,linktext => $3.$6, title => $self->encode_html_basic($4.$7), url => $8, clsty => $2.$5))!gemx;
927
928 $text =~ s!((?:^|(?<=[\s>\(])) # $1: open brace/bracket
929 (?: (?:" # quote character "
930 ($clstyre*)? # $2: optional CSS class/id
931 ([^"]+?) # $3: link text "
932 (?:\( ( (?:[^()]|$parenre)*) \))? # $4: optional link title
933 " # closing quote # "
934 )
935 |
936 (?:' # open single quote '
937 ($clstyre*)? # $5: optional CSS class/id
938 ([^']+?) # $6: link text '
939 (?:\( ( (?:[^()]|$parenre)*) \))? # $7: optional link title
940 ' # closing quote '
941 )
942 )
943 :(\d+|$urlre) # $8: URL suffix
944 (?:$|(?=$punct{1,2}|\s))) # $9: closing brace/bracket
945 !_repl(\@repl, $self->format_link(text => $1, linktext => $3.$6, title => $self->encode_html_basic($4.$7), url => $8, clsty => $2.$5))!gemx;
946
947 if ($self->{flavor} =~ m/^xhtml2/) {
948 # citation with cite link
949 $text =~ s!(?:^|(?<=[\s>'"\(])|([{[])) # $1: open brace/bracket '
950 \?\? # opening '??'
951 ([^\?]+?) # $2: characters (can't contain '?')
952 \?\? # closing '??'
953 :(\d+|$urlre) # $3: optional citation URL
954 (?:$|([\]}])|(?=$punct{1,2}|\s))# $4: closing brace/bracket
955 !_repl(\@repl, $self->format_cite(pre => $1,text => $2,cite => $3,post => $4))!gemx;
956 }
957
958 # footnotes
959 if ($text =~ m/[^ ]\[\d+\]/) {
960 my $fntag = '<sup';
961 $fntag .= ' class="'.$self->{css}{class_footnote}.'"' if $self->{css}{class_footnote};
962 $fntag .= '><a href="#'.($self->{css}{id_footnote_prefix}||'fn');
963 $text =~ s|([^ ])\[(\d+)\]|$1$fntag$2">$2</a></sup>|g;
964 }
965
966 # translate macros:
967 $text =~ s{(\{)(.+?)(\})}
968 {$self->format_macro(pre => $1, post => $3, macro => $2)}gex;
969
970 # these were present with textile 1 and are common enough
971 # to not require macro braces...
972 # (tm) -> &trade;
973 $text =~ s|[\(\[]TM[\)\]]|&#8482;|gi;
974 # (c) -> &copy;
975 $text =~ s|[\(\[]C[\)\]]|&#169;|gi;
976 # (r) -> &reg;
977 $text =~ s|[\(\[]R[\)\]]|&#174;|gi;
978
979 if ($self->{preserve_spaces}) {
980 # replace two spaces with an em space
981 $text =~ s/(?<!\s)\ \ (?!=\s)/&#8195;/g;
982 }
983
984 my $redo = $text =~ m/[\*_\?\-\+\^\~]/;
985 my $last = $text;
986 while ($redo) {
987 # simple replacements...
988 $redo = 0;
989 foreach my $tag (@qtags) {
990 my ($f, $r, $qf, $cls) = @$tag;
991 if ($text =~ s/(?:^|(?<=[\s>'"])|([{[])) # "' $1 - pre
992 $qf #
993 (?:($clstyre*))? # $2 - attributes
994 ([^$cls\s].*?) # $3 - content
995 (?<=\S)$qf #
996 (?:$|([\]}])|(?=$punct{1,2}|\s)) # $4 - post
997 /$self->format_tag(tag => $r, marker => $f, pre => $1, text => $3, clsty => $2, post => $4)/gemx) {
998 $redo ||= $last ne $text;
999 $last = $text;
1000 }
1001 }
1002 }
1003
1004 # superscript is an even simpler replacement...
1005 $text =~ s/(?<!\^)\^(?!\^)(.+?)(?<!\^)\^(?!\^)/<sup>$1<\/sup>/g;
1006
1007 # ABC(Aye Bee Cee) -> acronym
1008 $text =~ s{\b([A-Z][A-Za-z0-9]*?[A-Z0-9]+?)\b(?:[(]([^)]*)[)])}
1009 {_repl(\@repl,qq{<acronym title="}.$self->encode_html_basic($2).qq{">$1</acronym>})}ge;
1010
1011 # ABC -> 'capped' span
1012 if (my $caps = $self->{css}{class_caps}) {
1013 $text =~ s/(^|[^"][>\s]) # "
1014 ((?:[A-Z](?:[A-Z0-9\.,']|\&amp;){2,}\ *)+?) # '
1015 (?=[^A-Z\.0-9]|$)
1016 /$1._repl(\@repl, qq{<span class="$caps">$2<\/span>})/gemx;
1017 }
1018
1019 # nxn -> n&times;n
1020 $text =~ s!((?:[0-9\.]0|[1-9]|\d['"])\ ?)x(\ ?\d)!$1&#215;$2!g;
1021
1022 # translate these entities to the Unicode equivalents:
1023 $text =~ s/&#133;/&#8230;/g;
1024 $text =~ s/&#145;/&#8216;/g;
1025 $text =~ s/&#146;/&#8217;/g;
1026 $text =~ s/&#147;/&#8220;/g;
1027 $text =~ s/&#148;/&#8221;/g;
1028 $text =~ s/&#150;/&#8211;/g;
1029 $text =~ s/&#151;/&#8212;/g;
1030
1031 # Restore replacements done earlier:
1032 my $i = scalar(@repl);
1033 $text =~ s|<textile#$i>|$_|, $i-- while $_ = pop @repl;
1034
1035 # translate entities to characters for highbit stuff since
1036 # we're using utf8
1037 # removed for backward compatability with older versions of Perl
1038 #if ($self->{charset} =~ m/^utf-?8$/i) {
1039 # # translate any unicode entities to native UTF-8
1040 # $text =~ s/\&\#(\d+);/($1 > 127) ? pack('U',$1) : chr($1)/ge;
1041 #}
1042
1043 $text;
1044 }
1045 }
1046
1047 {
1048 # pull in charnames, but only for Perl 5.8 or later (and
1049 # disable strict subs for backward compatability
1050 my $Have_Charnames = 0;
1051 if ($] >= 5.008) {
1052 eval 'use charnames qw(:full);';
1053 $Have_Charnames = 1;
1054 }
1055
1056 sub format_macro {
1057 my $self = shift;
1058 my %attrs = @_;
1059 my $macro = $attrs{macro};
1060 if (defined $self->{macros}->{$macro}) {
1061 return $self->{macros}->{$macro};
1062 }
1063
1064 # handle full unicode name translation
1065 if ($Have_Charnames) {
1066 # charnames::vianame is only available in Perl 5.8.0 and later...
1067 if (defined (my $unicode = charnames::vianame(uc($macro)))) {
1068 return '&#'.$unicode.';';
1069 }
1070 }
1071
1072 return $attrs{pre}.$macro.$attrs{post};
1073 }
1074 }
1075
1076 sub format_cite {
1077 my $self = shift;
1078 my (%args) = @_;
1079 my $pre = exists $args{pre} ? $args{pre} : '';
1080 my $text = exists $args{text} ? $args{text} : '';
1081 my $cite = $args{cite};
1082 my $post = exists $args{post} ? $args{post} : '';
1083 _strip_borders(\$pre, \$post);
1084 my $tag = $pre.'<cite';
1085 if (($self->{flavor} =~ m/^xhtml2/) && defined $cite && $cite) {
1086 $cite = $self->format_url(url => $cite);
1087 $tag .= qq{ cite="$cite"};
1088 } else {
1089 $post .= ':';
1090 }
1091 $tag .= '>';
1092 $tag . $self->format_inline(text => $text) . '</cite>'.$post;
1093 }
1094
1095 sub format_code {
1096 my $self = shift;
1097 my (%args) = @_;
1098 my $code = exists $args{text} ? $args{text} : '';
1099 my $lang = $args{lang};
1100 $code = $self->encode_html($code, 1);
1101 $code =~ s/&lt;textile#(\d+)&gt;/<textile#$1>/g;
1102 my $tag = '<code';
1103 $tag .= " language=\"$lang\"" if $lang;
1104 $tag . '>' . $code . '</code>';
1105 }
1106
1107 sub format_classstyle {
1108 my $self = shift;
1109 my ($clsty, $class, $style) = @_;
1110
1111 $class =~ s/^ //;
1112
1113 my ($lang, $padleft, $padright, $id);
1114 if ($clsty && ($clsty =~ m/{([^}]+)}/)) {
1115 my $_style = $1;
1116 $_style =~ s/\n/ /g;
1117 $style .= ';'.$_style;
1118 $clsty =~ s/{[^}]+}//g;
1119 }
1120 if ($clsty && ($clsty =~ m/\(([A-Za-z0-9_\- ]+?)(?:#(.+?))?\)/ ||
1121 $clsty =~ m/\(([A-Za-z0-9_\- ]+?)?(?:#(.+?))\)/)) {
1122 if ($1 || $2) {
1123 if ($class) {
1124 $class = $1 . ' ' . $class;
1125 } else {
1126 $class = $1;
1127 }
1128 $id = $2;
1129 if ($class) {
1130 $clsty =~ s/\([A-Za-z0-9_\- ]+?(#.*?)?\)//g;
1131 }
1132 if ($id) {
1133 $clsty =~ s/\(#.+?\)//g;
1134 }
1135 }
1136 }
1137 if ($clsty && ($clsty =~ m/(\(+)/)) {
1138 $padleft = length($1);
1139 $clsty =~ s/\(+//;
1140 }
1141 if ($clsty && ($clsty =~ m/(\)+)/)) {
1142 $padright = length($1);
1143 $clsty =~ s/\)+//;
1144 }
1145 if ($clsty && ($clsty =~ m/\[(.+?)\]/)) {
1146 $lang = $1;
1147 $clsty =~ s/\[.+?\]//g;
1148 }
1149 my $attrs = '';
1150 $style .= qq{;padding-left:${padleft}em} if $padleft;
1151 $style .= qq{;padding-right:${padright}em} if $padright;
1152 $style =~ s/^;//;
1153 $class =~ s/^ //;
1154 $class =~ s/ $//;
1155 $attrs .= qq{ class="$class"} if $class;
1156 $attrs .= qq{ id="$id"} if $id;
1157 $attrs .= qq{ style="$style"} if $style;
1158 $attrs .= qq{ lang="$lang"} if $lang;
1159 $attrs =~ s/^ //;
1160 $attrs;
1161 }
1162
1163 sub format_tag {
1164 my $self = shift;
1165 my (%args) = @_;
1166 my $tagname = $args{tag};
1167 my $text = exists $args{text} ? $args{text} : '';
1168 my $pre = exists $args{pre} ? $args{pre} : '';
1169 my $post = exists $args{post} ? $args{post} : '';
1170 my $clsty = exists $args{clsty} ? $args{clsty} : '';
1171 _strip_borders(\$pre, \$post);
1172 my $tag = "<$tagname";
1173 my $attr = $self->format_classstyle($clsty);
1174 $tag .= qq{ $attr} if $attr;
1175 $tag .= qq{>$text</$tagname>};
1176 $pre.$tag.$post;
1177 }
1178
1179 sub format_deflist {
1180 my $self = shift;
1181 my (%args) = @_;
1182 my $str = exists $args{text} ? $args{text} : '';
1183 my $clsty;
1184 my @lines = split /\n/, $str;
1185 if ($lines[0] =~ m/^(dl($clstyre*?)\.\.?(?:\ +|$))/) {
1186 $clsty = $2;
1187 $lines[0] = substr($lines[0], length($1));
1188 }
1189
1190 sub add_term {
1191 my ($self, $dt, $dd) = @_;
1192 my ($dtattr, $ddattr);
1193 my $dtlang;
1194 if ($dt =~ m/^($clstyre*)/) {
1195 my $param = $1;
1196 $dtattr = $self->format_classstyle($param);
1197 if ($param =~ m/\[([A-Za-z]+?)\]/) {
1198 $dtlang = $1;
1199 }
1200 $dt = substr($dt, length($param));
1201 }
1202 if ($dd =~ m/^($clstyre*)/) {
1203 my $param = $1;
1204 # if the language was specified for the term,
1205 # then apply it to the definition as well (unless
1206 # already specified of course)
1207 if ($dtlang && ($param =~ m/\[([A-Za-z]+?)\]/)) {
1208 undef $dtlang;
1209 }
1210 $ddattr = $self->format_classstyle(($dtlang ? "[$dtlang]" : '') . $param);
1211 $dd = substr($dd, length($param));
1212 }
1213 my $out = '<dt';
1214 $out .= qq{ $dtattr} if $dtattr;
1215 $out .= '>' . $self->format_inline(text => $dt) . '</dt>' . "\n";
1216 if ($dd =~ m/\n\n/) {
1217 $dd = $self->textile($dd) if $dd =~ m/\n\n/;
1218 } else {
1219 $dd = $self->format_paragraph(text => $dd);
1220 }
1221 $out .= '<dd';
1222 $out .= qq{ $ddattr} if $ddattr;
1223 $out .= '>' . $dd . '</dd>' . "\n";
1224 }
1225
1226 my ($dt, $dd);
1227 my $out = '';
1228 foreach my $line (@lines) {
1229 if ($line =~ m/^((?:$clstyre*)(?:[^\ ].*?)(?<!["'\ ])):([^\ \/].*)$/) {
1230 $out .= add_term($self, $dt, $dd) if ($dt && $dd);
1231 $dt = $1;
1232 $dd = $2;
1233 } else {
1234 $dd .= "\n" . $line;
1235 }
1236 }
1237 $out .= add_term($self, $dt, $dd) if $dt && $dd;
1238
1239 my $tag = '<dl';
1240 my $attr = $self->format_classstyle($clsty) if $clsty;
1241 $tag .= qq{ $attr} if $attr;
1242 $tag .= '>'."\n";
1243
1244 $tag.$out."</dl>\n";
1245 }
1246
1247 sub format_list {
1248 my $self = shift;
1249 my (%args) = @_;
1250 my $str = exists $args{text} ? $args{text} : '';
1251
1252 my %list_tags = ('*' => 'ul', '#' => 'ol');
1253
1254 my @lines = split /\n/, $str;
1255
1256 my @stack;
1257 my $last_depth = 0;
1258 my $item = '';
1259 my $out = '';
1260 foreach my $line (@lines) {
1261 if ($line =~ m/^((?:$clstypadre*|$halignre)*)
1262 ([\#\*]+)
1263 ((?:$halignre|$clstypadre*)*)
1264 \ (.+)$/x) {
1265 if ($item ne '') {
1266 if ($item =~ m/\n/) {
1267 if ($self->{_line_open}) {
1268 $item =~ s/(<li[^>]*>|^)/$1$self->{_line_open}/gm;
1269 $item =~ s/(\n|$)/$self->{_line_close}$1/gs;
1270 } else {
1271 $item =~ s/(\n)/$self->{_line_close}$1/gs;
1272 }
1273 }
1274 $out .= $item;
1275 $item = '';
1276 }
1277 my $type = substr($2, 0, 1);
1278 my $depth = length($2);
1279 my $blockparam = $1;
1280 my $itemparam = $3;
1281 $line = $4;
1282 my ($blockclsty, $blockalign, $blockattr, $itemattr, $itemclsty,
1283 $itemalign);
1284 if ($blockparam =~ m/($clstypadre+)/) {
1285 $blockclsty = $1;
1286 }
1287 if ($blockparam =~ m/($halignre+)/) {
1288 $blockalign = $1;
1289 }
1290 if ($itemparam =~ m/($clstypadre+)/) {
1291 $itemclsty = $1;
1292 }
1293 if ($itemparam =~ m/($halignre+)/) {
1294 $itemalign = $1;
1295 }
1296 $itemattr = $self->format_classstyle($itemclsty) if $itemclsty;
1297 if ($depth > $last_depth) {
1298 for (my $j = $last_depth; $j < $depth; $j++) {
1299 $out .= qq{<$list_tags{$type}};
1300 push @stack, $type;
1301 if ($blockclsty) {
1302 $blockattr = $self->format_classstyle($blockclsty);
1303 $out .= ' '.$blockattr if $blockattr;
1304 }
1305 $out .= ">\n<li";
1306 $out .= qq{ $itemattr} if $itemattr;
1307 $out .= ">";
1308 }
1309 } elsif ($depth < $last_depth) {
1310 for (my $j = $depth; $j < $last_depth; $j++) {
1311 $out .= "</li>\n" if $j == $depth;
1312 my $type = pop @stack;
1313 $out .= qq{</$list_tags{$type}>\n</li>\n};
1314 }
1315 if ($depth) {
1316 $out .= '<li';
1317 $out .= qq{ $itemattr} if $itemattr;
1318 $out .= '>';
1319 }
1320 } else {
1321 $out .= "</li>\n<li";
1322 $out .= qq{ $itemattr} if $itemattr;
1323 $out .= '>';
1324 }
1325 $last_depth = $depth;
1326 }
1327 $item .= "\n" if $item ne '';
1328 $item .= $self->format_paragraph(text => $line);
1329 }
1330
1331 if ($item =~ m/\n/) {
1332 if ($self->{_line_open}) {
1333 $item =~ s/(<li[^>]*>|^)/$1$self->{_line_open}/gm;
1334 $item =~ s/(\n|$)/$self->{_line_close}$1/gs;
1335 } else {
1336 $item =~ s/(\n)/$self->{_line_close}$1/gs;
1337 }
1338 }
1339 $out .= $item;
1340
1341 for (my $j = 1; $j <= $last_depth; $j++) {
1342 $out .= '</li>' if $j == 1;
1343 my $type = pop @stack;
1344 $out .= "\n".'</'.$list_tags{$type}.'>';
1345 $out .= '</li>' if $j != $last_depth;
1346 }
1347
1348 $out;
1349 }
1350
1351 sub format_block {
1352 my $self = shift;
1353 my (%args) = @_;
1354 my $str = exists $args{text} ? $args{text} : '';
1355 my $inline = $args{inline};
1356 my $pre = exists $args{pre} ? $args{pre} : '';
1357 my $post = exists $args{post} ? $args{post} : '';
1358 _strip_borders(\$pre, \$post);
1359 my ($filters) = $str =~ m/^(\|(?:(?:[a-z0-9_\-]+)\|)+)/;
1360 if ($filters) {
1361 my $filtreg = quotemeta($filters);
1362 $str =~ s/^$filtreg//;
1363 $filters =~ s/^\|//;
1364 $filters =~ s/\|$//;
1365 my @filters = split /\|/, $filters;
1366 $str = $self->apply_filters(text => $str, filters => \@filters);
1367 my $count = scalar(@filters);
1368 if ($str =~ s!(<p>){$count}!$1!gs) {
1369 $str =~ s!(</p>){$count}!$1!gs;
1370 $str =~ s!(<br( /)?>){$count}!$1!gs;
1371 }
1372 }
1373 if ($inline) {
1374 # strip off opening para, closing para, since we're
1375 # operating within an inline block
1376 $str =~ s/^\s*<p[^>]*>//;
1377 $str =~ s/<\/p>\s*$//;
1378 }
1379 $pre.$str.$post;
1380 }
1381
1382 sub format_link {
1383 my $self = shift;
1384 my (%args) = @_;
1385 my $text = exists $args{text} ? $args{text} : '';
1386 my $linktext = exists $args{linktext} ? $args{linktext} : '';
1387 my $title = $args{title};
1388 my $url = $args{url};
1389 my $clsty = $args{clsty};
1390
1391 if (!defined $url || $url eq '') {
1392 return $text;
1393 }
1394 if (exists $self->{links} && exists $self->{links}{$url}) {
1395 $title ||= $self->{links}{$url}{title};
1396 $url = $self->{links}{$url}{url};
1397 }
1398 $linktext =~ s/ +$//;
1399 $linktext = $self->format_paragraph(text => $linktext);
1400 $url = $self->format_url(linktext => $linktext, url => $url);
1401 my $tag = qq{<a href="$url"};
1402 my $attr = $self->format_classstyle($clsty);
1403 $tag .= qq{ $attr} if $attr;
1404 if (defined $title) {
1405 $title =~ s/^\s+//;
1406 $tag .= qq{ title="$title"} if length($title);
1407 }
1408 $tag .= qq{>$linktext</a>};
1409 $tag;
1410 }
1411
1412 sub format_url {
1413 my $self = shift;
1414 my (%args) = @_;
1415 my $url = defined $args{url} ? $args{url} : '';
1416 if ($url =~ m/^(mailto:)?([-\+\w]+\@[-\w]+(\.\w[-\w]*)+)$/) {
1417 $url = 'mailto:'.$self->mail_encode($2);
1418 }
1419 if ($url !~ m!^(/|\./|\.\./|#)!) {
1420 $url = "http://$url" if $url !~ m!^(https?|ftp|mailto|nntp|telnet)!;
1421 }
1422 $url =~ s/&(?!amp;)/&amp;/g;
1423 $url =~ s/\ /\+/g;
1424 $url =~ s/^((?:.+?)\?)(.+)$/$1.$self->encode_url($2)/ge;
1425 $url;
1426 }
1427
1428 sub format_span {
1429 my $self = shift;
1430 my (%args) = @_;
1431 my $text = exists $args{text} ? $args{text} : '';
1432 my $pre = exists $args{pre} ? $args{pre} : '';
1433 my $post = exists $args{post} ? $args{post} : '';
1434 my $align = $args{align};
1435 my $cite = exists $args{cite} ? $args{cite} : '';
1436 my $clsty = $args{clsty};
1437 _strip_borders(\$pre, \$post);
1438 my ($class, $style);
1439 my $tag = qq{<span};
1440 $style = '';
1441 if (defined $align) {
1442 if ($self->{css_mode}) {
1443 my $alignment = _halign($align);
1444 $style .= qq{;float:$alignment} if $alignment;
1445 $class .= ' '.$self->{css}{"class_align_$alignment"} if $alignment;
1446 } else {
1447 my $alignment = _halign($align) || _valign($align);
1448 $tag .= qq{ align="$alignment"} if $alignment;
1449 }
1450 }
1451 my $attr = $self->format_classstyle($clsty, $class, $style);
1452 $tag .= qq{ $attr} if $attr;
1453 if (defined $cite) {
1454 $cite =~ s/^://;
1455 $cite = $self->format_url(url => $cite);
1456 $tag .= qq{ cite="$cite"};
1457 }
1458 $pre.$tag.'>'.$self->format_paragraph(text => $text).'</span>'.$post;
1459 }
1460
1461 sub format_image {
1462 my $self = shift;
1463 my (%args) = @_;
1464 my $src = exists $args{src} ? $args{src} : '';
1465 my $extra = $args{extra};
1466 my $align = $args{align};
1467 my $pre = exists $args{pre} ? $args{pre} : '';
1468 my $post = exists $args{post} ? $args{post} : '';
1469 my $link = $args{url};
1470 my $clsty = $args{clsty};
1471 _strip_borders(\$pre, \$post);
1472 return $pre.'!!'.$post if length($src) == 0;
1473 my $tag;
1474 if ($self->{flavor} =~ m/^xhtml2/) {
1475 my $type; # poor man's mime typing. need to extend this externally
1476 if ($src =~ m/(?:\.jpeg|\.jpg)$/i) {
1477 $type = 'image/jpeg';
1478 } elsif ($src =~ m/\.gif$/i) {
1479 $type = 'image/gif';
1480 } elsif ($src =~ m/\.png$/i) {
1481 $type = 'image/png';
1482 } elsif ($src =~ m/\.tiff$/i) {
1483 $type = 'image/tiff';
1484 }
1485 $tag = qq{<object};
1486 $tag .= qq{ type="$type"} if $type;
1487 $tag .= qq{ data="$src"};
1488 } else {
1489 $tag = qq{<img src="$src"};
1490 }
1491 my ($class, $style);
1492 if (defined $align) {
1493 if ($self->{css_mode}) {
1494 my $alignment = _halign($align);
1495 $style .= qq{;float:$alignment} if $alignment;
1496 $class .= ' '.$alignment if $alignment;
1497 $alignment = _valign($align);
1498 if ($alignment) {
1499 my $imgvalign = ($alignment =~ m/(top|bottom)/ ? 'text-' . $alignment : $alignment);
1500 $style .= qq{;vertical-align:$imgvalign} if $imgvalign;
1501 $class .= ' '.$self->{css}{"class_align_$alignment"} if $alignment;
1502 }
1503 } else {
1504 my $alignment = _halign($align) || _valign($align);
1505 $tag .= qq{ align="$alignment"} if $alignment;
1506 }
1507 }
1508 my ($pctw, $pcth, $w, $h, $alt);
1509 if (defined $extra) {
1510 ($alt) = $extra =~ m/\(([^\)]+)\)/;
1511 $extra =~ s/\([^\)]+\)//;
1512 my ($pct) = ($extra =~ m/(^|\s)(\d+)%(\s|$)/)[1];
1513 if (!$pct) {
1514 ($pctw, $pcth) = ($extra =~ m/(^|\s)(\d+)%x(\d+)%(\s|$)/)[1,2];
1515 } else {
1516 $pctw = $pcth = $pct;
1517 }
1518 if (!$pctw && !$pcth) {
1519 ($w,$h) = ($extra =~ m/(^|\s)(\d+|\*)x(\d+|\*)(\s|$)/)[1,2];
1520 $w = '' if $w eq '*';
1521 $h = '' if $h eq '*';
1522 if (!$w) {
1523 ($w) = ($extra =~ m/(^|[,\s])(\d+)w([\s,]|$)/)[1];
1524 }
1525 if (!$h) {
1526 ($h) = ($extra =~ m/(^|[,\s])(\d+)h([\s,]|$)/)[1];
1527 }
1528 }
1529 }
1530 $alt = '' unless defined $alt;
1531 if ($self->{flavor} !~ m/^xhtml2/) {
1532 $tag .= ' alt="' . $self->encode_html_basic($alt) . '"';
1533 }
1534 if ($w && $h) {
1535 if ($self->{flavor} !~ m/^xhtml2/) {
1536 $tag .= qq{ height="$h" width="$w"};
1537 } else {
1538 $style .= qq{;height:$h}.qq{px;width:$w}.q{px};
1539 }
1540 } else {
1541 my ($image_w, $image_h) = $self->image_size($src);
1542 if (($image_w && $image_h) && ($w || $h)) {
1543 # image size determined, but only width or height specified
1544 if ($w && !$h) {
1545 # width defined, scale down height proportionately
1546 $h = int($image_h * ($w / $image_w));
1547 } elsif ($h && !$w) {
1548 $w = int($image_w * ($h / $image_h));
1549 }
1550 } else {
1551 $w = $image_w;
1552 $h = $image_h;
1553 }
1554 if ($w && $h) {
1555 if ($pctw || $pcth) {
1556 $w = int($w * $pctw / 100);
1557 $h = int($h * $pcth / 100);
1558 }
1559 if ($self->{flavor} !~ m/^xhtml2/) {
1560 $tag .= qq{ height="$h" width="$w"};
1561 } else {
1562 $style .= qq{;height:$h}.qq{px;width:$w}.q{px};
1563 }
1564 }
1565 }
1566 my $attr = $self->format_classstyle($clsty, $class, $style);
1567 $tag .= qq{ $attr} if $attr;
1568 if ($self->{flavor} =~ m/^xhtml2/) {
1569 $tag .= '><p>' . $self->encode_html_basic($alt) . '</p></object>';
1570 } elsif ($self->{flavor} =~ m/^xhtml/) {
1571 $tag .= ' />';
1572 } else {
1573 $tag .= '>';
1574 }
1575 if (defined $link) {
1576 $link =~ s/^://;
1577 $link = $self->format_url(url => $link);
1578 $tag = '<a href="'.$link.'">'.$tag.'</a>';
1579 }
1580 $pre.$tag.$post;
1581 }
1582
1583 sub format_table {
1584 my $self = shift;
1585 my (%args) = @_;
1586 my $str = exists $args{text} ? $args{text} : '';
1587
1588 my @lines = split /\n/, $str;
1589 my @rows;
1590 my $line_count = scalar(@lines);
1591 for (my $i = 0; $i < $line_count; $i++) {
1592 if ($lines[$i] !~ m/\|\s*$/) {
1593 if ($i + 1 < $line_count) {
1594 $lines[$i+1] = $lines[$i] . "\n" . $lines[$i+1] if $i+1 <= $#lines;
1595 } else {
1596 push @rows, $lines[$i];
1597 }
1598 } else {
1599 push @rows, $lines[$i];
1600 }
1601 }
1602 my ($tid, $tpadl, $tpadr, $tlang);
1603 my $tclass = '';
1604 my $tstyle = '';
1605 my $talign = '';
1606 if ($rows[0] =~ m/^table[^\.]/) {
1607 my $row = $rows[0];
1608 $row =~ s/^table//;
1609 my $params = 1;
1610 # process row parameters until none are left
1611 while ($params) {
1612 if ($row =~ m/^($tblalignre)/) {
1613 # found row alignment
1614 $talign .= $1;
1615 $row = substr($row, length($1)) if $1;
1616 redo if $1;
1617 }
1618 if ($row =~ m/^($clstypadre)/) {
1619 # found a class/id/style/padding indicator
1620 my $clsty = $1;
1621 $row = substr($row, length($clsty)) if $clsty;
1622 if ($clsty =~ m/{([^}]+)}/) {
1623 $tstyle = $1;
1624 $clsty =~ s/{([^}]+)}//;
1625 redo if $tstyle;
1626 }
1627 if ($clsty =~ m/\(([A-Za-z0-9_\- ]+?)(?:#(.+?))?\)/ ||
1628 $clsty =~ m/\(([A-Za-z0-9_\- ]+?)?(?:#(.+?))\)/) {
1629 if ($1 || $2) {
1630 $tclass = $1;
1631 $tid = $2;
1632 redo;
1633 }
1634 }
1635 $tpadl = length($1) if $clsty =~ m/(\(+)/;
1636 $tpadr = length($1) if $clsty =~ m/(\)+)/;
1637 $tlang = $1 if $clsty =~ m/\[(.+?)\]/;
1638 redo if $clsty;
1639 }
1640 $params = 0;
1641 }
1642 $row =~ s/\.\s+//;
1643 $rows[0] = $row;
1644 }
1645 my $out = '';
1646 my @cols = split /\|/, $rows[0].' ';
1647 my (@colalign, @rowspans);
1648 foreach my $row (@rows) {
1649 my @cols = split /\|/, $row.' ';
1650 my $colcount = $#cols;
1651 pop @cols;
1652 my $colspan = 0;
1653 my $row_out = '';
1654 my ($rowclass, $rowid, $rowalign, $rowstyle, $rowheader);
1655 $cols[0] = '' if !defined $cols[0];
1656 if ($cols[0] =~ m/_/) {
1657 $cols[0] =~ s/_//g;
1658 $rowheader = 1;
1659 }
1660 if ($cols[0] =~ m/{([^}]+)}/) {
1661 $rowstyle = $1;
1662 $cols[0] =~ s/{[^}]+}//g;
1663 }
1664 if ($cols[0] =~ m/\(([^\#]+?)?(#(.+))?\)/) {
1665 $rowclass = $1;
1666 $rowid = $3;
1667 $cols[0] =~ s/\([^\)]+\)//g;
1668 }
1669 $rowalign = $1 if $cols[0] =~ m/($alignre)/;
1670 for (my $c = $colcount - 1; $c > 0; $c--) {
1671 if ($rowspans[$c]) {
1672 $rowspans[$c]--;
1673 next if $rowspans[$c] > 1;
1674 }
1675 my ($colclass, $colid, $header, $colparams, $colpadl, $colpadr, $collang);
1676 my $colstyle = '';
1677 my $colalign = $colalign[$c];
1678 my $col = pop @cols;
1679 $col ||= '';
1680 my $attrs = '';
1681 if ($col =~ m/^(((_|[\/\\]\d+|$alignre|$clstypadre)+)\. )/) {
1682 my $colparams = $2;
1683 $col = substr($col, length($1));
1684 my $params = 1;
1685 # keep processing column parameters until there
1686 # are none left...
1687 while ($params) {
1688 if ($colparams =~ m/^(_|$alignre)/g) {
1689 # found alignment or heading indicator
1690 $attrs .= $1;
1691 $colparams = substr($colparams, pos($colparams)) if $1;
1692 redo if $1;
1693 }
1694 if ($colparams =~ m/^($clstypadre)/g) {
1695 # found a class/id/style/padding marker
1696 my $clsty = $1;
1697 $colparams = substr($colparams, pos($colparams)) if $clsty;
1698 if ($clsty =~ m/{([^}]+)}/) {
1699 $colstyle = $1;
1700 $clsty =~ s/{([^}]+)}//;
1701 }
1702 if ($clsty =~ m/\(([A-Za-z0-9_\- ]+?)(?:#(.+?))?\)/ ||
1703 $clsty =~ m/\(([A-Za-z0-9_\- ]+?)?(?:#(.+?))\)/) {
1704 if ($1 || $2) {
1705 $colclass = $1;
1706 $colid = $2;
1707 if ($colclass) {
1708 $clsty =~ s/\([A-Za-z0-9_\- ]+?(#.*?)?\)//g;
1709 } elsif ($colid) {
1710 $clsty =~ s/\(#.+?\)//g;
1711 }
1712 }
1713 }
1714 if ($clsty =~ m/(\(+)/) {
1715 $colpadl = length($1);
1716 $clsty =~ s/\(+//;
1717 }
1718 if ($clsty =~ m/(\)+)/) {
1719 $colpadr = length($1);
1720 $clsty =~ s/\)+//;
1721 }
1722 if ($clsty =~ m/\[(.+?)\]/) {
1723 $collang = $1;
1724 $clsty =~ s/\[.+?\]//;
1725 }
1726 redo if $clsty;
1727 }
1728 if ($colparams =~ m/^\\(\d+)/) {
1729 $colspan = $1;
1730 $colparams = substr($colparams, length($1)+1);
1731 redo if $1;
1732 }
1733 if ($colparams =~ m/\/(\d+)/) {
1734 $rowspans[$c] = $1 if $1;
1735 $colparams = substr($colparams, length($1)+1);
1736 redo if $1;
1737 }
1738 $params = 0;
1739 }
1740 }
1741 if (length($attrs)) {
1742 $header = 1 if $attrs =~ m/_/;
1743 $colalign = '' if $attrs =~ m/($alignre)/ && length($1);
1744 # determine column alignment
1745 if ($attrs =~ m/<>/) {
1746 $colalign .= '<>';
1747 } elsif ($attrs =~ m/</) {
1748 $colalign .= '<';
1749 } elsif ($attrs =~ m/=/) {
1750 $colalign = '=';
1751 } elsif ($attrs =~ m/>/) {
1752 $colalign = '>';
1753 }
1754 if ($attrs =~ m/\^/) {
1755 $colalign .= '^';
1756 } elsif ($attrs =~ m/~/) {
1757 $colalign .= '~';
1758 } elsif ($attrs =~ m/-/) {
1759 $colalign .= '-';
1760 }
1761 }
1762 $header = 1 if $rowheader;
1763 $colalign[$c] = $colalign if $header;
1764 $col =~ s/^ +//; $col =~ s/ +$//;
1765 if (length($col)) {
1766 # create one cell tag
1767 my $rowspan = $rowspans[$c] || 0;
1768 my $col_out = '<' . ($header ? 'th' : 'td');
1769 if (defined $colalign) {
1770 # horizontal, vertical alignment
1771 my $halign = _halign($colalign);
1772 $col_out .= qq{ align="$halign"} if $halign;
1773 my $valign = _valign($colalign);
1774 $col_out .= qq{ valign="$valign"} if $valign;
1775 }
1776 # apply css attributes, row, column spans
1777 $colstyle .= qq{;padding-left:${colpadl}em} if $colpadl;
1778 $colstyle .= qq{;padding-right:${colpadr}em} if $colpadr;
1779 $col_out .= qq{ class="$colclass"} if $colclass;
1780 $col_out .= qq{ id="$colid"} if $colid;
1781 $colstyle =~ s/^;// if $colstyle;
1782 $col_out .= qq{ style="$colstyle"} if $colstyle;
1783 $col_out .= qq{ lang="$collang"} if $collang;
1784 $col_out .= qq{ colspan="$colspan"} if $colspan > 1;
1785 $col_out .= qq{ rowspan="$rowspan"} if ($rowspan||0) > 1;
1786 $col_out .= '>';
1787 # if the content of this cell has newlines OR matches
1788 # our paragraph block signature, process it as a full-blown
1789 # textile document
1790 if (($col =~ m/\n\n/) ||
1791 ($col =~ m/^(?:$halignre|$clstypadre*)*
1792 [\*\#]
1793 (?:$clstypadre*|$halignre)*\ /x)) {
1794 $col_out .= $self->textile($col);
1795 } else {
1796 $col_out .= $self->format_paragraph(text => $col);
1797 }
1798 $col_out .= '</' . ($header ? 'th' : 'td') . '>';
1799 $row_out = $col_out . $row_out;
1800 $colspan = 0 if $colspan;
1801 } else {
1802 $colspan = 1 if $colspan == 0;
1803 $colspan++;
1804 }
1805 }
1806 if ($colspan > 1) {
1807 # handle the spanned column if we came up short
1808 $colspan--;
1809 $row_out = qq{<td}
1810 . ($colspan>1 ? qq{ colspan="$colspan"} : '')
1811 . qq{></td>$row_out};
1812 }
1813
1814 # build one table row
1815 $out .= qq{<tr};
1816 if ($rowalign) {
1817 my $valign = _valign($rowalign);
1818 $out .= qq{ valign="$valign"} if $valign;
1819 }
1820 $out .= qq{ class="$rowclass"} if $rowclass;
1821 $out .= qq{ id="$rowid"} if $rowid;
1822 $out .= qq{ style="$rowstyle"} if $rowstyle;
1823 $out .= qq{>$row_out</tr>};
1824 }
1825
1826 # now, form the table tag itself
1827 my $table = '';
1828 $table .= qq{<table};
1829 if ($talign) {
1830 if ($self->{css_mode}) {
1831 # horizontal alignment
1832 my $alignment = _halign($talign);
1833 if ($talign eq '=') {
1834 $tstyle .= ';margin-left:auto;margin-right:auto';
1835 } else {
1836 $tstyle .= ';float:'.$alignment if $alignment;
1837 }
1838 $tclass .= ' '.$alignment if $alignment;
1839 } else {
1840 my $alignment = _halign($talign);
1841 $table .= qq{ align="$alignment"} if $alignment;
1842 }
1843 }
1844 $tstyle .= qq{;padding-left:${tpadl}em} if $tpadl;
1845 $tstyle .= qq{;padding-right:${tpadr}em} if $tpadr;
1846 $tclass =~ s/^ // if $tclass;
1847 $table .= qq{ class="$tclass"} if $tclass;
1848 $table .= qq{ id="$tid"} if $tid;
1849 $tstyle =~ s/^;// if $tstyle;
1850 $table .= qq{ style="$tstyle"} if $tstyle;
1851 $table .= qq{ lang="$tlang"} if $tlang;
1852 $table .= qq{ cellspacing="0"} if $tclass || $tid || $tstyle;
1853 $table .= qq{>$out</table>};
1854
1855 if ($table =~ m|<tr></tr>|) {
1856 # exception -- something isn't right so return fail case
1857 return undef;
1858 }
1859
1860 $table;
1861 }
1862
1863 sub apply_filters {
1864 my $self = shift;
1865 my (%args) = @_;
1866 my $text = $args{text};
1867 return '' unless defined $text;
1868 my $list = $args{filters};
1869 my $filters = $self->{filters};
1870 return $text unless (ref $filters) eq 'HASH';
1871
1872 my $param = $self->filter_param;
1873 foreach my $filter (@$list) {
1874 next unless exists $filters->{$filter};
1875 if ((ref $filters->{$filter}) eq 'CODE') {
1876 $text = $filters->{$filter}->($text, $param);
1877 }
1878 }
1879 $text;
1880 }
1881
1882 # minor utility / formatting routines
1883
1884 {
1885 my $Have_Entities = eval 'use HTML::Entities; 1' ? 1 : 0;
1886
1887 sub encode_html {
1888 my $self = shift;
1889 my($html, $can_double_encode) = @_;
1890 return '' unless defined $html;
1891 if ($Have_Entities && $self->{char_encoding}) {
1892 $html = HTML::Entities::encode_entities($html);
1893 } else {
1894 $html = $self->encode_html_basic($html, $can_double_encode);
1895 }
1896 $html;
1897 }
1898
1899 sub decode_html {
1900 my $self = shift;
1901 my ($html) = @_;
1902 $html =~ s!&quot;!"!g;
1903 $html =~ s!&amp;!&!g;
1904 $html =~ s!&lt;!<!g;
1905 $html =~ s!&gt;!>!g;
1906 $html;
1907 }
1908
1909 sub encode_html_basic {
1910 my $self = shift;
1911 my($html, $can_double_encode) = @_;
1912 return '' unless defined $html;
1913 return $html unless $html =~ m/[^\w\s]/;
1914 if ($can_double_encode) {
1915 $html =~ s!&!&amp;!g;
1916 } else {
1917 ## Encode any & not followed by something that looks like
1918 ## an entity, numeric or otherwise.
1919 $html =~ s/&(?!#?[xX]?(?:[0-9a-fA-F]+|\w{1,8});)/&amp;/g;
1920 }
1921 $html =~ s!"!&quot;!g;
1922 $html =~ s!<!&lt;!g;
1923 $html =~ s!>!&gt;!g;
1924 $html;
1925 }
1926
1927 }
1928
1929 {
1930 my $Have_ImageSize = eval 'use Image::Size; 1' ? 1 : 0;
1931
1932 sub image_size {
1933 my $self = shift;
1934 my ($file) = @_;
1935 if ($Have_ImageSize) {
1936 if (-f $file) {
1937 return Image::Size::imgsize($file);
1938 } else {
1939 if (my $docroot = $self->docroot) {
1940 require File::Spec;
1941 my $fullpath = File::Spec->catfile($docroot, $file);
1942 if (-f $fullpath) {
1943 return Image::Size::imgsize($fullpath);
1944 }
1945 }
1946 }
1947 }
1948 undef;
1949 }
1950 }
1951
1952 sub encode_url {
1953 my $self = shift;
1954 my($str) = @_;
1955 $str =~ s!([^A-Za-z0-9_\.\-\+\&=\%;])!
1956 ord($1) > 255 ? '%u' . (uc sprintf("%04x", ord($1)))
1957 : '%' . (uc sprintf("%02x", ord($1)))!egx;
1958 $str;
1959 }
1960
1961 sub mail_encode {
1962 my $self = shift;
1963 my ($addr) = @_;
1964 # granted, this is simple, but it gives off warm fuzzies
1965 $addr =~ s!([^\$])!
1966 ord($1) > 255 ? '%u' . (uc sprintf("%04x", ord($1)))
1967 : '%' . (uc sprintf("%02x", ord($1)))!egx;
1968 $addr;
1969 }
1970
1971 sub process_quotes {
1972 # stub routine for now. subclass and implement.
1973 my $self = shift;
1974 my ($str) = @_;
1975 $str;
1976 }
1977
1978 # a default set of macros for the {...} macro syntax
1979 # just a handy way to write a lot of the international characters
1980 # and some commonly used symbols
1981
1982 sub default_macros {
1983 my $self = shift;
1984 # <, >, " must be html entities in the macro text since
1985 # those values are escaped by the time they are processed
1986 # for macros.
1987 return {
1988 'c|' => '&#162;', # CENT SIGN
1989 '|c' => '&#162;', # CENT SIGN
1990 'L-' => '&#163;', # POUND SIGN
1991 '-L' => '&#163;', # POUND SIGN
1992 'Y=' => '&#165;', # YEN SIGN
1993 '=Y' => '&#165;', # YEN SIGN
1994 '(c)' => '&#169;', # COPYRIGHT SIGN
1995 '&lt;&lt;' => '&#171;', # LEFT-POINTING DOUBLE ANGLE QUOTATION
1996 '(r)' => '&#174;', # REGISTERED SIGN
1997 '+_' => '&#177;', # PLUS-MINUS SIGN
1998 '_+' => '&#177;', # PLUS-MINUS SIGN
1999 '&gt;&gt;' => '&#187;', # RIGHT-POINTING DOUBLE ANGLE QUOTATION
2000 '1/4' => '&#188;', # VULGAR FRACTION ONE QUARTER
2001 '1/2' => '&#189;', # VULGAR FRACTION ONE HALF
2002 '3/4' => '&#190;', # VULGAR FRACTION THREE QUARTERS
2003 'A`' => '&#192;', # LATIN CAPITAL LETTER A WITH GRAVE
2004 '`A' => '&#192;', # LATIN CAPITAL LETTER A WITH GRAVE
2005 'A\'' => '&#193;', # LATIN CAPITAL LETTER A WITH ACUTE
2006 '\'A' => '&#193;', # LATIN CAPITAL LETTER A WITH ACUTE
2007 'A^' => '&#194;', # LATIN CAPITAL LETTER A WITH CIRCUMFLEX
2008 '^A' => '&#194;', # LATIN CAPITAL LETTER A WITH CIRCUMFLEX
2009 'A~' => '&#195;', # LATIN CAPITAL LETTER A WITH TILDE
2010 '~A' => '&#195;', # LATIN CAPITAL LETTER A WITH TILDE
2011 'A"' => '&#196;', # LATIN CAPITAL LETTER A WITH DIAERESIS
2012 '"A' => '&#196;', # LATIN CAPITAL LETTER A WITH DIAERESIS
2013 'Ao' => '&#197;', # LATIN CAPITAL LETTER A WITH RING ABOVE
2014 'oA' => '&#197;', # LATIN CAPITAL LETTER A WITH RING ABOVE
2015 'AE' => '&#198;', # LATIN CAPITAL LETTER AE
2016 'C,' => '&#199;', # LATIN CAPITAL LETTER C WITH CEDILLA
2017 ',C' => '&#199;', # LATIN CAPITAL LETTER C WITH CEDILLA
2018 'E`' => '&#200;', # LATIN CAPITAL LETTER E WITH GRAVE
2019 '`E' => '&#200;', # LATIN CAPITAL LETTER E WITH GRAVE
2020 'E\'' => '&#201;', # LATIN CAPITAL LETTER E WITH ACUTE
2021 '\'E' => '&#201;', # LATIN CAPITAL LETTER E WITH ACUTE
2022 'E^' => '&#202;', # LATIN CAPITAL LETTER E WITH CIRCUMFLEX
2023 '^E' => '&#202;', # LATIN CAPITAL LETTER E WITH CIRCUMFLEX
2024 'E"' => '&#203;', # LATIN CAPITAL LETTER E WITH DIAERESIS
2025 '"E' => '&#203;', # LATIN CAPITAL LETTER E WITH DIAERESIS
2026 'I`' => '&#204;', # LATIN CAPITAL LETTER I WITH GRAVE
2027 '`I' => '&#204;', # LATIN CAPITAL LETTER I WITH GRAVE
2028 'I\'' => '&#205;', # LATIN CAPITAL LETTER I WITH ACUTE
2029 '\'I' => '&#205;', # LATIN CAPITAL LETTER I WITH ACUTE
2030 'I^' => '&#206;', # LATIN CAPITAL LETTER I WITH CIRCUMFLEX
2031 '^I' => '&#206;', # LATIN CAPITAL LETTER I WITH CIRCUMFLEX
2032 'I"' => '&#207;', # LATIN CAPITAL LETTER I WITH DIAERESIS
2033 '"I' => '&#207;', # LATIN CAPITAL LETTER I WITH DIAERESIS
2034 'D-' => '&#208;', # LATIN CAPITAL LETTER ETH
2035 '-D' => '&#208;', # LATIN CAPITAL LETTER ETH
2036 'N~' => '&#209;', # LATIN CAPITAL LETTER N WITH TILDE
2037 '~N' => '&#209;', # LATIN CAPITAL LETTER N WITH TILDE
2038 'O`' => '&#210;', # LATIN CAPITAL LETTER O WITH GRAVE
2039 '`O' => '&#210;', # LATIN CAPITAL LETTER O WITH GRAVE
2040 'O\'' => '&#211;', # LATIN CAPITAL LETTER O WITH ACUTE
2041 '\'O' => '&#211;', # LATIN CAPITAL LETTER O WITH ACUTE
2042 'O^' => '&#212;', # LATIN CAPITAL LETTER O WITH CIRCUMFLEX
2043 '^O' => '&#212;', # LATIN CAPITAL LETTER O WITH CIRCUMFLEX
2044 'O~' => '&#213;', # LATIN CAPITAL LETTER O WITH TILDE
2045 '~O' => '&#213;', # LATIN CAPITAL LETTER O WITH TILDE
2046 'O"' => '&#214;', # LATIN CAPITAL LETTER O WITH DIAERESIS
2047 '"O' => '&#214;', # LATIN CAPITAL LETTER O WITH DIAERESIS
2048 'O/' => '&#216;', # LATIN CAPITAL LETTER O WITH STROKE
2049 '/O' => '&#216;', # LATIN CAPITAL LETTER O WITH STROKE
2050 'U`' => '&#217;', # LATIN CAPITAL LETTER U WITH GRAVE
2051 '`U' => '&#217;', # LATIN CAPITAL LETTER U WITH GRAVE
2052 'U\'' => '&#218;', # LATIN CAPITAL LETTER U WITH ACUTE
2053 '\'U' => '&#218;', # LATIN CAPITAL LETTER U WITH ACUTE
2054 'U^' => '&#219;', # LATIN CAPITAL LETTER U WITH CIRCUMFLEX
2055 '^U' => '&#219;', # LATIN CAPITAL LETTER U WITH CIRCUMFLEX
2056 'U"' => '&#220;', # LATIN CAPITAL LETTER U WITH DIAERESIS
2057 '"U' => '&#220;', # LATIN CAPITAL LETTER U WITH DIAERESIS
2058 'Y\'' => '&#221;', # LATIN CAPITAL LETTER Y WITH ACUTE
2059 '\'Y' => '&#221;', # LATIN CAPITAL LETTER Y WITH ACUTE
2060 'a`' => '&#224;', # LATIN SMALL LETTER A WITH GRAVE
2061 '`a' => '&#224;', # LATIN SMALL LETTER A WITH GRAVE
2062 'a\'' => '&#225;', # LATIN SMALL LETTER A WITH ACUTE
2063 '\'a' => '&#225;', # LATIN SMALL LETTER A WITH ACUTE
2064 'a^' => '&#226;', # LATIN SMALL LETTER A WITH CIRCUMFLEX
2065 '^a' => '&#226;', # LATIN SMALL LETTER A WITH CIRCUMFLEX
2066 'a~' => '&#227;', # LATIN SMALL LETTER A WITH TILDE
2067 '~a' => '&#227;', # LATIN SMALL LETTER A WITH TILDE
2068 'a"' => '&#228;', # LATIN SMALL LETTER A WITH DIAERESIS
2069 '"a' => '&#228;', # LATIN SMALL LETTER A WITH DIAERESIS
2070 'ao' => '&#229;', # LATIN SMALL LETTER A WITH RING ABOVE
2071 'oa' => '&#229;', # LATIN SMALL LETTER A WITH RING ABOVE
2072 'ae' => '&#230;', # LATIN SMALL LETTER AE
2073 'c,' => '&#231;', # LATIN SMALL LETTER C WITH CEDILLA
2074 ',c' => '&#231;', # LATIN SMALL LETTER C WITH CEDILLA
2075 'e`' => '&#232;', # LATIN SMALL LETTER E WITH GRAVE
2076 '`e' => '&#232;', # LATIN SMALL LETTER E WITH GRAVE
2077 'e\'' => '&#233;', # LATIN SMALL LETTER E WITH ACUTE
2078 '\'e' => '&#233;', # LATIN SMALL LETTER E WITH ACUTE
2079 'e^' => '&#234;', # LATIN SMALL LETTER E WITH CIRCUMFLEX
2080 '^e' => '&#234;', # LATIN SMALL LETTER E WITH CIRCUMFLEX
2081 'e"' => '&#235;', # LATIN SMALL LETTER E WITH DIAERESIS
2082 '"e' => '&#235;', # LATIN SMALL LETTER E WITH DIAERESIS
2083 'i`' => '&#236;', # LATIN SMALL LETTER I WITH GRAVE
2084 '`i' => '&#236;', # LATIN SMALL LETTER I WITH GRAVE
2085 'i\'' => '&#237;', # LATIN SMALL LETTER I WITH ACUTE
2086 '\'i' => '&#237;', # LATIN SMALL LETTER I WITH ACUTE
2087 'i^' => '&#238;', # LATIN SMALL LETTER I WITH CIRCUMFLEX
2088 '^i' => '&#238;', # LATIN SMALL LETTER I WITH CIRCUMFLEX
2089 'i"' => '&#239;', # LATIN SMALL LETTER I WITH DIAERESIS
2090 '"i' => '&#239;', # LATIN SMALL LETTER I WITH DIAERESIS
2091 'n~' => '&#241;', # LATIN SMALL LETTER N WITH TILDE
2092 '~n' => '&#241;', # LATIN SMALL LETTER N WITH TILDE
2093 'o`' => '&#242;', # LATIN SMALL LETTER O WITH GRAVE
2094 '`o' => '&#242;', # LATIN SMALL LETTER O WITH GRAVE
2095 'o\'' => '&#243;', # LATIN SMALL LETTER O WITH ACUTE
2096 '\'o' => '&#243;', # LATIN SMALL LETTER O WITH ACUTE
2097 'o^' => '&#244;', # LATIN SMALL LETTER O WITH CIRCUMFLEX
2098 '^o' => '&#244;', # LATIN SMALL LETTER O WITH CIRCUMFLEX
2099 'o~' => '&#245;', # LATIN SMALL LETTER O WITH TILDE
2100 '~o' => '&#245;', # LATIN SMALL LETTER O WITH TILDE
2101 'o"' => '&#246;', # LATIN SMALL LETTER O WITH DIAERESIS
2102 '"o' => '&#246;', # LATIN SMALL LETTER O WITH DIAERESIS
2103 ':-' => '&#247;', # DIVISION SIGN
2104 '-:' => '&#247;', # DIVISION SIGN
2105 'o/' => '&#248;', # LATIN SMALL LETTER O WITH STROKE
2106 '/o' => '&#248;', # LATIN SMALL LETTER O WITH STROKE
2107 'u`' => '&#249;', # LATIN SMALL LETTER U WITH GRAVE
2108 '`u' => '&#249;', # LATIN SMALL LETTER U WITH GRAVE
2109 'u\'' => '&#250;', # LATIN SMALL LETTER U WITH ACUTE
2110 '\'u' => '&#250;', # LATIN SMALL LETTER U WITH ACUTE
2111 'u^' => '&#251;', # LATIN SMALL LETTER U WITH CIRCUMFLEX
2112 '^u' => '&#251;', # LATIN SMALL LETTER U WITH CIRCUMFLEX
2113 'u"' => '&#252;', # LATIN SMALL LETTER U WITH DIAERESIS
2114 '"u' => '&#252;', # LATIN SMALL LETTER U WITH DIAERESIS
2115 'y\'' => '&#253;', # LATIN SMALL LETTER Y WITH ACUTE
2116 '\'y' => '&#253;', # LATIN SMALL LETTER Y WITH ACUTE
2117 'y"' => '&#255', # LATIN SMALL LETTER Y WITH DIAERESIS
2118 '"y' => '&#255', # LATIN SMALL LETTER Y WITH DIAERESIS
2119 'OE' => '&#338;', # LATIN CAPITAL LIGATURE OE
2120 'oe' => '&#339;', # LATIN SMALL LIGATURE OE
2121 '*' => '&#2022;', # BULLET
2122 'Fr' => '&#8355;', # FRENCH FRANC SIGN
2123 'L=' => '&#8356;', # LIRA SIGN
2124 '=L' => '&#8356;', # LIRA SIGN
2125 'Rs' => '&#8360;', # RUPEE SIGN
2126 'C=' => '&#8364;', # EURO SIGN
2127 '=C' => '&#8364;', # EURO SIGN
2128 'tm' => '&#8482;', # TRADE MARK SIGN
2129 '&lt;-' => '&#8592;', # LEFTWARDS ARROW
2130 '-&gt;' => '&#8594;', # RIGHTWARDS ARROW
2131 '&lt;=' => '&#8656;', # LEFTWARDS DOUBLE ARROW
2132 '=&gt;' => '&#8658;', # RIGHTWARDS DOUBLE ARROW
2133 '=/' => '&#8800;', # NOT EQUAL TO
2134 '/=' => '&#8800;', # NOT EQUAL TO
2135 '&lt;_' => '&#8804;', # LESS-THAN OR EQUAL TO
2136 '_&lt;' => '&#8804;', # LESS-THAN OR EQUAL TO
2137 '&gt;_' => '&#8805;', # GREATER-THAN OR EQUAL TO
2138 '_&gt;' => '&#8805;', # GREATER-THAN OR EQUAL TO
2139 ':(' => '&#9785;', # WHITE FROWNING FACE
2140 ':)' => '&#9786;', # WHITE SMILING FACE
2141 'spade' => '&#9824;', # BLACK SPADE SUIT
2142 'club' => '&#9827;', # BLACK CLUB SUIT
2143 'heart' => '&#9829;', # BLACK HEART SUIT
2144 'diamond' => '&#9830;', # BLACK DIAMOND SUIT
2145 };
2146 }
2147
2148 # "private", internal routines
2149
2150 sub _css_defaults {
2151 my $self = shift;
2152 my %css_defaults = (
2153 class_align_right => 'right',
2154 class_align_left => 'left',
2155 class_align_center => 'center',
2156 class_align_top => 'top',
2157 class_align_bottom => 'bottom',
2158 class_align_middle => 'middle',
2159 class_align_justify => 'justify',
2160 class_caps => 'caps',
2161 class_footnote => 'footnote',
2162 id_footnote_prefix => 'fn',
2163 );
2164 $self->css(\%css_defaults);
2165 }
2166
2167 sub _halign {
2168 my ($align) = @_;
2169
2170 if ($align =~ m/<>/) {
2171 return 'justify';
2172 } elsif ($align =~ m/</) {
2173 return 'left';
2174 } elsif ($align =~ m/>/) {
2175 return 'right';
2176 } elsif ($align =~ m/=/) {
2177 return 'center';
2178 }
2179 return '';
2180 }
2181
2182 sub _valign {
2183 my ($align) = @_;
2184
2185 if ($align =~ m/\^/) {
2186 return 'top';
2187 } elsif ($align =~ m/~/) {
2188 return 'bottom';
2189 } elsif ($align =~ m/-/) {
2190 return 'middle';
2191 }
2192 return '';
2193 }
2194
2195 sub _imgalign {
2196 my ($align) = @_;
2197
2198 $align =~ s/(<>|=)//g;
2199 return _valign($align) || _halign($align);
2200 }
2201
2202 sub _strip_borders {
2203 my ($pre, $post) = @_;
2204 if ($$post && $$pre && ((my $open = substr($$pre, 0, 1)) =~ m/[{[]/)) {
2205 my $close = substr($$post, 0, 1);
2206 if ((($open eq '{') && ($close eq '}')) ||
2207 (($open eq '[') && ($close eq ']'))) {
2208 $$pre = substr($$pre, 1);
2209 $$post = substr($$post, 1);
2210 } else {
2211 $close = substr($$post, -1, 1) if $close !~ m/[}\]]/;
2212 if ((($open eq '{') && ($close eq '}')) ||
2213 (($open eq '[') && ($close eq ']'))) {
2214 $$pre = substr($$pre, 1);
2215 $$post = substr($$post, 0, length($$post) - 1);
2216 }
2217 }
2218 }
2219 }
2220
2221 sub _repl {
2222 push @{$_[0]}, $_[1];
2223 '<textile#'.(scalar(@{$_[0]})).'>';
2224 }
2225
2226 sub _tokenize {
2227 my $str = shift;
2228 my $pos = 0;
2229 my $len = length $str;
2230 my @tokens;
2231
2232 my $depth = 6;
2233 my $nested_tags = join('|', ('(?:</?[A-Za-z0-9:]+ \s? (?:[^<>]') x $depth)
2234 . (')*>)' x $depth);
2235 my $match = qr/(?s: <! ( -- .*? -- \s* )+ > )| # comment
2236 (?s: <\? .*? \?> )| # processing instruction
2237 (?s: <\% .*? \%> )| # ASP-like
2238 (?:$nested_tags)|
2239 (?:$codere)/x; # nested tags
2240
2241 while ($str =~ m/($match)/g) {
2242 my $whole_tag = $1;
2243 my $sec_start = pos $str;
2244 my $tag_start = $sec_start - length $whole_tag;
2245 if ($pos < $tag_start) {
2246 push @tokens, ['text', substr($str, $pos, $tag_start - $pos)];
2247 }
2248 if ($whole_tag =~ m/^[[{]?\@/) {
2249 push @tokens, ['text', $whole_tag];
2250 } else {
2251 # this clever hack allows us to preserve \n within tags.
2252 # this is restored at the end of the format_paragraph method
2253 #$whole_tag =~ s/\n/\r/g;
2254 $whole_tag =~ s/\n/\001/g;
2255 push @tokens, ['tag', $whole_tag];
2256 }
2257 $pos = pos $str;
2258 }
2259 push @tokens, ['text', substr($str, $pos, $len - $pos)] if $pos < $len;
2260 \@tokens;
2261 }
2262
2263 1;
2264 __END__
2265
2266 =head1 NAME
2267
2268 Text::Textile - A humane web text generator.
2269
2270 =head1 SYNOPSIS
2271
2272 use Text::Textile qw(textile);
2273 my $text = <<EOT;
2274 h1. Heading
2275
2276 A _simple_ demonstration of Textile markup.
2277
2278 * One
2279 * Two
2280 * Three
2281
2282 "More information":http://www.textism.com/tools/textile is available.
2283 EOT
2284
2285 # procedural usage
2286 my $html = textile($text);
2287 print $html;
2288
2289 # OOP usage
2290 my $textile = new Text::Textile;
2291 $html = $textile->process($text);
2292 print $html;
2293
2294 =head1 ABSTRACT
2295
2296 Text::Textile is a Perl-based implementation of Dean Allen's Textile
2297 syntax. Textile is shorthand for doing common formatting tasks.
2298
2299 =head1 METHODS
2300
2301 =head2 new( [%options] )
2302
2303 Instantiates a new Text::Textile object. Optional options
2304 can be passed to initialize the object. Attributes for the
2305 options key are the same as the get/set method names
2306 documented here.
2307
2308 =head2 set( $attribute, $value )
2309
2310 Used to set Textile attributes. Attribute names are the same
2311 as the get/set method names documented here.
2312
2313 =head2 get( $attribute )
2314
2315 Used to get Textile attributes. Attribute names are the same
2316 as the get/set method names documented here.
2317
2318 =head2 disable_html( [$disable] )
2319
2320 Gets or sets the "disable html" control, which allows you to
2321 prevent HTML tags from being used within the text processed.
2322 Any HTML tags encountered will be removed if disable html is
2323 enabled. Default behavior is to allow HTML.
2324
2325 =head2 flavor( [$flavor] )
2326
2327 Assigns the HTML flavor of output from Text::Textile. Currently
2328 these are the valid choices: html, xhtml (behaves like "xhtml1"),
2329 xhtml1, xhtml2. Default flavor is "xhtml1".
2330
2331 Note that the xhtml2 flavor support is experimental and incomplete
2332 (and will remain that way until the XHTML 2.0 draft becomes a
2333 proper recommendation).
2334
2335 =head2 css( [$css] )
2336
2337 Gets or sets the css support for Textile. If css is enabled,
2338 Textile will emit CSS rules. You may pass a 1 or 0 to enable
2339 or disable CSS behavior altogether. If you pass a hashref,
2340 you may assign the CSS class names that are used by
2341 Text::Textile. The following key names for such a hash are
2342 recognized:
2343
2344 =over
2345
2346 =item class_align_right
2347
2348 defaults to 'right'
2349
2350 =item class_align_left
2351
2352 defaults to 'left'
2353
2354 =item class_align_center
2355
2356 defaults to 'center'
2357
2358 =item class_align_top
2359
2360 defaults to 'top'
2361
2362 =item class_align_bottom
2363
2364 defaults to 'bottom'
2365
2366 =item class_align_middle
2367
2368 defaults to 'middle'
2369
2370 =item class_align_justify
2371
2372 defaults to 'justify'
2373
2374 =item class_caps
2375
2376 defaults to 'caps'
2377
2378 =item class_footnote
2379
2380 defaults to 'footnote'
2381
2382 =item id_footnote_prefix
2383
2384 defaults to 'fn'
2385
2386 =back
2387
2388 =head2 charset( [$charset] )
2389
2390 Gets or sets the character set targetted for publication.
2391 At this time, Text::Textile only changes its behavior
2392 if the 'utf-8' character set is assigned.
2393
2394 Specifically, if utf-8 is requested, any special characters
2395 created by Textile will be output as native utf-8 characters
2396 rather than HTML entities.
2397
2398 =head2 docroot( [$path] )
2399
2400 Gets or sets the physical file path to root of document files.
2401 This path is utilized when images are referenced and size
2402 calculations are needed (the Image::Size module is used to read
2403 the image dimensions).
2404
2405 =head2 trim_spaces( [$trim] )
2406
2407 Gets or sets the 'trim spaces' control flag. If enabled, this
2408 will clear any lines that have only spaces on them (the newline
2409 itself will remain).
2410
2411 =head2 preserve_spaces( [$preserve] )
2412
2413 Gets or sets the 'preserve spaces' control flag. If enabled, this
2414 will replace any double spaces within the paragraph data with the
2415 &#8195; HTML entity (wide space). The default is 0. Spaces will
2416 pass through to the browser unchanged and render as a single space.
2417 Note that this setting has no effect on spaces within E<lt>preE<gt>,
2418 E<lt>codeE<gt> blocks or E<lt>scriptE<gt> sections.
2419
2420 =head2 filter_param( [$data] )
2421
2422 Gets or sets a parameter that is passed to filters.
2423
2424 =head2 filters( [\%filters] )
2425
2426 Gets or sets a list of filters to make available for
2427 Text::Textile to use. Returns a hash reference of the currently
2428 assigned filters.
2429
2430 =head2 char_encoding( [$encode] )
2431
2432 Gets or sets the character encoding logical flag. If character
2433 encoding is enabled, the HTML::Entities package is used to
2434 encode special characters. If character encoding is disabled,
2435 only <, >, " and & are encoded to HTML entities.
2436
2437 =head2 handle_quotes( [$handle] )
2438
2439 Gets or sets the "smart quoting" control flag. Returns the
2440 current setting.
2441
2442 =head2 process( $str )
2443
2444 Alternative method for invoking the textile method.
2445
2446 =head2 textile( $str )
2447
2448 Can be called either procedurally or as a method. Transforms
2449 $str using Textile markup rules.
2450
2451 =head2 format_paragraph( [$args] )
2452
2453 Processes a single paragraph. The following attributes are
2454 allowed:
2455
2456 =over
2457
2458 =item text
2459
2460 The text to be processed.
2461
2462 =back
2463
2464 =head2 format_inline( [%args] )
2465
2466 Processes an inline string (plaintext) for Textile syntax.
2467 The following attributes are allowed:
2468
2469 =over
2470
2471 =item text
2472
2473 The text to be processed.
2474
2475 =back
2476
2477 =head2 format_macro( %args )
2478
2479 Responsible for processing a particular macro. Arguments passed
2480 include:
2481
2482 =over
2483
2484 =item pre
2485
2486 open brace character
2487
2488 =item post
2489
2490 close brace character
2491
2492 =item macro
2493
2494 the macro to be executed
2495
2496 =back
2497
2498 The return value from this method would be the replacement
2499 text for the macro given. If the macro is not defined, it will
2500 return pre + macro + post, thereby preserving the original
2501 macro string.
2502
2503 =head2 format_cite( %args )
2504
2505 Processes text for a citation tag. The following attributes
2506 are allowed:
2507
2508 =over
2509
2510 =item pre
2511
2512 Any text that comes before the citation.
2513
2514 =item text
2515
2516 The text that is being cited.
2517
2518 =item cite
2519
2520 The URL of the citation.
2521
2522 =item post
2523
2524 Any text that follows the citation.
2525
2526 =back
2527
2528 =head2 format_code( %args )
2529
2530 Processes '@...@' type blocks (code snippets). The following
2531 attributes are allowed:
2532
2533 =over
2534
2535 =item text
2536
2537 The text of the code itself.
2538
2539 =item lang
2540
2541 The language (programming language) for the code.
2542
2543 =back
2544
2545 =head2 format_classstyle( $clsty, $class, $style )
2546
2547 Returns a string of tag attributes to accomodate the class,
2548 style and symbols present in $clsty.
2549
2550 $clsty is checked for:
2551
2552 =over
2553
2554 =item C<{...}>
2555
2556 style rules. If present, they are appended to $style.
2557
2558 =item C<(...#...)>
2559
2560 class and/or ID name declaration
2561
2562 =item C<(> (one or more)
2563
2564 pad left characters
2565
2566 =item C<)> (one or more)
2567
2568 pad right characters
2569
2570 =item C<[ll]>
2571
2572 language declaration
2573
2574 =back
2575
2576 The attribute string returned will contain any combination
2577 of class, id, style and/or lang attributes.
2578
2579 =head2 format_tag( %args )
2580
2581 Constructs an HTML tag. Accepted arguments:
2582
2583 =over
2584
2585 =item tag
2586
2587 the tag to produce
2588
2589 =item text
2590
2591 the text to output inside the tag
2592
2593 =item pre
2594
2595 text to produce before the tag
2596
2597 =item post
2598
2599 text to produce following the tag
2600
2601 =item clsty
2602
2603 class and/or style attributes that should be assigned to the tag.
2604
2605 =back
2606
2607 =head2 format_list( %args )
2608
2609 Takes a Textile formatted list (numeric or bulleted) and
2610 returns the markup for it. Text that is passed in requires
2611 substantial parsing, so the format_list method is a little
2612 involved. But it should always produce a proper ordered
2613 or unordered list. If it cannot (due to misbalanced input),
2614 it will return the original text. Arguments accepted:
2615
2616 =over
2617
2618 =item text
2619
2620 The text to be processed.
2621
2622 =back
2623
2624 =head2 format_block( %args )
2625
2626 Processes '==xxxxx==' type blocks for filters. A filter
2627 would follow the open '==' sequence and is specified within
2628 pipe characters, like so:
2629
2630 ==|filter|text to be filtered==
2631
2632 You may specify multiple filters in the filter portion of
2633 the string. Simply comma delimit the filters you desire
2634 to execute. Filters are defined using the filters method.
2635
2636 =head2 format_link( %args )
2637
2638 Takes the Textile link attributes and transforms them into
2639 a hyperlink.
2640
2641 =head2 format_url( %args )
2642
2643 Takes the given $url and transforms it appropriately.
2644
2645 =head2 format_span( %args )
2646
2647 =head2 format_image( %args )
2648
2649 Returns markup for the given image. $src is the location of
2650 the image, $extra contains the optional height/width and/or
2651 alt text. $url is an optional hyperlink for the image. $class
2652 holds the optional CSS class attribute.
2653
2654 Arguments you may pass:
2655
2656 =over
2657
2658 =item src
2659
2660 The 'src' (URL) for the image. This may be a local path,
2661 ideally starting with a '/'. Images can be located within
2662 the file system if the docroot method is used to specify
2663 where the docroot resides. If the image can be found, the
2664 image_size method is used to determine the dimensions of
2665 the image.
2666
2667 =item extra
2668
2669 Additional parameters for the image. This would include
2670 alt text, height/width specification or scaling instructions.
2671
2672 =item align
2673
2674 Alignment attribute.
2675
2676 =item pre
2677
2678 Text to produce prior to the tag.
2679
2680 =item post
2681
2682 Text to produce following the tag.
2683
2684 =item link
2685
2686 Optional URL to connect with the image tag.
2687
2688 =item clsty
2689
2690 Class and/or style attributes.
2691
2692 =back
2693
2694 =head2 format_table( %args )
2695
2696 Takes a Wiki-ish string of data and transforms it into a full
2697 table.
2698
2699 =head2 apply_filters( %args )
2700
2701 The following attributes are allowed:
2702
2703 =over
2704
2705 =item text
2706
2707 The text to be processed.
2708
2709 =item filters
2710
2711 An array reference of filter names to run for the given text.
2712
2713 =back
2714
2715 =head2 encode_html( $html, $can_double_encode )
2716
2717 Encodes input $html string, escaping characters as needed
2718 to HTML entities. This relies on the HTML::Entities package
2719 for full effect. If unavailable, encode_html_basic is used
2720 as a fallback technique. If the "char_encoding" flag is
2721 set to false, encode_html_basic is used exclusively.
2722
2723 =head2 decode_html( $html )
2724
2725 Decodes HTML entities in $html to their natural character
2726 equivelants.
2727
2728 =head2 encode_html_basic( $html, $can_double_encode )
2729
2730 Encodes the input $html string for the following characters:
2731 E<lt>, E<gt>, & and ". If $can_double_encode is true, all
2732 ampersand characters are escaped even if they already were.
2733 If $can_double_encode is false, ampersands are only escaped
2734 when they aren't part of a HTML entity already.
2735
2736 =head2 image_size( $file )
2737
2738 Returns the size for the image identified in $file. This
2739 method relies upon the Image::Size Perl package. If unavailable,
2740 image_size will return undef. Otherwise, the expected return
2741 value is a list of the width and height (in that order), in
2742 pixels.
2743
2744 =head2 encode_url( $str )
2745
2746 Encodes the query portion of a URL, escaping characters
2747 as necessary.
2748
2749 =head2 mail_encode( $email )
2750
2751 Encodes the email address in $email for 'mailto:' links.
2752
2753 =head2 process_quotes( $str )
2754
2755 Processes string, formatting plain quotes into curly quotes.
2756
2757 =head2 default_macros
2758
2759 Returns a hashref of macros that are assigned to be processed by
2760 default within the format_inline method.
2761
2762 =head2 _halign( $alignment )
2763
2764 Returns the alignment keyword depending on the symbol passed.
2765
2766 =over
2767
2768 =item C<E<lt>E<gt>>
2769
2770 becomes 'justify'
2771
2772 =item C<E<lt>>
2773
2774 becomes 'left'
2775
2776 =item C<E<gt>>
2777
2778 becomes 'right'
2779
2780 =item C<=>
2781
2782 becomes 'center'
2783
2784 =back
2785
2786 =head2 _valign( $alignment )
2787
2788 Returns the alignment keyword depending on the symbol passed.
2789
2790 =over
2791
2792 =item C<^>
2793
2794 becomes 'top'
2795
2796 =item C<~>
2797
2798 becomes 'bottom'
2799
2800 =item C<->
2801
2802 becomes 'middle'
2803
2804 =back
2805
2806 =head2 _imgalign( $alignment )
2807
2808 Returns the alignment keyword depending on the symbol passed.
2809 The following alignment symbols are recognized, and given
2810 preference in the order listed:
2811
2812 =over
2813
2814 =item C<^>
2815
2816 becomes 'top'
2817
2818 =item C<~>
2819
2820 becomes 'bottom'
2821
2822 =item C<->
2823
2824 becomes 'middle'
2825
2826 =item C<E<lt>>
2827
2828 becomes 'left'
2829
2830 =item C<E<gt>>
2831
2832 becomes 'right'
2833
2834 =back
2835
2836 =head2 _repl( \@arr, $str )
2837
2838 An internal routine that takes a string and appends it to an array.
2839 It returns a marker that is used later to restore the preserved
2840 string.
2841
2842 =head2 _tokenize( $str )
2843
2844 An internal routine responsible for breaking up a string into
2845 individual tag and plaintext elements.
2846
2847 =head2 _css_defaults
2848
2849 Sets the default CSS names for CSS controlled markup. This
2850 is an internal function that should not be called directly.
2851
2852 =head2 _strip_borders( $pre, $post )
2853
2854 This utility routine will take 'border' characters off of
2855 the given $pre and $post strings if they match one of these
2856 conditions:
2857
2858 $pre starts with '[', $post ends with ']'
2859 $pre starts with '{', $post ends with '}'
2860
2861 If neither condition is met, then the $pre and $post
2862 values are left untouched.
2863
2864 =head1 SYNTAX
2865
2866 Text::Textile processes text in units of blocks and lines.
2867 A block might also be considered a paragraph, since blocks
2868 are separated from one another by a blank line. Blocks
2869 can begin with a signature that helps identify the rest
2870 of the block content. Block signatures include:
2871
2872 =over
2873
2874 =item p
2875
2876 A paragraph block. This is the default signature if no
2877 signature is explicitly given. Paragraphs are formatted
2878 with all the inline rules (see inline formatting) and
2879 each line receives the appropriate markup rules for
2880 the flavor of HTML in use. For example, newlines for XHTML
2881 content receive a E<lt>br /E<gt> tag at the end of the line
2882 (with the exception of the last line in the paragraph).
2883 Paragraph blocks are enclosed in a E<lt>pE<gt> tag.
2884
2885 =item pre
2886
2887 A pre-formatted block of text. Textile will not add any
2888 HTML tags for individual lines. Whitespace is also preserved.
2889
2890 Note that within a "pre" block, E<lt> and E<gt> are
2891 translated into HTML entities automatically.
2892
2893 =item bc
2894
2895 A "bc" signature is short for "block code", which implies
2896 a preformatted section like the 'pre' block, but it also
2897 gets a E<lt>codeE<gt> tag (or for XHTML 2, a E<lt>blockcodeE<gt>
2898 tag is used instead).
2899
2900 Note that within a "bc" block, E<lt> and E<gt> are
2901 translated into HTML entities automatically.
2902
2903 =item table
2904
2905 For composing HTML tables. See the "TABLES" section for more
2906 information.
2907
2908 =item bq
2909
2910 A "bq" signature is short for "block quote". Paragraph text
2911 formatting is applied to these blocks and they are enclosed
2912 in a E<lt>blockquoteE<gt> tag as well as E<lt>pE<gt> tags
2913 within.
2914
2915 =item h1, h2, h3, h4, h5, h6
2916
2917 Headline signatures that produce E<lt>h1E<gt>, etc. tags.
2918 You can adjust the relative output of these using the
2919 head_offset attribute.
2920
2921 =item clear
2922
2923 A 'clear' signature is simply used to indicate that the next
2924 block should emit a CSS style attribute that clears any
2925 floating elements. The default behavior is to clear "both",
2926 but you can use the left (E<lt>) or right (E<gt>) alignment
2927 characters to indicate which side to clear.
2928
2929 =item dl
2930
2931 A "dl" signature is short for "definition list". See the
2932 "LISTS" section for more information.
2933
2934 =item fn
2935
2936 A "fn" signature is short for "footnote". You add a number
2937 following the "fn" keyword to number the footnote. Footnotes
2938 are output as paragraph tags but are given a special CSS
2939 class name which can be used to style them as you see fit.
2940
2941 =back
2942
2943 All signatures should end with a period and be followed
2944 with a space. Inbetween the signature and the period, you
2945 may use several parameters to further customize the block.
2946 These include:
2947
2948 =over
2949
2950 =item C<{style rule}>
2951
2952 A CSS style rule. Style rules can span multiple lines.
2953
2954 =item C<[ll]>
2955
2956 A language identifier (for a "lang" attribute).
2957
2958 =item C<(class)> or C<(#id)> or C<(class#id)>
2959
2960 For CSS class and id attributes.
2961
2962 =item C<E<gt>>, C<E<lt>>, C<=>, C<E<lt>E<gt>>
2963
2964 Modifier characters for alignment. Right-justification, left-justification,
2965 centered, and full-justification.
2966
2967 =item C<(> (one or more)
2968
2969 Adds padding on the left. 1em per "(" character is applied.
2970 When combined with the align-left or align-right modifier,
2971 it makes the block float.
2972
2973 =item C<)> (one or more)
2974
2975 Adds padding on the right. 1em per ")" character is applied.
2976 When combined with the align-left or align-right modifier,
2977 it makes the block float.
2978
2979 =item C<|filter|> or C<|filter|filter|filter|>
2980
2981 A filter may be invoked to further format the text for this
2982 signature. If one or more filters are identified, the text
2983 will be processed first using the filters and then by
2984 Textile's own block formatting rules.
2985
2986 =back
2987
2988 =head2 Extended Blocks
2989
2990 Normally, a block ends with the first blank line encountered.
2991 However, there are situations where you may want a block to continue
2992 for multiple paragraphs of text. To cause a given block signature
2993 to stay active, use two periods in your signature instead of one.
2994 This will tell Textile to keep processing using that signature
2995 until it hits the next signature is found.
2996
2997 For example:
2998
2999 bq.. This is paragraph one of a block quote.
3000
3001 This is paragraph two of a block quote.
3002
3003 p. Now we're back to a regular paragraph.
3004
3005 You can apply this technique to any signature (although for
3006 some it doesn't make sense, like "h1" for example). This is
3007 especially useful for "bc" blocks where your code may
3008 have many blank lines scattered through it.
3009
3010 =head2 Escaping
3011
3012 Sometimes you want Textile to just get out of the way and
3013 let you put some regular HTML markup in your document. You
3014 can disable Textile formatting for a given block using the '=='
3015 escape mechanism:
3016
3017 p. Regular paragraph
3018
3019 ==
3020 Escaped portion -- will not be formatted
3021 by Textile at all
3022 ==
3023
3024 p. Back to normal.
3025
3026 You can also use this technique within a Textile block,
3027 temporarily disabling the inline formatting functions:
3028
3029 p. This is ==*a test*== of escaping.
3030
3031 =head2 Inline Formatting
3032
3033 Formatting within a block of text is covered by the "inline"
3034 formatting rules. These operators must be placed up against
3035 text/punctuation to be recognized. These include:
3036
3037 =over
3038
3039 =item E<42>C<strong>E<42>
3040
3041 Translates into E<lt>strongE<gt>strongE<lt>/strongE<gt>.
3042
3043 =item C<_emphasis_>
3044
3045 Translates into E<lt>emE<gt>emphasisE<lt>/emE<gt>.
3046
3047 =item E<42>E<42>C<bold>E<42>E<42>
3048
3049 Translates into E<lt>bE<gt>boldE<lt>/bE<gt>.
3050
3051 =item C<__italics__>
3052
3053 Translates into E<lt>iE<gt>italicsE<lt>/iE<gt>.
3054
3055 =item C<++bigger++>
3056
3057 Translates into E<lt>bigE<gt>biggerE<lt>/bigE<gt>.
3058
3059 =item C<--smaller-->
3060
3061 Translates into: E<lt>smallE<gt>smallerE<lt>/smallE<gt>.
3062
3063 =item C<-deleted text->
3064
3065 Translates into E<lt>delE<gt>deleted textE<lt>/delE<gt>.
3066
3067 =item C<+inserted text+>
3068
3069 Translates into E<lt>insE<gt>inserted textE<lt>/insE<gt>.
3070
3071 =item C<^superscript^>
3072
3073 Translates into E<lt>supE<gt>superscriptE<lt>/supE<gt>.
3074
3075 =item C<~subscript~>
3076
3077 Translates into E<lt>subE<gt>subscriptE<lt>/subE<gt>.
3078
3079 =item C<%span%>
3080
3081 Translates into E<lt>spanE<gt>spanE<lt>/spanE<gt>.
3082
3083 =item C<@code@>
3084
3085 Translates into E<lt>codeE<gt>codeE<lt>/codeE<gt>. Note
3086 that within a '@...@' section, E<lt> and E<gt> are
3087 translated into HTML entities automatically.
3088
3089 =back
3090
3091 Inline formatting operators accept the following modifiers:
3092
3093 =over
3094
3095 =item C<{style rule}>
3096
3097 A CSS style rule.
3098
3099 =item C<[ll]>
3100
3101 A language identifier (for a "lang" attribute).
3102
3103 =item C<(class)> or C<(#id)> or C<(class#id)>
3104
3105 For CSS class and id attributes.
3106
3107 =back
3108
3109 =head3 Examples
3110
3111 Textile is *way* cool.
3112
3113 Textile is *_way_* cool.
3114
3115 Now this won't work, because the formatting
3116 characters need whitespace before and after
3117 to be properly recognized.
3118
3119 Textile is way c*oo*l.
3120
3121 However, you can supply braces or brackets to
3122 further clarify that you want to format, so
3123 this would work:
3124
3125 Textile is way c[*oo*]l.
3126
3127 =head2 Footnotes
3128
3129 You can create footnotes like this:
3130
3131 And then he went on a long trip[1].
3132
3133 By specifying the brackets with a number inside, Textile will
3134 recognize that as a footnote marker. It will replace that with
3135 a construct like this:
3136
3137 And then he went on a long
3138 trip<sup class="footnote"><a href="#fn1">1</a></sup>
3139
3140 To supply the content of the footnote, place it at the end of your
3141 document using a "fn" block signature:
3142
3143 fn1. And there was much rejoicing.
3144
3145 Which creates a paragraph that looks like this:
3146
3147 <p class="footnote" id="fn1"><sup>1</sup> And there was
3148 much rejoicing.</p>
3149
3150 =head2 Links
3151
3152 Textile defines a shorthand for formatting hyperlinks.
3153 The format looks like this:
3154
3155 "Text to display":http://example.com
3156
3157 In addition to this, you can add 'title' text to your link:
3158
3159 "Text to display (Title text)":http://example.com
3160
3161 The URL portion of the link supports relative paths as well
3162 as other protocols like ftp, mailto, news, telnet, etc.
3163
3164 "E-mail me please":mailto:someone@example.com
3165
3166 You can also use single quotes instead of double-quotes if
3167 you prefer. As with the inline formatting rules, a hyperlink
3168 must be surrounded by whitespace to be recognized (an
3169 exception to this is common punctuation which can reside
3170 at the end of the URL). If you have to place a URL next to
3171 some other text, use the bracket or brace trick to do that:
3172
3173 You["gotta":http://example.com]seethis!
3174
3175 Textile supports an alternate way to compose links. You can
3176 optionally create a lookup list of links and refer to them
3177 separately. To do this, place one or more links in a block
3178 of it's own (it can be anywhere within your document):
3179
3180 [excom]http://example.com
3181 [exorg]http://example.org
3182
3183 For a list like this, the text in the square brackets is
3184 used to uniquely identify the link given. To refer to that
3185 link, you would specify it like this:
3186
3187 "Text to display":excom
3188
3189 Once you've defined your link lookup table, you can use
3190 the identifiers any number of times.
3191
3192 =head2 Images
3193
3194 Images are identified by the following pattern:
3195
3196 !/path/to/image!
3197
3198 Image attributes may also be specified:
3199
3200 !/path/to/image 10x20!
3201
3202 Which will render an image 10 pixels wide and 20 pixels high.
3203 Another way to indicate width and height:
3204
3205 !/path/to/image 10w 20h!
3206
3207 You may also redimension the image using a percentage.
3208
3209 !/path/to/image 20%x40%!
3210
3211 Which will render the image at 20% of it's regular width
3212 and 40% of it's regular height.
3213
3214 Or specify one percentage to resize proprotionately:
3215
3216 !/path/to/image 20%!
3217
3218 Alt text can be given as well:
3219
3220 !/path/to/image (Alt text)!
3221
3222 The path of the image may refer to a locally hosted image or
3223 can be a full URL.
3224
3225 You can also use the following modifiers after the opening '!'
3226 character:
3227
3228 =over
3229
3230 =item C<E<lt>>
3231
3232 Align the image to the left (causes the image to float if
3233 CSS options are enabled).
3234
3235 =item C<E<gt>>
3236
3237 Align the image to the right (causes the image to float if
3238 CSS options are enabled).
3239
3240 =item C<-> (dash)
3241
3242 Aligns the image to the middle.
3243
3244 =item C<^>
3245
3246 Aligns the image to the top.
3247
3248 =item C<~> (tilde)
3249
3250 Aligns the image to the bottom.
3251
3252 =item C<{style rule}>
3253
3254 Applies a CSS style rule to the image.
3255
3256 =item C<(class)> or C<(#id)> or C<(class#id)>
3257
3258 Applies a CSS class and/or id to the image.
3259
3260 =item C<(> (one or more)
3261
3262 Pads 1em on the left for each '(' character.
3263
3264 =item C<)> (one or more)
3265
3266 Pads 1em on the right for each ')' character.
3267
3268 =back
3269
3270 =head2 Character Replacements
3271
3272 A few simple, common symbols are automatically replaced:
3273
3274 (c)
3275 (r)
3276 (tm)
3277
3278 In addition to these, there are a whole set of character
3279 macros that are defined by default. All macros are enclosed
3280 in curly braces. These include:
3281
3282 {c|} or {|c} cent sign
3283 {L-} or {-L} pound sign
3284 {Y=} or {=Y} yen sign
3285
3286 Many of these macros can be guessed. For example:
3287
3288 {A'} or {'A}
3289 {a"} or {"a}
3290 {1/4}
3291 {*}
3292 {:)}
3293 {:(}
3294
3295 =head2 Lists
3296
3297 Textile also supports ordered and unordered lists.
3298 You simply place an asterisk or pound sign, followed
3299 with a space at the start of your lines.
3300
3301 Simple lists:
3302
3303 * one
3304 * two
3305 * three
3306
3307 Multi-level lists:
3308
3309 * one
3310 ** one A
3311 ** one B
3312 *** one B1
3313 * two
3314 ** two A
3315 ** two B
3316 * three
3317
3318 Ordered lists:
3319
3320 # one
3321 # two
3322 # three
3323
3324 Styling lists:
3325
3326 (class#id)* one
3327 * two
3328 * three
3329
3330 The above sets the class and id attributes for the E<lt>ulE<gt>
3331 tag.
3332
3333 *(class#id) one
3334 * two
3335 * three
3336
3337 The above sets the class and id attributes for the first E<lt>liE<gt>
3338 tag.
3339
3340 Definition lists:
3341
3342 dl. textile:a cloth, especially one manufactured by weaving
3343 or knitting; a fabric
3344 format:the arrangement of data for storage or display.
3345
3346 Note that there is no space between the term and definition. The
3347 term must be at the start of the line (or following the "dl"
3348 signature as shown above).
3349
3350 =head2 Tables
3351
3352 Textile supports tables. Tables must be in their own block and
3353 must have pipe characters delimiting the columns. An optional
3354 block signature of "table" may be used, usually for applying
3355 style, class, id or other options to the table element itself.
3356
3357 From the simple:
3358
3359 |a|b|c|
3360 |1|2|3|
3361
3362 To the complex:
3363
3364 table(fig). {color:red}_|Top|Row|
3365 {color:blue}|/2. Second|Row|
3366 |_{color:green}. Last|
3367
3368 Modifiers can be specified for the table signature itself,
3369 for a table row (prior to the first 'E<verbar>' character) and
3370 for any cell (following the 'E<verbar>' for that cell). Note that for
3371 cells, a period followed with a space must be placed after
3372 any modifiers to distinguish the modifier from the cell content.
3373
3374 Modifiers allowed are:
3375
3376 =over
3377
3378 =item C<{style rule}>
3379
3380 A CSS style rule.
3381
3382 =item C<(class)> or C<(#id)> or C<(class#id)>
3383
3384 A CSS class and/or id attribute.
3385
3386 =item C<(> (one or more)
3387
3388 Adds 1em of padding to the left for each '(' character.
3389
3390 =item C<)> (one or more)
3391
3392 Adds 1em of padding to the right for each ')' character.
3393
3394 =item C<E<lt>>
3395
3396 Aligns to the left (floats to left for tables if combined with the
3397 ')' modifier).
3398
3399 =item C<E<gt>>
3400
3401 Aligns to the right (floats to right for tables if combined with
3402 the '(' modifier).
3403
3404 =item C<=>
3405
3406 Aligns to center (sets left, right margins to 'auto' for tables).
3407
3408 =item C<E<lt>E<gt>>
3409
3410 For cells only. Justifies text.
3411
3412 =item C<^>
3413
3414 For rows and cells only. Aligns to the top.
3415
3416 =item C<~> (tilde)
3417
3418 For rows and cells only. Aligns to the bottom.
3419
3420 =item C<_> (underscore)
3421
3422 Can be applied to a table row or cell to indicate a header
3423 row or cell.
3424
3425 =item C<\2> or C<\3> or C<\4>, etc.
3426
3427 Used within cells to indicate a colspan of 2, 3, 4, etc. columns.
3428 When you see "\", think "push forward".
3429
3430 =item C</2> or C</3> or C</4>, etc.
3431
3432 Used within cells to indicate a rowspan or 2, 3, 4, etc. rows.
3433 When you see "/", think "push downward".
3434
3435 =back
3436
3437 When a cell is identified as a header cell and an alignment
3438 is specified, that becomes the default alignment for
3439 cells below it. You can always override this behavior by
3440 specifying an alignment for one of the lower cells.
3441
3442 =head2 CSS Notes
3443
3444 When CSS is enabled (and it is by default), CSS class names
3445 are automatically applied in certain situations.
3446
3447 =over
3448
3449 =item Aligning a block or span or other element to
3450 left, right, etc.
3451
3452 "left" for left justified, "right" for right justified,
3453 "center" for centered text, "justify" for full-justified
3454 text.
3455
3456 =item Aligning an image to the top or bottom
3457
3458 "top" for top alignment, "bottom" for bottom alignment,
3459 "middle" for middle alignment.
3460
3461 =item Footnotes
3462
3463 "footnote" is applied to the paragraph tag for the
3464 footnote text itself. An id of "fn" plus the footnote
3465 number is placed on the paragraph for the footnote as
3466 well. For the footnote superscript tag, a class of
3467 "footnote" is used.
3468
3469 =item Capped text
3470
3471 For a series of characters that are uppercased, a
3472 span is placed around them with a class of "caps".
3473
3474 =back
3475
3476 =head2 Miscellaneous
3477
3478 Textile tries to do it's very best to ensure proper XHTML
3479 syntax. It will even attempt to fix errors you may introduce
3480 writing in HTML yourself. Unescaped '&' characters within
3481 URLs will be properly escaped. Singlet tags such as br, img
3482 and hr are checked for the '/' terminator (and it's added
3483 if necessary). The best way to make sure you produce valid
3484 XHTML with Textile is to not use any HTML markup at all--
3485 use the Textile syntax and let it produce the markup for you.
3486
3487 =head1 LICENSE
3488
3489 This software is licensed under the same terms as Perl itself.
3490 Please see L<ARTISTIC> for license details.
3491
3492 =head1 AUTHOR & COPYRIGHT
3493
3494 Text::Textile was written by Brad Choate, brad@bradchoate.com.
3495 It is an adaptation of Textile, developed by Dean Allen of Textism.com.
3496
3497 =cut
0 #!/usr/bin/perl -w
1
2 use strict;
3 use warnings;
4
5 use Test::More tests=>1;
6
7 use_ok('Text::Textile');
0 use Test::More tests=>1;
1 use Text::Textile qw(textile);
2
3 my $source = "paragraph1\n\nparagraph2\n\n";
4 my $dest = textile($source);
5 my $expected = "<p>paragraph1</p>\n\n<p>paragraph2</p>";
6
7 is($dest, $expected);
0 use warnings;
1 use strict;
2 use Test::More tests=>1;
3 use Text::Textile qw(textile);
4
5 my $source = '"title":http://www.example.com';
6 my $dest = textile($source);
7 my $expected = '<p><a href="http://www.example.com">title</a></p>';
8
9 is($dest, $expected);
0 use warnings;
1 use strict;
2 use Test::More tests=>2;
3 use Text::Textile qw(textile);
4
5 my $source = "* list1\n* list2\n* list3\n";
6 my $dest = textile($source);
7 $dest =~ s/(^\s+|\s+$)//gs;
8 my $expected = "<ul>\n<li>list1</li>\n<li>list2</li>\n<li>list3</li>\n</ul>";
9
10 is($dest, $expected);
11
12 $source = "# list1\n# list2\n# list3\n";
13 $dest = textile($source);
14 $dest =~ s/(^\s+|\s+$)//gs;
15 $expected = "<ol>\n<li>list1</li>\n<li>list2</li>\n<li>list3</li>\n</ol>";
16
17 is($dest, $expected);
0 use warnings;
1 use strict;
2 use Test::More tests=>1;
3 use Text::Textile qw(textile);
4
5 my $source = <<SOURCE;
6 start paragraph
7
8 another paragraph
9
10 * list of things with "urls":http://www.jerakeen.org in
11 * more things in the list
12
13 a http://bare.url.here. and an email\@address.com
14
15 SOURCE
16
17 my $dest = textile($source);
18 $dest =~ s/(^\s+|\s+$)//g;
19
20 my $expected = <<EXPECTED;
21 <p>start paragraph</p>
22
23 <p>another paragraph</p>
24
25 <ul>
26 <li>list of things with <a href="http://www.jerakeen.org">urls</a> in</li>
27 <li>more things in the list</li>
28 </ul>
29
30 <p>a http://bare.url.here. and an email\@address.com</p>
31 EXPECTED
32 $expected =~ s/(^\s+|\s+$)//g;
33
34 is($dest, $expected);
35