File Coverage

blib/lib/HTML/AutoTag.pm
Criterion Covered Total %
statement 61 61 100.0
branch 29 32 90.6
condition 1 2 50.0
subroutine 7 7 100.0
pod 2 2 100.0
total 100 104 96.1


line stmt bran cond sub pod time code
1             package HTML::AutoTag;
2 8     8   125723 use 5.006;
  8         31  
3 8     8   43 use strict;
  8         16  
  8         197  
4 8     8   46 use warnings FATAL => 'all';
  8         13  
  8         475  
5             our $VERSION = '1.05';
6              
7 8     8   6444 use HTML::Entities;
  8         56759  
  8         762  
8 8     8   7212 use Tie::Hash::Attribute;
  8         8133  
  8         6350  
9              
10             our( $INDENT, $NEWLINE, $LEVEL, $ENCODE, $ENCODES, $SORTED );
11              
12             sub new {
13 15     15 1 544197 my $self = shift;
14 15         56 my $args = {@_};
15 15 100       89 $ENCODE = defined $args->{encode} ? $args->{encode} : exists $args->{encodes};
16 15 100       56 $ENCODES = defined $args->{encodes} ? $args->{encodes} : '';
17 15 100       51 $INDENT = defined $args->{indent} ? $args->{indent} : '';
18 15 100       53 $NEWLINE = defined $args->{indent} ? "\n" : '';
19 15   50     90 $LEVEL = $args->{level} || 0;
20 15         32 $SORTED = $args->{sorted};
21 15         73 bless {}, $self;
22             }
23              
24             sub tag {
25 267     267 1 1958 my $self = shift;
26 267         831 my %args = @_;
27 267         437 my $attr = $args{attr};
28              
29 267 50       725 return '' unless defined $args{tag};
30              
31 267         375 my $attr_str;
32 267 100       905 if (grep ref($_), values %$attr) {
33             # complex attrs use a tied hash
34 47 50       593 unless (grep /^-/, keys %$attr) {
35 47         431 tie my %attr, 'Tie::Hash::Attribute', sorted => $SORTED;
36 47         489 %attr = %$attr;
37 47         900 $attr = \%attr;
38             }
39             } else {
40             # simple attrs can bypass being tied
41 220         366 $attr_str = '';
42 220 100       706 my @keys = $SORTED ? sort keys %$attr : keys %$attr;
43 220         539 for my $key (@keys) {
44 79         584 $attr_str .= ' ' . Tie::Hash::Attribute::_key( $key ) . '="' . Tie::Hash::Attribute::_val( $attr->{$key} ) . '"';
45             }
46             }
47              
48             # emtpy tag
49 267 100       1378 unless (defined $args{cdata}) {
50 35 50       378 return ( $INDENT x $LEVEL )
51             . "<$args{tag}"
52             . ( defined( $attr_str ) ? $attr_str : scalar( %$attr ) )
53             . " />$NEWLINE"
54             ;
55             }
56              
57 232         340 my $cdata;
58             my $no_post_indent;
59 232 100       818 if (ref($args{cdata}) eq 'ARRAY') {
    100          
60              
61 12 100       40 if (ref($args{cdata}[0]) eq 'HASH') {
62              
63 4         9 $LEVEL++;
64 4         10 $cdata = $NEWLINE;
65 4         8 for (0 .. $#{ $args{cdata} }) {
  4         20  
66 18         414 $cdata .= $self->tag( %{ $args{cdata}[$_] } );
  18         92  
67             }
68 4         90 $LEVEL--;
69              
70             } else {
71 8         13 my $str = '';
72 8         12 for (@{ $args{cdata} }) {
  8         24  
73 36         1370 $str .= $self->tag( tag => $args{tag}, attr => $attr, cdata => $_);
74             }
75 8         327 return $str;
76             }
77              
78             } elsif (ref($args{cdata}) eq 'HASH') {
79 14         21 $LEVEL++;
80 14         24 $cdata = $NEWLINE . $self->tag( %{ $args{cdata} } );
  14         92  
81 14         33 $LEVEL--;
82              
83             } else {
84 206 100       508 $cdata = $ENCODE ? HTML::Entities::encode_entities( $args{cdata}, $ENCODES ) : $args{cdata};
85 206         813 $no_post_indent = 1;
86             }
87              
88 224 100       1760 return ( $INDENT x $LEVEL )
    100          
89             . "<$args{tag}" . ( defined( $attr_str ) ? $attr_str : scalar( %$attr ) )
90             . ">$cdata"
91             . ( $no_post_indent ? '' : ( $INDENT x $LEVEL ) )
92             . "$NEWLINE"
93             ;
94             }
95              
96             1;
97              
98             __END__