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               } $_->[0]
  60             : $_->[0]
  61     ), @{$self->{parts}};
  62 }
  63
  64 sub _hsv_unescaped_string {
  65     my $self = shift;
  66
  67     return join '', map $_->[0], @{$self->{parts}};
  68 }
  69
  70 sub _hsv_dot {
  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
  89     return ref($self)->new(@parts, { ignore => $self->{ignore} });
  90 }
  91
  92 sub _hsv_is_true {
  93     my ($self) = @_;
  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     );
 111 }
 112
 113 sub ref { '' }
 114
 115 sub DESTROY { }
 116
 117 1;
 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