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 |
b8aaa17d |
9 | '""' => '_hsv_escaped_string', |
10 | '.' => '_hsv_dot', |
11 | 'bool' => '_hsv_is_true', |
e1b4b35c |
12 | |
e1b4b35c |
13 | fallback => 1, |
14 | ; |
15 | |
16 | sub new { |
b8aaa17d |
17 | if (ref($_[0])) { my $c = shift; return $c->_hsv_unescaped_string->new(@_) } |
e1b4b35c |
18 | my ($class, @raw_parts) = @_; |
19 | |
f27b509e |
20 | my $opts = (ref($raw_parts[-1]) eq 'HASH') ? pop(@raw_parts) : {}; |
21 | |
51eaef0b |
22 | my @parts = map { |
23 | if (ref($_) eq 'ARRAY') { |
24 | $_ |
25 | } elsif ($_->$_isa(__PACKAGE__)) { |
26 | @{$_->{parts}} |
27 | } else { |
28 | [ $_, 0 ] |
29 | } |
30 | } @raw_parts; |
e1b4b35c |
31 | |
f27b509e |
32 | my $self = bless { parts => \@parts, %$opts }, $class; |
e1b4b35c |
33 | |
34 | return $self; |
35 | } |
36 | |
b8aaa17d |
37 | sub AUTOLOAD { |
38 | my $invocant = shift; |
39 | (my $meth = our $AUTOLOAD) =~ s/.*:://; |
40 | die "No such method ${meth} on ${invocant}" |
41 | unless ref($invocant); |
42 | return $invocant->_hsv_unescaped_string->$meth(@_); |
43 | } |
44 | |
45 | sub _hsv_escaped_string { |
e1b4b35c |
46 | my $self = shift; |
47 | |
f27b509e |
48 | if ($self->{ignore}{scalar caller}) { |
b8aaa17d |
49 | return $self->_hsv_unescaped_string; |
f27b509e |
50 | } |
51 | |
e1b4b35c |
52 | return join '', map +( |
53 | $_->[1] |
54 | ? byval { |
55 | s/&/&/g; |
56 | s/</</g; |
57 | s/>/>/g; |
58 | s/"/"/g; |
59 | } $_->[0] |
60 | : $_->[0] |
61 | ), @{$self->{parts}}; |
62 | } |
63 | |
b8aaa17d |
64 | sub _hsv_unescaped_string { |
e1b4b35c |
65 | my $self = shift; |
66 | |
67 | return join '', map $_->[0], @{$self->{parts}}; |
68 | } |
69 | |
b8aaa17d |
70 | sub _hsv_dot { |
e1b4b35c |
71 | my ($self, $str, $prefix) = @_; |
72 | |
73 | return $self unless $str; |
74 | |
75 | my @parts = @{$self->{parts}}; |
76 | |
77 | my @new_parts = ( |
78 | $str->$_isa(__PACKAGE__) |
79 | ? @{$str->{parts}} |
80 | : [ $str, 1 ] |
81 | ); |
82 | |
83 | if ( $prefix ) { |
84 | unshift @parts, @new_parts; |
85 | } else { |
86 | push @parts, @new_parts; |
87 | } |
88 | |
f27b509e |
89 | return ref($self)->new(@parts, { ignore => $self->{ignore} }); |
90 | } |
91 | |
b8aaa17d |
92 | sub _hsv_is_true { |
f27b509e |
93 | my ($self) = @_; |
d86bdf82 |
94 | return 1 if grep $_, map $_->[0], @{$self->{parts}}; |
95 | } |
96 | |
97 | sub isa { |
98 | my $self = shift; |
99 | return ( |
100 | eval { $self->_hsv_unescaped_string->isa(@_) } |
101 | or $self->SUPER::isa(@_) |
102 | ); |
103 | } |
104 | |
105 | sub can { |
106 | my $self = shift; |
107 | return ( |
108 | eval { $self->_hsv_unescaped_string->can(@_) } |
109 | or $self->SUPER::can(@_) |
110 | ); |
e1b4b35c |
111 | } |
112 | |
586054e0 |
113 | sub ref { '' } |
114 | |
9c9a7ae5 |
115 | sub DESTROY { } |
116 | |
e1b4b35c |
117 | 1; |
d86bdf82 |
118 | |
119 | __END__ |
120 | |
121 | =head1 NAME |
122 | |
123 | HTML::String::Value - A scalar hiding as a string on behalf of L<HTML::String> |
124 | |
125 | =head1 SYNOPSIS |
126 | |
127 | Usually, you'd create this with L<HTML::String>'s L<HTML::String/html> export |
128 | but: |
129 | |
130 | my $html = HTML::String::Value->new($do_not_escape_this); |
131 | |
132 | my $html = HTML::String::Value->new([ $do_not_escape_this, 0 ]); |
133 | |
134 | my $html = HTML::String::Value->new([ $do_escape_this, 1 ]); |
135 | |
136 | my $html = HTML::String::Value->new($already_an_html_string_value); |
137 | |
138 | my $html = HTML::String::Value->new(@an_array_of_any_of_the_above); |
139 | |
140 | my $html = HTML::String::Value->new( |
141 | @parts, { ignore => { package_name => 1 } } |
142 | ); |
143 | |
144 | =head1 METHODS |
145 | |
146 | =head2 new |
147 | |
148 | my $html = HTML::String::Value->new(@parts, \%options?); |
149 | |
150 | Each entry in @parts consists of one of: |
151 | |
152 | 'some text that will not be escaped' |
153 | |
154 | [ 'some text that will not be escaped', 0 ] |
155 | |
156 | [ 'text that you DO want to be scaped', 1 ] |
157 | |
158 | $existing_html_string_value |
159 | |
160 | Currently, the %options hashref contains only: |
161 | |
162 | ( |
163 | ignore => { 'Package::One' => 1, 'Package::Two' => 1, ... } |
164 | ) |
165 | |
166 | which tells this value object to ignore whether escaping has been requested |
167 | for any particular chunk and instead to provide the unescaped version. |
168 | |
169 | When called on an existing object, does the equivalent of |
170 | |
171 | $self->_hsv_unescaped_string->new(@args); |
172 | |
173 | to fit in with the "pretending to be a class name" behaviour provided by |
174 | L</AUTOLOAD>. |
175 | |
176 | =head2 _hsv_escaped_string |
177 | |
178 | $html->_hsv_escaped_string |
179 | |
180 | Returns a concatenation of all parts of this value with those marked for |
181 | escaping escaped, unless the calling package has been specified in the |
182 | C<ignore> option to L</new>. |
183 | |
184 | If the calling package has been marked as ignoring escaping, returns the |
185 | result of L</_hsv_unescaped_string>. |
186 | |
187 | You probably shouldn't be calling this directly. |
188 | |
189 | =head2 _hsv_unescaped_string |
190 | |
191 | $html->_hsv_unescaped_string |
192 | |
193 | Returns a concatenation of all parts of this value with no escaping performed. |
194 | |
195 | You probably shouldn't be calling this directly. |
196 | |
197 | =head2 _hsv_dot |
198 | |
199 | $html->_hsv_dot($other_string, $reversed) |
200 | |
201 | Returns a new value object consisting of the two values' parts concatenated |
202 | together (in reverse if C<$reversed> is true). |
203 | |
204 | Unlike L</new>, this method defaults to escaping a bare string provided. |
205 | |
206 | You probably shouldn't be calling this directly. |
207 | |
208 | =head2 _hsv_is_true |
209 | |
210 | $html->_hsv_is_true |
211 | |
212 | Returns true if any of this value's parts are true. |
213 | |
214 | You probably shouldn't be calling this directly. |
215 | |
216 | =head2 AUTOLOAD |
217 | |
218 | $html->method_name(@args) |
219 | |
220 | This calls the equivalent of |
221 | |
222 | $html->_hsv_unescaped_string->method_name(@args) |
223 | |
224 | to allow for class method calls even when the class name has ended up being |
225 | turned into a value object. |
226 | |
227 | =head2 isa |
228 | |
229 | $html->isa($name) |
230 | |
231 | This method returns true if either the value or the unescaped string are |
232 | isa the supplied C<$name> in order to allow for class method calls even when |
233 | the class name has ended up being turned into a value object. |
234 | |
235 | =head2 can |
236 | |
237 | $html->can($name) |
238 | |
239 | This method returns a coderef if either the value or the unescaped string |
240 | provides this method; methods on the unescaped string are preferred to allow |
241 | for class method calls even when the class name has ended up being |
242 | turned into a value object. |
243 | |
244 | =head2 ref |
245 | |
246 | $html->ref |
247 | |
248 | This method always returns C<''>. Since we register ourselves with |
249 | L<UNIVERSAL::ref>, this means that |
250 | |
251 | ref($html); |
252 | |
253 | will also return C<''>, which means that modules loaded after this one will |
254 | see a value object as being a plain scalar unless they're explicitly checking |
255 | the defined-ness of the return value of C<ref>, which probably means that they |
256 | wanted to spot people cheating like we're trying to. |
257 | |
258 | If you have trouble with things trying to treat a value object as something |
259 | other than a string, try loading L<UNIVERSAL::ref> earlier. |
260 | |
261 | =head2 DESTROY |
262 | |
263 | Overridden to do nothing so that L</AUTOLOAD> doesn't trap it. |
264 | |
265 | =head1 OPERATOR OVERLOADS |
266 | |
267 | =head2 stringification |
268 | |
269 | Stringification is overloaded to call L</_hsv_escaped_string> |
270 | |
271 | =head2 concatenation |
272 | |
273 | Concatentation is overloaded to call L</_hsv_dot> |
274 | |
275 | =head2 boolification |
276 | |
277 | Boolification is overloaded to call L</_hsv_is_true> |
278 | |
279 | =head1 AUTHORS |
280 | |
281 | See L<HTML::String> for authors. |
282 | |
283 | =head1 COPYRIGHT AND LICENSE |
284 | |
285 | See L<HTML::String> for the copyright and license. |
286 | |
287 | =cut |