File Coverage

blib/lib/Mojolicious/Plugin/FormFields.pm

Criterion	Covered	Total	%
statement	152	156	97.4
branch	36	46	78.2
condition	31	51	60.7
subroutine	33	34	97.0
pod	1	1	100.0
total	253	288	87.8

package Mojolicious::Plugin::FormFields;

use Mojo::Base 'Mojolicious::Plugin::ParamExpand';

our $VERSION = '0.01_02';

sub register
{
  my ($self, $app, $config) = @_;

  $config->{separator} = Mojolicious::Plugin::FormFields::Field->separator;
  $self->SUPER::register($app, $config);

  $app->helper(field => sub {
      my $c    = shift;
      my $name = shift || '';
      my $key  = "formfields.$name";
      $c->stash->{$key} ||= Mojolicious::Plugin::FormFields::Field->new($c, $name, @_);
      $c->stash->{$key};
  });

  $app->helper(fields => sub {
      Mojolicious::Plugin::FormFields::Fields->new(@_);
  });
}

package Mojolicious::Plugin::FormFields::Field;

use Mojo::Base '-strict';
use Scalar::Util;
use Carp ();

use overload
    '@{}' => '_to_fields',
    '""'  => '_to_string',
    fallback => 1;

my $SEPARATOR = '.';

sub new
{
    my $class = shift;
    my ($c, $name, $object) = @_;
    Carp::croak 'field name required' unless $name;

    my $self = bless {
	c      => $c,
	name   => $name,
	object => $object,
	value  => _lookup_value($name, $object, $c)
    }, $class;

    Scalar::Util::weaken $self->{c};
    $self;
}

sub checkbox
{
    my $self = shift;

    my $value;
    $value = shift if @_ % 2;
    $value //= 1;

    my %options = @_;
    $options{value} = $value;

    $self->input('checkbox', %options);
}

sub file
{
    my ($self, %options) = @_;
    $options{id} //= _dom_id($self->{name});

    $self->{c}->file_field($self->{name}, %options);
}

sub input
{
    my ($self, $type, %options) = @_;
    my $value = $self->{value};

    $options{id} //= _dom_id($self->{name});
    $options{value} //= $value if defined $value;
    $options{type} = $type;

    if($type eq 'checkbox' || $type eq 'radio') {
	$options{checked} = 'checked'
	    if !exists $options{checked} && defined $value && $value eq $options{value};
    }

    $self->{c}->input_tag($self->{name}, %options);
}

sub hidden
{
    my ($self, %options) = @_;
    $self->input('hidden', %options);
}

sub radio
{
    my ($self, $value, %options) = @_;
    Carp::croak 'value required' unless defined $value;

    $options{id} //= _dom_id($self->{name}, $value);
    $options{value} = $value;

    $self->input('radio', %options);
}

sub select
{
    my $self = shift;
    my $options = @_ % 2 ? shift : [];
    my %attr = @_;
    $attr{id} //= _dom_id($self->{name});

    my $c = $self->{c};
    my $name = $self->{name};
    my $field;

    if(defined $c->param($name)) {
	$field = $c->select_field($name, $options, %attr);
    }
    else {
	# Make select_field select the value
	$c->param($name, $self->{value});
	$field = $c->select_field($name, $options, %attr);
	$c->param($name, undef);
    }

    $field;
}

sub password
{
    my ($self, %options) = @_;
    $options{id} //= _dom_id($self->{name});

    $self->{c}->password_field($self->{name}, %options);
}

sub label
{
    my $self = shift;

    my $text;
    $text = pop if ref $_[-1] eq 'CODE';
    $text = shift if @_ % 2;	# step on CODE
    $text //= _default_label($self->{name});

    my %options = @_;
    $options{for} //= _dom_id($self->{name});

    $self->{c}->tag('label', %options, $text)
}

sub text
{
    my ($self, %options) = @_;
    $self->input('text', %options);
}

sub textarea
{
    my ($self, %options) = @_;
    $options{id} //= _dom_id($self->{name});

    my $size = delete $options{size};
    if($size && $size =~ /^(\d+)[xX](\d+)$/) {
	$options{rows} = $1;
	$options{cols} = $2;
    }

    $self->{c}->text_area($self->{name}, %options, sub { $self->{value} || '' });
}

sub each
{
    my $self = shift;
    my $block = pop;
    my $fields = $self->_to_fields;

    return $fields unless ref($block) eq 'CODE';

    local $_;
    $block->() for @$fields;

    return;
}

sub separator { $SEPARATOR; }

sub _to_string { shift->{value}; }

sub _to_fields
{
    my $self  = shift;
    my $value = $self->{value};

    my $fields = [];
    return $fields unless ref($value) eq 'ARRAY';

    my $i = -1;
    while(++$i < @$value) {
	my $path = "$self->{name}${SEPARATOR}$i";
	push @$fields, $self->{c}->fields($path, $self->{object});
    }

    $fields;
}

sub _dom_id
{
    my @name = @_;
    s/[^\w]+/-/g for @name;
    join '-', @name;
}

sub _default_label
{
    my $label = (split /\Q$SEPARATOR/, shift)[-1];
    $label =~ s/[^-a-z0-9]+/ /ig;
    ucfirst $label;
}

sub _checked_field
{
    my ($self, $value, $options) = @_;
}

sub _lookup_value
{
    my ($name, $object, $c) = @_;
    my @path = split /\Q$SEPARATOR/, $name;

    if(!$object) {
	$object = $c->stash($path[0]);
	_invalid_parameter($name, "nothing in the stash for '$path[0]'") unless $object;
    }

    # Remove the stash key for $object
    shift @path;

    while(defined(my $accessor = shift @path)) {
	my $isa = ref($object);

	# We don't handle the case where one of these return an array
	if(Scalar::Util::blessed($object) && $object->can($accessor)) {
	    $object = $object->$accessor;
	}
	elsif($isa eq 'HASH') {
	    # If blessed and !can() do we _really_ want to look inside?
	    $object = $object->{$accessor};
	}
	elsif($isa eq 'ARRAY') {
	    _invalid_parameter($name, "non-numeric index '$accessor' used to access an ARRAY")
		unless $accessor =~ /^\d+$/;

	    $object = $object->[$accessor];
	}
	else {
	    my $type = $isa || 'type that is not a reference';
	    _invalid_parameter($name, "cannot use '$accessor' on a $type");
	}
    }

    $object;
}

sub _invalid_parameter
{
    my ($field, $message) = @_;
    Carp::croak "Invalid parameter '$field': $message";
}

package Mojolicious::Plugin::FormFields::Fields;

use Mojo::Base '-strict';
use Carp ();

sub new
{
    my ($class, $c, $name, $object) = @_;
    Carp::croak 'object name required' unless $name;

    my $self = bless {
	c      => $c,
	name   => $name, #path?
	object => $object
    }, $class;

    Scalar::Util::weaken $self->{c};
    $self;
}

my $sep = Mojolicious::Plugin::FormFields::Field->separator;

for my $m (qw(checkbox fields file hidden input label password radio select text textarea)) {
    no strict 'refs';    *$m = sub {
        my $self = shift;
        my $name = shift;
        Carp::croak 'field name required' unless $name;

        my $path = "$self->{name}$sep$name";
	my $field = $self->{c}->field($path, $self->{object}, $self->{c});

	return @{$field} if $m eq 'fields';

	$field->$m(@_);
    };
}


1;

__END__