File Coverage

blib/lib/HTML/DisableForm.pm

Criterion	Covered	Total	%
statement	59	61	96.7
branch	36	42	85.7
condition	7	8	87.5
subroutine	12	12	100.0
pod	3	3	100.0
total	117	126	92.8

package HTML::DisableForm;
use strict;
use warnings;
use base qw/HTML::Parser/;

our $VERSION = 0.01;

my %can_disable = (
    input    => 1,
    textarea => 1,
    select   => 1,
);

sub new {
    my $class = shift;
    my $self = $class->SUPER::new(api_version => 3);
    $self->handler(start => \&_handle_start, "self, tagname, attr, text");
    $self->handler(end   => \&_handle_end, "self, tagname, text");
    $self->handler(default => \&_handle_default, "self, text");
    $self->attr_encoded(1);
    bless $self, $class;
}

sub readonly_form {
    my ($self, %option) = @_;
    $self->disable_form(%option, readonly => 1);
}

sub disable_form {
    my ($self, %option) = @_;
    $self->{target}   = $option{target} if $option{target};
    $self->{readonly} = 1 if $option{readonly};
    $self->_set_options_map($_, $option{$_}) for qw/ignore_fields ignore_forms/;
    $self->_parse(%option);
    delete $self->{output};
}

sub _set_options_map {
    my ($self, $name, $value) = @_;
    return unless defined $value;
    my %options_map = map { $_ => 1 } ref $value eq 'ARRAY' ? @$value  : $value;
    $self->{$name} = \%options_map;
}

sub _parse {
    my $self = shift;
    my %option = @_;
    if (my $file = $option{file}){
        $self->parse_file($file);
    } elsif (my $scalarref = $option{scalarref}){
        $self->parse($$scalarref);
    } elsif (my $arrayref = $option{arrayref}){
        $self->parse($_) for @$arrayref;
    }
}

sub _can_disable {
    my ($self, $tagname, $attr) = @_;
    $can_disable{$tagname} or return;
    return 0 if defined $self->{target} && !$self->{current_form};
    if (my $current_form = $self->{current_form}) {
        if (defined $self->{target}) {
            $current_form eq $self->{target} ? return 1 : return 0;
        }
        return 0 if $self->{ignore_forms}->{$current_form};
    }
    if ($attr->{name}) {
        return 0 if $self->{ignore_fields}->{$attr->{name}};
    }
    return 1;
}

sub _handle_start {
    my ($self, $tagname, $attr, $text) = @_;
    $self->{current_form} = $attr->{name} || $attr->{id} || ''
        if $tagname eq 'form';

    if ($self->_can_disable($tagname, $attr)) {
        $self->{output} .= "<$tagname";
        while (my ($key, $value) = each %$attr) {
            next if $key eq '/';
            $self->{output} .= sprintf qq( %s="%s"), $key, $value;
        }
        $self->{output} .= $self->{readonly} ? ' readonly="readonly"' : ' disabled="disabled"';
        $self->{output} .= ' /' if $attr->{'/'};
        $self->{output} .= '>';
    } else {
        $self->{output} .= $text;
    }
}

sub _handle_end {
    my ($self, $tagname, $text) = @_;
    delete $self->{current_form}
        if $tagname eq 'form' and exists $self->{current_form};
    $self->{output} .= $text;
}

sub _handle_default {
    my ($self, $text) = @_;
    $self->{output} .= $text;
}

1;

__END__