File Coverage

blib/lib/HTML/FormHelpers.pm

Criterion	Covered	Total	%
statement	15	85	17.6
branch	0	22	0.0
condition	0	29	0.0
subroutine	5	19	26.3
pod	6	8	75.0
total	26	163	15.9

package HTML::FormHelpers;
{
  $HTML::FormHelpers::VERSION = '0.004';
}
# ABSTRACT: Useful routines for generating HTML form elements

use strict;
use warnings;
use Try::Tiny;
use Scalar::Util qw/ blessed /;
use parent 'Exporter';

our @EXPORT_OK = qw( process_attributes radio text select button hidden checkbox );
our %EXPORT_TAGS = ( all => [ qw(radio text select button hidden checkbox )] );


# NOTE: The first hashref we come across is assumed to be the
#       attributes
sub process_attributes {
    for my $i (0..$#_) {
        if (ref $_[$i] eq 'HASH') {
            my $attrs = splice @_, $i, 1;
            return join " ", map { $_ . '="' . $attrs->{$_} . '"' } keys %{$attrs};
        }
    }
    return "";
}

sub process_args {
    my $obj;
    $obj = shift if blessed $_[0];
    my $attributes = &process_attributes;
    my $idx = try { $obj->can('id') && "[" . ($obj->id // "") . "]" } catch { "" };
    my $name = $_[0] . $idx;
    return ($obj,$name,$attributes);
}

sub radio {
    my ($obj, $fname, $attributes) = &process_args;
    my ($name, $values, $sep) = @_;
    $sep ||= '';
    my ($i, @ret) = 0;
    my $on = do { try { $obj->$name }  } // @{$values}[0];
    while ($i < @$values) {
        my ($val,$disp) = @{$values}[$i, $i+1];
        my $checked = $on eq $val ? 'checked="checked"' : "";
        push @ret, qq($disp);
    } continue { $i+=2 }
    return ref $sep eq 'ARRAY' ? @ret : join $sep,@ret;
}


sub text {
    my ($obj, $fname, $attributes) = &process_args;
    my ($name, $value) = @_;
    my $val = do { try { $obj->$name } } // $value // "";
    return qq();
}


sub select {
    my ($obj, $fname, $attributes) = &process_args;
    my ($name, $options, $key, $value) = @_;
    my $str = $name ? qq() : "";
    my $on = $obj && $name ? ($obj->$name // "") : "";
    for my $o (@$options) {
        my ($k, $v);
        if (ref $o eq 'HASH') {
            ($k,$v) = each %$o;
        } elsif ($key && $value) {
            $k  = do { try { $o->$key } catch { $o->{$key} } } // "";
            $v = do { try { $o->$value } catch { $o->{$value} } } // "";
        } else {
            $k = $v = $o;
        }
        $str .= qq($v);
    }
    $str .= "";
    return $str;
}


sub button {
    my ($obj, $fname, $attributes) = &process_args;
    my ($name, $value) = @_;
    $value //= $name;
    return qq();
}

sub hidden {
    my ($obj, $fname, $attributes) = &process_args;
    my ($name, $value) = @_;
    return qq();
}


sub checkbox {
    my ($obj, $fname, $attributes) = &process_args;
    my ($name, $checked) = @_;
    $checked = try { $obj->$name } catch { $checked // 1 };
    $attributes .= " checked" if $checked;
    return qq();
}

1;

__END__