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