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 Scalar::Util qw(blessed);
   7 use Data::Munge;
   8
   9 use overload
  10     '""'   => '_hsv_escaped_string',
  11     '.'    => '_hsv_dot',
  12     'bool' => '_hsv_is_true',
  13
  14     fallback => 1,
  15 ;
  16
  17 sub new {
  18     if (blessed($_[0])) {
  19         my $c = shift;
  20         return $c->_hsv_unescaped_string->new(@_);
  21     }
  22     my ($class, @raw_parts) = @_;
  23
  24     my $opts = (ref($raw_parts[-1]) eq 'HASH') ? pop(@raw_parts) : {};
  25
  26     my @parts = map {
  27         if (ref($_) eq 'ARRAY') {
  28             $_
  29         } elsif ($_->$_isa(__PACKAGE__)) {
  30             @{$_->{parts}}
  31         } else {
  32             [ $_, 0 ]
  33         }
  34     } @raw_parts;
  35
  36     my $self = bless { parts => \@parts, %$opts }, $class;
  37
  38     return $self;
  39 }
  40
  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 {
  50     my $self = shift;
  51
  52     if ($self->{ignore}{scalar caller}) {
  53         return $self->_hsv_unescaped_string;
  54     }
  55
  56     return join '', map +(
  57         $_->[1]
  58             ? byval {
  59                 s/&/&amp;/g;
  60                 s/</&lt;/g;
  61                 s/>/&gt;/g;
  62                 s/"/&quot;/g;
  63                 s/'/&#39;/g;
  64               } $_->[0]
  65             : $_->[0]
  66     ), @{$self->{parts}};
  67 }
  68
  69 sub _hsv_unescaped_string {
  70     my $self = shift;
  71
  72     return join '', map $_->[0], @{$self->{parts}};
  73 }
  74
  75 sub _hsv_dot {
  76     my ($self, $str, $prefix) = @_;
  77
  78     return $self unless $str;
  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
  94     return bless({ %$self, parts => \@parts }, blessed($self));
  95 }
  96
  97 sub _hsv_is_true {
  98     my ($self) = @_;
  99     return 1 if grep $_, map $_->[0], @{$self->{parts}};
 100 }
 101
 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
 106 sub isa {
 107     my $self = shift;
 108     return (
 109         do {
 110             local $@;
 111             eval { blessed($self) and $self->_hsv_unescaped_string->isa(@_) }
 112         }
 113         or $self->SUPER::isa(@_)
 114     );
 115 }
 116
 117 sub can {
 118     my $self = shift;
 119     return (
 120         do {
 121             local $@;
 122             eval { blessed($self) and $self->_hsv_unescaped_string->isa(@_) }
 123         }
 124         or $self->SUPER::can(@_)
 125     );
 126 }
 127
 128 sub ref { '' }
 129
 130 sub DESTROY { }
 131
 132 1;
 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
 171   [ 'text that you DO want to be escaped', 1 ]
 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