lib/HTML/String/Value.pm

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