File Coverage

blib/lib/HTML/Obj2HTML.pm
Criterion Covered Total %
statement 86 429 20.0
branch 51 268 19.0
condition 7 74 9.4
subroutine 15 41 36.5
pod 0 29 0.0
total 159 841 18.9


line stmt bran cond sub pod time code
1             package HTML::Obj2HTML;
2              
3             $HTML::Obj2HTML::VERSION = '0.13';
4              
5 1     1   609 use strict;
  1         2  
  1         29  
6 1     1   4 use warnings;
  1         2  
  1         23  
7              
8 1     1   4 use Carp;
  1         2  
  1         97  
9 1     1   492 use HTML::Entities;
  1         7451  
  1         79  
10 1     1   653 use Text::Markdown;
  1         38723  
  1         56  
11 1     1   490 use Text::Pluralize;
  1         643  
  1         56  
12 1     1   593 use Locale::Currency::Format;
  1         4696  
  1         106  
13 1     1   569 use List::MoreUtils qw(uniq);
  1         13622  
  1         6  
14 1     1   1505 use Module::Pluggable require => 1;
  1         10952  
  1         16  
15              
16             use constant {
17 1         5107 END_TAG_OPTIONAL => 0x0,
18             END_TAG_REQUIRED => 0x1,
19             END_TAG_FORBIDDEN => 0x2,
20             OBSOLETE => 0x4
21 1     1   101 };
  1         3  
