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     '""'   => 'escaped_string',
  10     '.'    => 'dot',
  11
  12     fallback => 1,
  13 ;
  14
  15 sub new {
  16     my ($class, @raw_parts) = @_;
  17
  18     my @parts = map {
  19         if (ref($_) eq 'ARRAY') {
  20             $_
  21         } elsif ($_->$_isa(__PACKAGE__)) {
  22             @{$_->{parts}}
  23         } else {
  24             [ $_, 0 ]
  25         }
  26     } @raw_parts;
  27
  28     my $self = bless { parts => \@parts }, $class;
  29
  30     return $self;
  31 }
  32
  33 sub escaped_string {
  34     my $self = shift;
  35
  36     return join '', map +(
  37         $_->[1]
  38             ? byval {
  39                 s/&/&amp;/g;
  40                 s/</&lt;/g;
  41                 s/>/&gt;/g;
  42                 s/"/&quot;/g;
  43               } $_->[0]
  44             : $_->[0]
  45     ), @{$self->{parts}};
  46 }
  47
  48 sub unescaped_string {
  49     my $self = shift;
  50
  51     return join '', map $_->[0], @{$self->{parts}};
  52 }
  53
  54 sub dot {
  55     my ($self, $str, $prefix) = @_;
  56
  57     return $self unless $str;
  58
  59     my @parts = @{$self->{parts}};
  60
  61     my @new_parts = (
  62         $str->$_isa(__PACKAGE__)
  63             ? @{$str->{parts}}
  64             : [ $str, 1 ]
  65     );
  66
  67     if ( $prefix ) {
  68         unshift @parts, @new_parts;
  69     } else {
  70         push @parts, @new_parts;
  71     }
  72
  73     return ref($self)->new(@parts);
  74 }
  75
  76 sub ref { '' }
  77
  78 1;