File Coverage

blib/lib/HTML/String/Value.pm

Criterion	Covered	Total	%
statement	55	67	82.0
branch	14	22	63.6
condition	3	9	33.3
subroutine	13	17	76.4
pod	4	4	100.0
total	89	119	74.7

package HTML::String::Value;

use strictures 1;
use UNIVERSAL::ref;
use Safe::Isa;
use Scalar::Util qw(blessed);
use Data::Munge;

use overload
    '""'   => '_hsv_escaped_string',
    '.'    => '_hsv_dot',
    'bool' => '_hsv_is_true',

    fallback => 1,
;

sub new {
    if (blessed($_[0])) {
        my $c = shift;
        return $c->_hsv_unescaped_string->new(@_);
    }
    my ($class, @raw_parts) = @_;

    my $opts = (ref($raw_parts[-1]) eq 'HASH') ? pop(@raw_parts) : {};

    my @parts = map {
        if (ref($_) eq 'ARRAY') {
            $_
        } elsif ($_->$_isa(__PACKAGE__)) {
            @{$_->{parts}}
        } else {
            [ $_, 0 ]
        }
    } @raw_parts;

    my $self = bless { parts => \@parts, %$opts }, $class;

    return $self;
}

sub AUTOLOAD {
    my $invocant = shift;
    (my $meth = our $AUTOLOAD) =~ s/.*:://;
    die "No such method ${meth} on ${invocant}"
        unless ref($invocant);
    return $invocant->_hsv_unescaped_string->$meth(@_);
}

sub _hsv_escaped_string {
    my $self = shift;

    if ($self->{ignore}{scalar caller}) {
        return $self->_hsv_unescaped_string;
    }

    return join '', map +(
        $_->[1]
            ? byval {
                s/&/&/g;
                s/
                s/>/>/g;
                s/"/"/g;
                s/'/'/g;
              } $_->[0]
            : $_->[0]
    ), @{$self->{parts}};
}

sub _hsv_unescaped_string {
    my $self = shift;

    return join '', map $_->[0], @{$self->{parts}};
}

sub _hsv_dot {
    my ($self, $str, $prefix) = @_;

    return $self unless defined $str && length $str;

    my @parts = @{$self->{parts}};

    my @new_parts = (
        $str->$_isa(__PACKAGE__)
            ? @{$str->{parts}}
            : [ $str, 1 ]
    );

    if ( $prefix ) {
        unshift @parts, @new_parts;
    } else {
        push @parts, @new_parts;
    }

    return bless({ %$self, parts => \@parts }, blessed($self));
}

sub _hsv_is_true {
    my ($self) = @_;
    return 1 if grep $_, map $_->[0], @{$self->{parts}};
}

# we need to local $@ here because some modules (cough, TT, cough)
# will do a 'die $@ if $@' without realising that it wasn't their eval
# that set it

sub isa {
    my $self = shift;
    return (
        do {
            local $@;
            eval { blessed($self) and $self->_hsv_unescaped_string->isa(@_) }
        }
        or $self->SUPER::isa(@_)
    );
}

sub can {
    my $self = shift;
    return (
        do {
            local $@;
            eval { blessed($self) and $self->_hsv_unescaped_string->can(@_) }
        }
        or $self->SUPER::can(@_)
    );
}

sub ref { '' }

sub DESTROY { }

1;

__END__