22              
23             # storage is a sort of top-level stash for an object. It doesn't have to be used
24             # you can get away with building your own object variable and passing it to "gen"
25             my $storage = [];
26             # Opts are simple storage that could be referred to in extensions (not typically
27             # in the base class). A good example is "readonly" (true/false)
28             my %opt;
29             # extensions are stored here
30             my %extensions = ();
31             # snippets are stored here
32             my $snippets = {};
33             # A dictionary of substitutions are stored here and can be referenced in _content_
34             my %dictionary;
35              
36             my $file_ext = ".po";
37              
38             my %dofiles;
39              
40             # Whether or not to close empty tags with /
41             my $mode = "XHTML";
42             # Whether or not to output a warning when something that doesn't look like a valid
43             # html 5 tag is used
44             my $warn_on_unknown_tag = 1;
45             # Whether or not to use HTML::FromArrayref format ("elementname {attributes} content" triplets)
46             my $html_fromarrayref_format = 0;
47             # Default currency to use
48             my $default_currency = "GBP";
49              
50             our $db;
51              
52             # Load up the extensions
53             plugins();
54              
55             sub import {
56 1     1   10 my @extra = ();
57 1         2 my $loadcomponents = 0;
58 1         2 my $ext;
59 1         5 while (my $opt = shift) {
60 1 50       11 if ($opt eq "components") {
    50          
    50          
    50          
    50          
    50          
61 0         0 my $arg = shift;
62 0         0 $loadcomponents = $arg;
63             }
64             elsif ($opt eq "default_currency") {
65 0         0 $default_currency = shift;
66             }
67             elsif ($opt eq "mode") {
68 0         0 $mode = shift;
69             }
70             elsif ($opt eq "warn_on_unknown_tag") {
71 0         0 $warn_on_unknown_tag = shift;
72             }
73             elsif ($opt eq "html_fromarrayref_format") {
74 0         0 $html_fromarrayref_format = shift;
75             }
76             elsif ($opt eq "file_extension") {
77 0         0 $file_ext = shift;
78 0         0 $file_ext =~ s/[\/\n\r]//g;
79             }
80             else {
81 1         4 push(@extra, $opt);
82             }
83             }
84 1 50       35 if ($loadcomponents) {
85 0         0 foreach my $file (split("\n", `find $loadcomponents -name "*${file_ext}"`)) {
86 0         0 chomp($file);
87 0         0 my $l = $file;
88 0         0 $l =~ s/$loadcomponents\///;
89 0         0 $l =~ s/${file_ext}$//;
90 0         0 $l =~ s/\//::/g;
91             #print STDERR "HTML::Obj2HTML registering component $l\n";
92             HTML::Obj2HTML::register_extension($l, {
93             tag => "",
94             before => sub {
95 0     0   0 my $o = shift;
96 0 0       0 if (ref $o eq "HASH") {
97 0         0 return HTML::Obj2HTML::fetch($file, $o);
98             } else {
99 0         0 return HTML::Obj2HTML::fetch($file, { _ => $o });
100             }
101             }
102 0         0 });
103             }
104             }
105             }
106              
107             my %tags = (
108             a => END_TAG_REQUIRED,
109             abbr => END_TAG_REQUIRED,
110             acronym => END_TAG_REQUIRED | OBSOLETE,
111             address => END_TAG_REQUIRED,
112             applet => END_TAG_REQUIRED | OBSOLETE,
113             area => END_TAG_FORBIDDEN,
114             article => END_TAG_REQUIRED,
115             aside => END_TAG_REQUIRED,
116             audio => END_TAG_REQUIRED,
117             b => END_TAG_REQUIRED,
118             base => END_TAG_FORBIDDEN,
119             basefont => END_TAG_FORBIDDEN | OBSOLETE,
120             bdi => END_TAG_REQUIRED,
121             bdo => END_TAG_REQUIRED,
122             big => END_TAG_REQUIRED | OBSOLETE,
123             blockquote => END_TAG_REQUIRED,
124             body => END_TAG_OPTIONAL,
125             br => END_TAG_FORBIDDEN,
126             button => END_TAG_REQUIRED,
127             canvas => END_TAG_REQUIRED,
128             caption => END_TAG_REQUIRED,
129             center => END_TAG_REQUIRED,
130             cite => END_TAG_REQUIRED,
131             code => END_TAG_REQUIRED,
132             col => END_TAG_FORBIDDEN,
133             colgroup => END_TAG_REQUIRED,
134             data => END_TAG_REQUIRED,
135             datalist => END_TAG_REQUIRED,
136             dd => END_TAG_OPTIONAL,
137             del => END_TAG_REQUIRED,
138             details => END_TAG_REQUIRED,
139             dfn => END_TAG_REQUIRED,
140             dialog => END_TAG_REQUIRED,
141             dir => END_TAG_REQUIRED | OBSOLETE,
142             div => END_TAG_REQUIRED,
143             dl => END_TAG_REQUIRED,
144             dt => END_TAG_OPTIONAL,
145             em => END_TAG_REQUIRED,
146             embed => END_TAG_FORBIDDEN,
147             fielset => END_TAG_REQUIRED,
148             figcaption => END_TAG_REQUIRED,
149             figure => END_TAG_REQUIRED,
150             font => END_TAG_REQUIRED | OBSOLETE,
151             footer => END_TAG_REQUIRED,
152             form => END_TAG_REQUIRED,
153             frame => END_TAG_FORBIDDEN | OBSOLETE,
154             frameset => END_TAG_REQUIRED | OBSOLETE,
155             head => END_TAG_OPTIONAL,
156             header => END_TAG_REQUIRED,
157             hgroup => END_TAG_REQUIRED,
158             h1 => END_TAG_REQUIRED,
159             h2 => END_TAG_REQUIRED,
160             h3 => END_TAG_REQUIRED,
161             h4 => END_TAG_REQUIRED,
162             h5 => END_TAG_REQUIRED,
163             h6 => END_TAG_REQUIRED,
164             hr => END_TAG_FORBIDDEN,
165             html => END_TAG_OPTIONAL,
166             i => END_TAG_REQUIRED,
167             iframe => END_TAG_REQUIRED,
168             img => END_TAG_FORBIDDEN,
169             input => END_TAG_FORBIDDEN,
170             ins => END_TAG_REQUIRED,
171             kbd => END_TAG_REQUIRED,
172             keygen => END_TAG_FORBIDDEN,
173             label => END_TAG_REQUIRED,
174             legend => END_TAG_REQUIRED,
175             li => END_TAG_REQUIRED,
176             link => END_TAG_FORBIDDEN,
177             main => END_TAG_REQUIRED,
178             map => END_TAG_REQUIRED,
179             mark => END_TAG_REQUIRED,
180             menu => END_TAG_REQUIRED,
181             menuitem => END_TAG_FORBIDDEN,
182             meta => END_TAG_FORBIDDEN,
183             meter => END_TAG_REQUIRED,
184             nav => END_TAG_REQUIRED,
185             noframes => END_TAG_REQUIRED | OBSOLETE,
186             noscript => END_TAG_REQUIRED,
187             object => END_TAG_REQUIRED,
188             ol => END_TAG_REQUIRED,
189             optgroup => END_TAG_REQUIRED,
190             option => END_TAG_OPTIONAL,
191             output => END_TAG_REQUIRED,
192             p => END_TAG_OPTIONAL,
193             param => END_TAG_FORBIDDEN,
194             picture => END_TAG_REQUIRED,
195             pre => END_TAG_REQUIRED,
196             progress => END_TAG_REQUIRED,
197             q => END_TAG_REQUIRED,
198             rp => END_TAG_REQUIRED,
199             rt => END_TAG_REQUIRED,
200             ruby => END_TAG_REQUIRED,
201             s => END_TAG_REQUIRED,
202             samp => END_TAG_REQUIRED,
203             script => END_TAG_REQUIRED,
204             section => END_TAG_REQUIRED,
205             select => END_TAG_REQUIRED,
206             small => END_TAG_REQUIRED,
207             source => END_TAG_FORBIDDEN,
208             span => END_TAG_REQUIRED,
209             strike => END_TAG_REQUIRED | OBSOLETE,
210             strong => END_TAG_REQUIRED,
211             style => END_TAG_REQUIRED,
212             sub => END_TAG_REQUIRED,
213             summary => END_TAG_REQUIRED,
214             sup => END_TAG_REQUIRED,
215             svp => END_TAG_REQUIRED,
216             table => END_TAG_REQUIRED,
217             tbody => END_TAG_REQUIRED,
218             td => END_TAG_REQUIRED,
219             template => END_TAG_REQUIRED,
220             textarea => END_TAG_REQUIRED,
221             tfoot => END_TAG_REQUIRED,
222             th => END_TAG_OPTIONAL,
223             thead => END_TAG_REQUIRED,
224             time => END_TAG_REQUIRED,
225             title => END_TAG_REQUIRED,
226             tr => END_TAG_OPTIONAL,
227             track => END_TAG_FORBIDDEN,
228             tt => END_TAG_REQUIRED | OBSOLETE,
229             u => END_TAG_REQUIRED,
230             ul => END_TAG_REQUIRED,
231             var => END_TAG_REQUIRED,
232             video => END_TAG_REQUIRED,
233             wbr => END_TAG_FORBIDDEN
234             );
235              
236             sub flush {
237 0     0 0 0 %opt = ();
238 0         0 %dictionary = ();
239 0         0 $snippets = {};
240             }
241             sub set_opt {
242 0     0 0 0 my $key = shift;
243 0         0 my $val = shift;
244 0         0 $opt{$key} = $val;
245             }
246             sub get_opt {
247 0     0 0 0 my $key = shift;
248 0         0 return $opt{$key};
249             }
250              
251             sub set_dbh {
252 0     0 0 0 $db = shift;
253             }
254              
255             sub set_dictionary {
256 0     0 0 0 my $hashref = shift;
257 0         0 %dictionary = %{$hashref};
  0         0  
258             }
259             sub add_dictionary_items {
260 0     0 0 0 my $hashref = shift;
261 0         0 %dictionary = (%dictionary, %{$hashref});
  0         0  
262             }
263              
264             sub set_snippet {
265 0     0 0 0 my $name = shift;
266 0         0 my $obj = shift;
267 0 0       0 if (!ref $obj) {
268 0         0 my $args = shift;
269 0         0 $obj = fetch($obj, $args);
270             }
271 0         0 $snippets->{$name} = $obj;
272             }
273             sub get_snippet {
274 0     0 0 0 my $name = shift;
275 0         0 return $snippets->{$name};
276             }
277             sub append_snippet {
278 0     0 0 0 my $name = shift;
279 0         0 my $obj = shift;
280 0 0       0 if (!defined $snippets->{$name}) {
    0          
281 0         0 $snippets->{$name} = [];
282             } elsif (ref $snippets->{$name} ne "ARRAY") {
283 0         0 return;
284             }
285 0 0       0 if (!ref $obj) {
286 0         0 my $args = shift;
287 0         0 $obj = fetch($obj, $args);
288             }
289 0         0 push(@{$snippets->{$name}}, $obj);
  0         0  
290             }
291              
292              
293              
294              
295             sub do {
296 0     0 0 0 HTML::Obj2HTML::print($storage);
297             }
298              
299             sub init {
300 0     0 0 0 $storage = shift;
301             }
302              
303             sub sort {
304 0     0 0 0 my $parentblock = shift;
305 0         0 my $sortsub = shift;
306 0         0 my $arr = shift;
307 0         0 my @ret = ();
308              
309 0         0 foreach my $c (sort { $sortsub->($a,$b) } @$arr) {
  0         0  
310 0         0 push(@ret, $parentblock, $c);
311             }
312 0         0 return \@ret;
313             }
314              
315             sub iterate {
316 0     0 0 0 my $parentblock = shift;
317 0         0 my $arr = shift;
318 0   0     0 my $collapsearrayrefs = shift || 0;
319 0         0 my @ret = ();
320              
321 0         0 foreach my $c (@$arr) {
322 0 0 0     0 if (ref($c) eq "ARRAY" && $collapsearrayrefs) {
    0          
323 0         0 my $itr = iterate($parentblock, $c);
324 0         0 push(@ret, @{$itr});
  0         0  
325             } elsif (defined $c) {
326 0         0 push(@ret, $parentblock, $c);
327             }
328             }
329 0         0 return \@ret;
330             }
331              
332             sub fetchraw {
333 0     0 0 0 my $f = shift;
334             # If we want an absolute path, use document root
335 0 0       0 if ($f =~ /\//) {
336 0         0 $f = $ENV{DOCUMENT_ROOT}.$f;
337             }
338             # And don't allow back-tracking through the file system!
339 0         0 $f =~ s|\/[\.\/]+|\/|;
340 0         0 my $rawfile;
341 0 0       0 if (-e $f) {
342 0         0 local($/);
343 0         0 open(RAWFILE, $f);
344 0         0 $rawfile = ;
345 0         0 close(RAWFILE);
346             }
347 0         0 return $rawfile;
348             }
349             sub fetch {
350 0     0 0 0 my $f = shift;
351 0         0 our $args = shift;
352 0         0 my $fetch;
353 0 0       0 if ($f !~ /^[\.\/]/) { $f = "./".$f; }
  0         0  
354 0 0       0 if (-e $f) {
355 0         0 $fetch = do($f);
356 0 0       0 if (!$fetch) {
357 0 0       0 if ($@) {
358 0         0 carp "Do failed for $f at error: $@\n";
359             }
360 0 0       0 if ($!) {
361 0         0 carp "Do failed for $f bang error: $!\n";
362             }
363             }
364 0 0       0 if (ref $fetch eq "CODE") {
365 0         0 $fetch = $fetch->($args);
366             }
367              
368             } else {
369 0         0 my $pwd = `pwd`;
370 0         0 chomp($pwd);
371 0         0 carp "Couldn't find $f ($pwd)\n";
372 0         0 return [];
373             }
374 0         0 return $fetch;
375             }
376             sub display {
377 0     0 0 0 my $f = shift;
378 0         0 my $args = shift;
379 0         0 my $ret = fetch($f, $args);
380 0         0 print gen($ret);
381             }
382             sub push {
383 0     0 0 0 my $arr = shift;
384 0         0 my $f = shift;
385 0         0 my $arg = shift;
386 0         0 my $ret = fetch($f,$arg);
387 0         0 push(@{$arr}, @{$ret});
  0         0  
  0         0  
388             }
389             sub append {
390 0     0 0 0 my $insertpoint = shift;
391 0         0 my $inserto = shift;
392 0         0 my $args = shift;
393 0 0 0     0 if (!ref $inserto && $inserto =~ /staticfile:(.*)/) {
    0 0        
394 0         0 $inserto = HTML::Obj2HTML::fetchraw($1);
395             } elsif (!ref $inserto && $inserto =~ /file:(.*)/) {
396 0         0 $inserto = fetch($1, $args);
397             }
398 0         0 my $o = find($storage, $insertpoint);
399 0         0 foreach my $e (@{$o}) {
  0         0  
400             # convert to common format
401 0 0       0 if (!ref $e->[1]) {
    0          
402 0         0 $e->[1] = { _ => [ _ => $e->[1] ] };
403             } elsif (ref $e->[1] eq "ARRAY") {
404 0         0 $e->[1] = { _ => $e->[1] };
405             }
406 0         0 CORE::push(@{$e->[1]->{_}}, @{$inserto});
  0         0  
  0         0  
407             }
408             }
409             sub prepend {
410 0     0 0 0 my $insertpoint = shift;
411 0         0 my $inserto = shift;
412 0         0 my $args = shift;
413 0 0 0     0 if (!ref $inserto && $inserto =~ /staticfile:(.*)/) {
    0 0        
414 0         0 $inserto = HTML::Obj2HTML::fetchraw($1);
415             } elsif (!ref $inserto && $inserto =~ /file:(.*)/) {
416 0         0 $inserto = fetch($1, $args);
417             }
418 0         0 my $o = find($storage, $insertpoint);
419 0         0 foreach my $e (@{$o}) {
  0         0  
420             # convert to common format
421 0 0       0 if (!ref $e->[1]) {
    0          
422 0         0 $e->[1] = { _ => [ _ => $e->[1] ] };
423             } elsif (ref $e->[1] eq "ARRAY") {
424 0         0 $e->[1] = { _ => $e->[1] };
425             }
426 0         0 unshift(@{$e->[1]->{_}}, @{$inserto});
  0         0  
  0         0  
427             }
428             }
429              
430             sub find {
431 0     0 0 0 my $o = shift;
432 0         0 my $query = shift;
433 0   0     0 my $ret = shift || [];
434              
435 0         0 my @tags = @{$o};
  0         0  
436 0         0 while (@tags) {
437 0         0 my $tag = shift(@tags);
438 0         0 my $attr = shift(@tags);
439              
440 0 0       0 if (ref $attr eq "ARRAY") {
    0          
441 0         0 find($attr, $query, $ret);
442             } elsif (ref $attr eq "HASH") {
443 0         0 my %attrs = %{$attr};
  0         0  
444 0         0 my $content;
445 0 0       0 if ($attrs{_}) {
446 0         0 find($attrs{_}, $query, $ret);
447             }
448 0 0 0     0 if ($query =~ /\#(.*)/ && $attrs{id} eq $1) {
    0 0        
449 0         0 CORE::push(@{$ret}, [$tag, $attr]);
  0         0  
450             } elsif ($query =~ /^([^\#\.]\S*)/ && $tag eq $1) {
451 0         0 CORE::push(@{$ret}, [$tag, $attr]);
  0         0  
452             }
453             }
454             }
455 0         0 return $ret;
456             }
457              
458             sub gen {
459 4     4 0 101 my $o = shift;
460 4         8 my $ret = "";
461              
462 4 50       10 if (!defined $o) { return ""; }
  0         0  
463 4 50       11 if (!ref $o) {
464 0         0 $o = web_escape($o);
465 0         0 return $o;
466             }
467 4 50       16 if (ref $o eq "HASH") {
468 0         0 carp "HTML::Obj2HTML::gen called with a hash reference!";
469 0         0 return "";
470             }
471 4 50       10 if (ref $o eq "CODE") {
472 0         0 eval {
473 0         0 $ret = HTML::Obj2HTML::gen($o->());
474             };
475 0 0       0 if ($@) { carp "Error parsing HTML::Obj2HTML objects when calling code ref: $@\n"; }
  0         0  
476 0         0 return $ret;
477             }
478 4 50       10 if (ref $o ne "ARRAY") {
479 0         0 return "";
480             }
481              
482 4         6 my @tags = @{$o};
  4         10  
483 4         12 while (@tags) {
484 6         11 my $tag = shift(@tags);
485 6 50       14 if (!defined $tag) {
486 0         0 next;
487             }
488 6 50       15 if (ref $tag eq "ARRAY") {
489 0         0 $ret .= HTML::Obj2HTML::gen($tag);
490 0         0 next;
491             }
492 6 50       13 if (ref $tag eq "CODE") {
493 0         0 eval {
494 0         0 $ret .= HTML::Obj2HTML::gen($tag->());
495             };
496 0 0       0 if ($@) { carp "Error parsing HTML::Obj2HTML objects when calling code ref: $@\n"; }
  0         0  
497 0         0 next;
498             }
499 6 50       13 if ($tag =~ /_(.+)/) {
500 0         0 $ret .= HTML::Obj2HTML::gen(get_snippet($1));
501 0         0 next;
502             }
503             # If the tag has a space it's not a valid tag, so output it as content instead
504 6 50       17 if ($tag =~ /\s/) {
505 0         0 $ret .= $tag;
506 0         0 next;
507             }
508              
509 6         8 my $attr = shift(@tags);
510 6 50       13 if ($html_fromarrayref_format) {
511             # Make this module behave more like HTML::FromArrayref, where you have elementname, { attributes }, content
512             # This should be considered for backward compatibility; The find routine would struggle with this...
513 0 0 0     0 if (ref $attr eq "HASH" && ($tags{$tag} & END_TAG_FORBIDDEN) == 0) {
514 0         0 $attr->{"_"} = shift(@tags);
515             }
516             }
517             # Typically linking to another file will return an arrayref, but could equally return a hashref to also set the
518             # attributes of the element calling it
519 6 100 66     23 if ($attr && !ref $attr) {
520 3 50       15 if ($attr =~ /staticfile:(.+)/) {
    50          
    50          
521 0         0 $attr = HTML::Obj2HTML::fetchraw($1);
522             } elsif ($attr =~ /file:(.+)/) {
523 0         0 $attr = HTML::Obj2HTML::fetch($1);
524             } elsif ($attr =~ /raw:(.+)/) {
525 0         0 $attr = HTML::Obj2HTML::fetchraw($1);
526             }
527             }
528              
529             # Run the current tag through extentions
530 6         10 my $origtag = $tag;
531 6 50       16 if (defined $extensions{$origtag}) {
532 0 0 0     0 if (defined $extensions{$origtag}->{scalarattr} && !ref $attr) { $attr = { $extensions{$origtag}->{scalarattr} => $attr }; }
  0         0  
533              
534 0 0       0 if (defined $extensions{$origtag}->{before}) {
535 0         0 my $o = $extensions{$origtag}->{before}($attr);
536 0 0       0 if (ref $o eq "ARRAY") {
    0          
537 0         0 $ret .= HTML::Obj2HTML::gen($o);
538             } elsif (ref $o eq "") {
539 0         0 $ret .= $o;
540             }
541             }
542              
543 0 0       0 if (defined $extensions{$origtag}->{tag}) {
544 0         0 $tag = $extensions{$origtag}->{tag};
545             }
546 0 0       0 if (defined $extensions{$origtag}->{attr}) {
547 0 0       0 if (ref $attr ne "HASH") {
548 0         0 $attr = { _ => $attr };
549             }
550 0         0 foreach my $k (keys %{$extensions{$origtag}->{attr}}) {
  0         0  
551 0 0       0 if (defined $attr->{$k}) {
552 0         0 $attr->{$k} = $extensions{$origtag}->{attr}->{$k}." ".$attr->{$k};
553 0 0       0 if ($k eq "class") {
554 0         0 $attr->{$k} = join(" ", uniq(split(/\s+/, $attr->{$k})));
555             }
556             } else {
557 0         0 $attr->{$k} = $extensions{$origtag}->{attr}->{$k};
558             }
559             }
560             }
561              
562 0 0       0 if (defined $extensions{$origtag}->{replace}) {
563 0         0 my $o = HTML::Obj2HTML::gen($extensions{$origtag}->{replace}($attr));
564 0 0       0 if (ref $o eq "HASH") {
    0          
565 0         0 $ret .= HTML::Obj2HTML::gen($o);
566             } elsif (ref $o eq "") {
567 0         0 $ret .= $o;
568             }
569 0         0 $tag = "";
570             }
571             }
572              
573             # Non-HTML functions
574 6 50 33     55 if ($tag eq "_") {
    50 33        
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    50          
    100          
    50          
    50          
575 0 0       0 if (ref $attr) {
576 0         0 carp("HTML::Obj2HTML: _ element called, but attr wasn't a scalar.");
577             } else {
578 0         0 $ret .= web_escape($attr);
579             }
580              
581             } elsif ($tag eq "raw") {
582 0 0       0 if (ref $attr) {
583 0         0 carp("HTML::Obj2HTML: raw element called, but attr wasn't a scalar.");
584             } else {
585 0         0 $ret .= "$attr";
586             }
587              
588             } elsif ($tag eq "if") {
589 0 0       0 if (ref $attr eq "HASH") {
    0          
590 0 0 0     0 if ($attr->{cond} && $attr->{true}) {
    0 0        
591 0         0 $ret .= HTML::Obj2HTML::gen($attr->{true});
592             } elsif (!$attr->{cond} && $attr->{false}) {
593 0         0 $ret .= HTML::Obj2HTML::gen($attr->{false});
594             }
595             } elsif (ref $attr eq "ARRAY") {
596 0         0 for (my $i = 0; $i<$#{$attr}; $i+=2) {
  0         0  
597 0 0       0 if ($attr->[$i]) {
598 0         0 $ret .= HTML::Obj2HTML::gen($attr->[$i+1]);
599 0         0 last;
600             }
601             }
602             } else {
603 0         0 carp("HTML::Obj2HTML: if element called, but attr wasn't a hash ref or array ref.");
604             }
605             } elsif ($tag eq "switch") {
606 0 0       0 if (ref $attr eq "HASH") {
607 0 0       0 if (defined $attr->{$attr->{val}}) {
    0          
    0          
608 0         0 $ret .= HTML::Obj2HTML::gen($attr->{$attr->{val}});
609             } elsif (defined $attr->{"_default"}) {
610 0         0 $ret .= HTML::Obj2HTML::gen($attr->{"_default"});
611             } elsif (defined $attr->{"_"}) {
612 0         0 $ret .= HTML::Obj2HTML::gen($attr->{"_"});
613             }
614             } else {
615 0         0 carp("HTML::Obj2HTML: switch element called, but attr wasn't a hash ref.");
616             }
617              
618             } elsif ($tag eq "md") {
619 0 0       0 if (ref $attr) {
620 0         0 carp("HTML::Obj2HTML: md element called, but attr wasn't a scalar.");
621             } else {
622 0         0 $ret .= markdown($attr);
623             }
624              
625             } elsif ($tag eq "plain") {
626 0 0       0 if (ref $attr) {
627 0         0 carp("HTML::Obj2HTML: plain element called, but attr wasn't a scalar.");
628             } else {
629 0         0 $ret .= plain($attr);
630             }
631              
632             } elsif ($tag eq "currency") {
633 0 0       0 if (ref $attr eq "HASH") {
    0          
634 0   0     0 $ret .= web_escape(currency_format($attr->{currency} || $default_currency, $attr->{"_"}, FMT_SYMBOL));
635             } elsif (!ref $attr) {
636 0         0 $ret .= web_escape(currency_format($default_currency, $attr, FMT_SYMBOL));
637             } else {
638 0         0 carp("HTML::Obj2HTML: currency called, but attr wasn't a hash ref or plain scalar.");
639             }
640              
641             } elsif ($tag eq "pluralize") {
642 0 0       0 if (ref $attr eq "ARRAY") {
643 0         0 $ret .= pluralize($attr->[0], $attr->[1]);
644             } else {
645 0         0 carp("HTML::Obj2HTML: pluralize called, but attr wasn't a array ref");
646             }
647              
648             } elsif ($tag eq "include") {
649 0         0 $ret .= HTML::Obj2HTML::gen(HTML::Obj2HTML::fetch($o->{src}.$file_ext, $attr));
650              
651             } elsif ($tag eq "javascript") {
652 0         0 $ret .= "";
653              
654             } elsif ($tag eq "includejs") {
655 0 0       0 if (!ref $attr) {
    0          
656 0         0 $ret .= "";
657             } elsif (ref $attr == "HASH") {
658 0         0 $ret .= "";
666             }
667              
668              
669             } elsif ($tag eq "includecss") {
670 0         0 $ret .= "";
671              
672             } elsif ($tag eq "doctype") {
673 1         4 $ret .= "";
674              
675             } elsif (ref $attr eq "HASH" && defined $attr->{removeif} && $attr->{removeif}) {
676 0         0 $ret .= HTML::Obj2HTML::gen($attr->{_});
677              
678             # Finally through all the non-HTML elements ;)
679             } elsif ($tag) {
680              
681             # It's perfectly allowed to omit content from a tag where the end tag was forbidden
682             # If we have content, we have to assume that it should appear after the
683             # tag - not discard it, or show it within
684             # If we've got a hash ref though, we have attributes :)
685             # Note that this has to go here, because the attribute might have been a staticfile: or similar
686             # to execute some additional code
687 5 50 33     20 if ($tags{$tag} & END_TAG_FORBIDDEN && ref $attr ne "HASH") {
688 0         0 unshift(@tags, $attr);
689 0         0 $attr = undef;
690             }
691              
692 5 50 33     19 if ($warn_on_unknown_tag && !defined $tags{$tag}) {
693 0         0 carp "Warning: Unknown tag $tag in HTML::Obj2HTML\n";
694             }
695              
696 5         10 $ret .= "<$tag";
697 5 50       59 if (!defined $attr) {
    100          
    50          
    50          
    50          
698 0 0       0 if ($tags{$tag} & END_TAG_FORBIDDEN) {
    0          
699 0 0       0 if ($mode eq "XHTML") {
700 0         0 $ret .= " />";
701             } else {
702 0         0 $ret .= ">";
703             }
704             } elsif ($tags{$tag} & END_TAG_REQUIRED) {
705 0         0 $ret .= ">";
706             }
707              
708             } elsif (ref $attr eq "ARRAY") {
709 3         6 $ret .= ">";
710 3         47 $ret .= HTML::Obj2HTML::gen($attr);
711 3         6 $ret .= "";
712              
713             } elsif (ref $attr eq "HASH") {
714 0         0 my %attrs = %{$attr};
  0         0  
715 0         0 my $content;
716 0         0 foreach my $k (keys(%attrs)) {
717 0 0       0 if (ref $k eq "ARRAY") {
    0          
    0          
    0          
718 0         0 $content = $k;
719              
720             } elsif (ref $attrs{$k} eq "ARRAY") {
721             # shorthand, you can defined the content within the classname, e.g. div => { "ui segment" => [ _ => "Content" ] }
722 0 0       0 if ($k ne "_") {
723 0         0 $ret .= format_attr("class", $k);
724             }
725 0   0     0 $content = $attrs{$k} || '';
726              
727             } elsif (ref $attrs{$k} eq "HASH") {
728              
729 0 0       0 if ($k eq "style") {
    0          
    0          
730 0         0 my @styles = ();
731 0         0 while (my ($csskey, $cssval) = each(%{$attrs{$k}})) {
  0         0  
732 0         0 CORE::push(@styles, $csskey.":".$cssval.";");
733             }
734 0         0 $ret .= format_attr("style", join("",@styles));
735             } elsif ($k eq "if") {
736 0         0 my $val = $attrs{$k};
737 0 0 0     0 if ($val->{cond} && $val->{true}) {
    0 0        
738 0         0 foreach my $newk (keys(%{$val->{true}})) {
  0         0  
739 0         0 $ret .= format_attr($newk, $val->{true}->{$newk})
740             }
741             } elsif (!$val->{cond} && $val->{false}) {
742 0         0 foreach my $newk (keys(%{$val->{false}})) {
  0         0  
743 0         0 $ret .= format_attr($newk, $val->{false}->{$newk})
744             }
745             }
746             } elsif (defined $attrs{$k}->{if}) {
747 0 0 0     0 if ($attrs{$k}->{if} && defined $attrs{$k}->{true}) {
    0 0        
748 0         0 $ret .= format_attr($k, $attrs{$k}->{true});
749             } elsif (!$attrs{$k}->{if} && defined $attrs{$k}->{false}) {
750 0         0 $ret .= format_attr($k, $attrs{$k}->{false});
751             }
752             }
753              
754             } elsif ($k eq "_") {
755 0   0     0 $content = $attrs{$k} || '';
756              
757             } else {
758 0         0 $ret .= format_attr($k, $attrs{$k});
759             }
760             }
761 0 0       0 if ($tags{$tag} & END_TAG_FORBIDDEN) {
    0          
    0          
762             # content is also forbidden!
763 0 0       0 if ($mode eq "XHTML") {
764 0         0 $ret .= " />";
765             } else {
766 0         0 $ret .= ">";
767             }
768             } elsif (defined $content) {
769 0         0 $ret .= ">";
770 0         0 $ret .= HTML::Obj2HTML::gen($content);
771 0         0 $ret .= "";
772             } elsif ($tags{$tag} & END_TAG_REQUIRED) {
773 0         0 $ret .= ">";
774             } else {
775 0 0       0 if ($mode eq "XHTML") {
776 0         0 $ret .= " />";
777             } else {
778 0         0 $ret .= ">";
779             }
780             }
781             } elsif (ref $attr eq "CODE") {
782 0         0 $ret .= ">";
783 0         0 eval {
784 0         0 $ret .= gen($attr->());
785             };
786 0         0 $ret .= "";
787 0 0       0 if ($@) { warn "Error parsing HTML::Obj2HTML objects when calling code ref: $@\n"; }
  0         0  
788             } elsif (ref $attr eq "") {
789 2         22 my $val = web_escape($attr);
790 2         6 $ret .= ">$val";
791             }
792             }
793              
794 6 50 33     23 if (defined $extensions{$origtag} && defined $extensions{$origtag}->{after}) {
795 0         0 $ret .= $extensions{$origtag}->{after}($attr);
796             }
797              
798             }
799 4         11 return $ret;
800             }
801              
802             sub format_attr {
803 0     0 0 0 my $k = shift;
804 0         0 my $val = shift;
805 0         0 $val = web_escape($val);
806 0 0       0 if (defined $val) {
807 0         0 return " $k=\"$val\"";
808             }
809 0         0 return "";
810             }
811             sub substitute_dictionary {
812 2     2 0 4 my $val = shift;
813 2 50       6 if ($val) {
814 2 0       5 $val =~ s/%([A-Za-z][A-Za-z0-9]+)%/if (defined $dictionary{$1}) { $dictionary{$1}; } else { $1; }/ge;
  0         0  
  0         0  
  0         0  
815             }
816 2         3 return $val;
817             }
818             sub web_escape {
819 2     2 0 7 my $val = shift;
820 2         7 $val = HTML::Entities::encode($val);
821 2         44 $val = substitute_dictionary($val);
822 2         4 return $val;
823             }
824             sub plain {
825 0     0 0 0 my $txt = shift;
826 0         0 $txt = web_escape($txt);
827 0         0 $txt =~ s|\n|
|g;
828 0         0 return $txt;
829             }
830             sub markdown {
831 0     0 0 0 my $txt = shift;
832 0         0 $txt = substitute_dictionary($txt);
833 0         0 my $m = new Text::Markdown;
834 0         0 my $val = $m->markdown(HTML::Entities::encode($txt));
835 0         0 return $val;
836             }
837              
838             sub print {
839 0     0 0 0 my $o = shift;
840 0         0 print gen($o);
841             }
842              
843             sub format {
844 0     0 0 0 my $plain = shift;
845 0         0 $plain =~ s/\n/
/g;
846 0         0 return [ raw => $plain ];
847             }
848              
849             sub register_extension {
850 39     39 0 66 my $tag = shift;
851 39         49 my $def = shift;
852 39         45 my $flags = shift;
853 39         84 $extensions{$tag} = $def;
854 39 50       60 if (defined $flags) {
855 0         0 $tags{$tag} = $flags;
856             } else {
857 39         100 $tags{$tag} = END_TAG_OPTIONAL;
858             }
859             }
860              
861             1;
862             __END__