Commit | Line | Data |
e1b4b35c |
1 | package HTML::String::Value; |
2 | |
3 | use strictures 1; |
586054e0 |
4 | use UNIVERSAL::ref; |
e1b4b35c |
5 | use Safe::Isa; |
6 | use Data::Munge; |
7 | |
e1b4b35c |
8 | use overload |
9 | '""' => 'escaped_string', |
10 | '.' => 'dot', |
11 | '.=' => 'dot_equals', |
ed99cbb4 |
12 | '=' => 'clone', |
e1b4b35c |
13 | |
e1b4b35c |
14 | fallback => 1, |
15 | ; |
16 | |
17 | sub new { |
18 | my ($class, @raw_parts) = @_; |
19 | |
51eaef0b |
20 | my @parts = map { |
21 | if (ref($_) eq 'ARRAY') { |
22 | $_ |
23 | } elsif ($_->$_isa(__PACKAGE__)) { |
24 | @{$_->{parts}} |
25 | } else { |
26 | [ $_, 0 ] |
27 | } |
28 | } @raw_parts; |
e1b4b35c |
29 | |
30 | my $self = bless { parts => \@parts }, $class; |
31 | |
32 | return $self; |
33 | } |
34 | |
35 | sub escaped_string { |
36 | my $self = shift; |
37 | |
38 | return join '', map +( |
39 | $_->[1] |
40 | ? byval { |
41 | s/&/&/g; |
42 | s/</</g; |
43 | s/>/>/g; |
44 | s/"/"/g; |
45 | } $_->[0] |
46 | : $_->[0] |
47 | ), @{$self->{parts}}; |
48 | } |
49 | |
50 | sub unescaped_string { |
51 | my $self = shift; |
52 | |
53 | return join '', map $_->[0], @{$self->{parts}}; |
54 | } |
55 | |
56 | sub dot { |
57 | my ($self, $str, $prefix) = @_; |
58 | |
59 | return $self unless $str; |
60 | |
61 | my @parts = @{$self->{parts}}; |
62 | |
63 | my @new_parts = ( |
64 | $str->$_isa(__PACKAGE__) |
65 | ? @{$str->{parts}} |
66 | : [ $str, 1 ] |
67 | ); |
68 | |
69 | if ( $prefix ) { |
70 | unshift @parts, @new_parts; |
71 | } else { |
72 | push @parts, @new_parts; |
73 | } |
74 | |
75 | return ref($self)->new(@parts); |
76 | } |
77 | |
78 | sub dot_equals { |
79 | my ($self, $str, $prefix) = @_; |
80 | |
81 | return $self unless $str; |
82 | |
83 | my @new_parts = ( |
84 | $str->$_isa(__PACKAGE__) |
85 | ? @{$str->{parts}} |
86 | : [ $str, 1 ] |
87 | ); |
88 | |
89 | push @{$self->{parts}}, @new_parts; |
90 | |
91 | return $self; |
92 | } |
93 | |
ed99cbb4 |
94 | sub clone { |
95 | my $self = shift; |
96 | |
97 | return ref($self)->new(@{$self->{parts}}); |
98 | } |
99 | |
586054e0 |
100 | sub ref { '' } |
101 | |
e1b4b35c |
102 | 1; |