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   127392 use 5.006;
  8         30  
3 8     8   42 use strict;
  8         16  
  8         199  
4 8     8   48 use warnings FATAL => 'all';
  8         14  
  8         425  
5             our $VERSION = '1.04';
6              
7 8     8   6662 use HTML::Entities;
  8         51881  
  8         657  
8 8     8   6455 use Tie::Hash::Attribute;
  8         8220  
  8         6324  
9              
10             our( $INDENT, $NEWLINE, $LEVEL, $ENCODE, $ENCODES, $SORTED );
11              
12             sub new {
13 15     15 1 4649 my $self = shift;
14 15         56 my $args = {@_};
15 15 100       75 $ENCODE = defined $args->{encode} ? $args->{encode} : exists $args->{encodes};
16 15 100       52 $ENCODES = defined $args->{encodes} ? $args->{encodes} : '';
17 15 100       53 $INDENT = defined $args->{indent} ? $args->{indent} : '';
18 15 100       48 $NEWLINE = defined $args->{indent} ? "\n" : '';
19 15   50     90 $LEVEL = $args->{level} || 0;
20 15         30 $SORTED = $args->{sorted};
21 15         66 bless {}, $self;
22             }
23              
24             sub tag {
25 267     267 1 1747 my $self = shift;
26 267         720 my %args = @_;
27 267         427 my $attr = $args{attr};
28              
29 267 50       739 return '' unless defined $args{tag};
30              
31 267         354 my $attr_str;
32 267 100       831 if (grep ref($_), values %$attr) {
33             # complex attrs use a tied hash
34 47 50       579 unless (grep /^-/, keys %$attr) {
35 47         418 tie my %attr, 'Tie::Hash::Attribute', sorted => $SORTED;
36 47         485 %attr = %$attr;
37 47         851 $attr = \%attr;
38             }
39             } else {
40             # simple attrs can bypass being tied
41 220         323 $attr_str = '';
42 220 100       644 my @keys = $SORTED ? sort keys %$attr : keys %$attr;
43 220         506 for my $key (@keys) {
44 79         599 $attr_str .= ' ' . Tie::Hash::Attribute::_key( $key ) . '="' . Tie::Hash::Attribute::_val( $attr->{$key} ) . '"';
45             }
46             }
47              
48             # emtpy tag
49 267 100       1369 unless (defined $args{cdata}) {
50 35 50       267 return ( $INDENT x $LEVEL )
51             . "<$args{tag}"
52             . ( defined( $attr_str ) ? $attr_str : scalar( %$attr ) )
53             . " />$NEWLINE"
54             ;
55             }
56              
57 232         329 my $cdata;
58             my $no_post_indent;
59 232 100       743 if (ref($args{cdata}) eq 'ARRAY') {
    100          
60              
61 12 100       39 if (ref($args{cdata}[0]) eq 'HASH') {
62              
63 4         8 $LEVEL++;
64 4         9 $cdata = $NEWLINE;
65 4         8 for (0 .. $#{ $args{cdata} }) {
  4         19  
66 18         402 $cdata .= $self->tag( %{ $args{cdata}[$_] } );
  18         90  
67             }
68 4         86 $LEVEL--;
69              
70             } else {
71 8         14 my $str = '';
72 8         12 for (@{ $args{cdata} }) {
  8         23  
73 36         1299 $str .= $self->tag( tag => $args{tag}, attr => $attr, cdata => $_);
74             }
75 8         312 return $str;
76             }
77              
78             } elsif (ref($args{cdata}) eq 'HASH') {
79 14         22 $LEVEL++;
80 14         23 $cdata = $NEWLINE . $self->tag( %{ $args{cdata} } );
  14         91  
81 14         32 $LEVEL--;
82              
83             } else {
84 206 100       498 $cdata = $ENCODE ? HTML::Entities::encode_entities( $args{cdata}, $ENCODES ) : $args{cdata};
85 206         830 $no_post_indent = 1;
86             }
87              
88 224 100       1721 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__