File Coverage

blib/lib/Template/HTML/Variable.pm

Criterion	Covered	Total	%
statement	32	87	36.7
branch	2	32	6.2
condition	2	3	66.6
subroutine	9	11	81.8
pod	7	7	100.0
total	52	140	37.1

package Template::HTML::Variable;

use strict;
use warnings;

sub op_factory {
    my ($op) = @_;

    return eval q|sub {
        my ($self, $str) = @_;

        if ( ref $str eq __PACKAGE__) {
            return $self->{value} | . $op . q| $str->{value};
        }
        else {
            return $self->{value} | . $op . q| $str;
        }
    }|;
}

use overload
    '""'   => \&html_encoded,
    '.'    => \&concat,
    '.='   => \&concatequals,
    '='    => \&clone,

    'cmp' => op_factory('cmp'),
    'eq'  => op_factory('eq'),
    '<=>' => op_factory('<=>'),
    '=='  => op_factory('=='),
    '%'   => op_factory('%'),
    '+'   => op_factory('+'),
    '-'   => op_factory('-'),
    '*'   => op_factory('*'),
    '/'   => op_factory('/'),
    '**'  => op_factory('**'),
    '>>'  => op_factory('>>'),
    '<<'  => op_factory('<<'),
;

sub new {
    my ($class, $value) = @_;

    my $self = bless { value => $value }, $class;

    return $self;
}

sub plain {
    my $self = shift;

    return $self->{value};
}

sub html_encoded {
    my $self = shift;

    my $value = $self->{value};

    for ($value) {
        s/&/&/g;
        s/
        s/>/>/g;
        s/"/"/g;
    }

    return $value;
}

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

    # Special case where we're _not_ going to html_encode now now
    return $self->clone() if not defined $str or $str eq '';

    if ( $prefix ) {
        return $str . $self->html_encoded();
    }
    else {
        return $self->html_encoded() . $str;
    }
}

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

    if ( ref $str eq __PACKAGE__) {
        $self->{value} .= $str->{value};
        return $self;
    }
    else {
        # Special case where we're _not_ going to html_encode now now
        return $self->clone() if $str eq '';

        $self->{value} .= $str;
        return $self->html_encoded . $str;
    }
}

sub clone {
    my $self = shift;

    my $clone = bless { %$self }, ref $self;

    return $clone;
}

1;
__END__