documentationify
[scpubgit/HTML-String.git] / lib / HTML / String / Value.pm
CommitLineData
e1b4b35c 1package HTML::String::Value;
2
3use strictures 1;
586054e0 4use UNIVERSAL::ref;
e1b4b35c 5use Safe::Isa;
6use Data::Munge;
7
e1b4b35c 8use overload
b8aaa17d 9 '""' => '_hsv_escaped_string',
10 '.' => '_hsv_dot',
11 'bool' => '_hsv_is_true',
e1b4b35c 12
e1b4b35c 13 fallback => 1,
14;
15
16sub 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 37sub 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
45sub _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/</&lt;/g;
57 s/>/&gt;/g;
58 s/"/&quot;/g;
59 } $_->[0]
60 : $_->[0]
61 ), @{$self->{parts}};
62}
63
b8aaa17d 64sub _hsv_unescaped_string {
e1b4b35c 65 my $self = shift;
66
67 return join '', map $_->[0], @{$self->{parts}};
68}
69
b8aaa17d 70sub _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 92sub _hsv_is_true {
f27b509e 93 my ($self) = @_;
d86bdf82 94 return 1 if grep $_, map $_->[0], @{$self->{parts}};
95}
96
97sub isa {
98 my $self = shift;
99 return (
100 eval { $self->_hsv_unescaped_string->isa(@_) }
101 or $self->SUPER::isa(@_)
102 );
103}
104
105sub can {
106 my $self = shift;
107 return (
108 eval { $self->_hsv_unescaped_string->can(@_) }
109 or $self->SUPER::can(@_)
110 );
e1b4b35c 111}
112
586054e0 113sub ref { '' }
114
9c9a7ae5 115sub DESTROY { }
116
e1b4b35c 1171;
d86bdf82 118
119__END__
120
121=head1 NAME
122
123HTML::String::Value - A scalar hiding as a string on behalf of L<HTML::String>
124
125=head1 SYNOPSIS
126
127Usually, you'd create this with L<HTML::String>'s L<HTML::String/html> export
128but:
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
150Each 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
160Currently, the %options hashref contains only:
161
162 (
163 ignore => { 'Package::One' => 1, 'Package::Two' => 1, ... }
164 )
165
166which tells this value object to ignore whether escaping has been requested
167for any particular chunk and instead to provide the unescaped version.
168
169When called on an existing object, does the equivalent of
170
171 $self->_hsv_unescaped_string->new(@args);
172
173to fit in with the "pretending to be a class name" behaviour provided by
174L</AUTOLOAD>.
175
176=head2 _hsv_escaped_string
177
178 $html->_hsv_escaped_string
179
180Returns a concatenation of all parts of this value with those marked for
181escaping escaped, unless the calling package has been specified in the
182C<ignore> option to L</new>.
183
184If the calling package has been marked as ignoring escaping, returns the
185result of L</_hsv_unescaped_string>.
186
187You probably shouldn't be calling this directly.
188
189=head2 _hsv_unescaped_string
190
191 $html->_hsv_unescaped_string
192
193Returns a concatenation of all parts of this value with no escaping performed.
194
195You probably shouldn't be calling this directly.
196
197=head2 _hsv_dot
198
199 $html->_hsv_dot($other_string, $reversed)
200
201Returns a new value object consisting of the two values' parts concatenated
202together (in reverse if C<$reversed> is true).
203
204Unlike L</new>, this method defaults to escaping a bare string provided.
205
206You probably shouldn't be calling this directly.
207
208=head2 _hsv_is_true
209
210 $html->_hsv_is_true
211
212Returns true if any of this value's parts are true.
213
214You probably shouldn't be calling this directly.
215
216=head2 AUTOLOAD
217
218 $html->method_name(@args)
219
220This calls the equivalent of
221
222 $html->_hsv_unescaped_string->method_name(@args)
223
224to allow for class method calls even when the class name has ended up being
225turned into a value object.
226
227=head2 isa
228
229 $html->isa($name)
230
231This method returns true if either the value or the unescaped string are
232isa the supplied C<$name> in order to allow for class method calls even when
233the class name has ended up being turned into a value object.
234
235=head2 can
236
237 $html->can($name)
238
239This method returns a coderef if either the value or the unescaped string
240provides this method; methods on the unescaped string are preferred to allow
241for class method calls even when the class name has ended up being
242turned into a value object.
243
244=head2 ref
245
246 $html->ref
247
248This method always returns C<''>. Since we register ourselves with
249L<UNIVERSAL::ref>, this means that
250
251 ref($html);
252
253will also return C<''>, which means that modules loaded after this one will
254see a value object as being a plain scalar unless they're explicitly checking
255the defined-ness of the return value of C<ref>, which probably means that they
256wanted to spot people cheating like we're trying to.
257
258If you have trouble with things trying to treat a value object as something
259other than a string, try loading L<UNIVERSAL::ref> earlier.
260
261=head2 DESTROY
262
263Overridden to do nothing so that L</AUTOLOAD> doesn't trap it.
264
265=head1 OPERATOR OVERLOADS
266
267=head2 stringification
268
269Stringification is overloaded to call L</_hsv_escaped_string>
270
271=head2 concatenation
272
273Concatentation is overloaded to call L</_hsv_dot>
274
275=head2 boolification
276
277Boolification is overloaded to call L</_hsv_is_true>
278
279=head1 AUTHORS
280
281See L<HTML::String> for authors.
282
283=head1 COPYRIGHT AND LICENSE
284
285See L<HTML::String> for the copyright and license.
286
287=cut