File Coverage

blib/lib/HTML/Shakan.pm

Criterion	Covered	Total	%
statement	128	128	100.0
branch	30	38	78.9
condition	1	3	33.3
subroutine	30	30	100.0
pod	5	7	71.4
total	194	206	94.1

package HTML::Shakan;
use strict;
use warnings;
use Mouse;
our $VERSION = '2.00';
use Carp ();
use 5.008001;

use FormValidator::Lite 'Email', 'URL', 'Date', 'File';
use Hash::MultiValue;

use HTML::Shakan::Renderer::HTML;
use HTML::Shakan::Filters;
use HTML::Shakan::Widgets::Simple;
use HTML::Shakan::Fields;
use HTML::Shakan::Field::Input;
use HTML::Shakan::Field::Date;
use HTML::Shakan::Field::Choice;
use HTML::Shakan::Field::File;
use List::MoreUtils 'uniq';

sub import {
    HTML::Shakan::Fields->export_to_level(1);
}

has '_fvl' => (
    is => 'ro',
    isa => 'FormValidator::Lite',
    lazy => 1,
    handles => [qw/has_error load_function_message get_error_messages is_error is_valid set_error set_message/],
    default => sub {
        my $self = shift;
        $self->params(); # build laziness data

        FormValidator::Lite->new($self);
    }
);

sub BUILD {
    my $self = shift;

    my $fvl = $self->_fvl;

    # simple check
    $fvl->check(do {
        my @c;
        for my $field (@{ $self->fields }) {
            push @c, $field->get_constraints();
        }
        @c;
    });

    # run custom validation
    if (my $cv = $self->custom_validation) {
        $cv->( $self );
    }
    for my $field ($self->fields) {
        if (my $cv = $field->custom_validation) {
            $cv->($self, $field);
        }
    }

    if ($fvl->is_valid) {
        $self->_inflate_values();
    } else {
        $fvl->set_param_message(
            $self->_set_error_messages()
        );
    }
}

has custom_validation => (
    is => 'ro',
    isa => 'CodeRef',
);

sub _set_error_messages {
    my ($self, ) = @_;

    my %x;
    for my $field ($self->fields) {
        $x{$field->name} = $field->label || $field->name;
    }
    %x;
}

sub _inflate_values {
    my $self = shift;

    # inflate values
    my $params = $self->params;
    for my $field (@{ $self->fields }) {
        if (my $inf = $field->inflator) {
            my $v = $params->{$field->name};
            if (defined $v) {
                $params->{$field->name} = $inf->inflate($v);
            }
        }
    }
}

has 'submitted' => (
    is => 'ro',
    isa => 'Bool',
    lazy => 1,
    builder => '_build_submitted',
);
sub _build_submitted {
    my ($self, ) = @_;

    my $r = $self->request;
    my $submitted_field = (
        scalar
          grep { defined $r->param($_) || defined $r->upload($_) }
          uniq
          map  { $_->name }
                 $self->fields
    );
    return $submitted_field > 0 ? 1 : 0;
}

sub submitted_and_valid {
    my $self = shift;
    $self->submitted && $self->is_valid;
}

has model => (
    is => 'rw',
    isa => 'Object',
    trigger => sub {
        my ($self, $model) = @_;
        $model->form($self);
        $model;
    },
);

has renderer => (
    is => 'rw',
    isa => 'Object',
    builder => '_build_renderer',
);
sub _build_renderer {
    HTML::Shakan::Renderer::HTML->new();
}
sub render {
    my $self = shift;
    $self->renderer()->render($self);
}

sub render_field {
    my ( $self, $name ) = @_;
    my ( $field, ) = grep { $_->name eq $name } $self->fields;
    return unless $field;
    return $self->widgets->render( $self, $field );
}

sub fillin_param {
    my ($self, $key) = @_;
    $self->fillin_params->{$key};
}
has fillin_params => (
    is => 'ro',
    isa => 'HashRef',
    lazy => 1,
    default => sub {
        my $self = shift;
        my $fp = {};
        for my $name ($self->request->param) {
            my @v = $self->request->param($name);
            if (@v) {
                $fp->{$name} = @v==1 ? $v[0] : \@v;
            }
        }
        $fp;
    },
);

has fields => (
    is       => 'ro',
    isa      => 'ArrayRef',
    required => 1,
    auto_deref => 1,
);

has request => (
    is       => 'ro',
    isa      => 'Object',
    required => 1,
);

has 'widgets' => (
    is => 'ro',
    isa => 'Str',
    default => 'HTML::Shakan::Widgets::Simple',
);

has 'params' => (
    is => 'rw',
    isa => 'Hash::MultiValue',
    lazy => 1,
    builder => '_build_params',
);

has 'uploads' => (
    is => 'rw',
    isa => 'HashRef',
    default => sub { +{} },
);
sub upload {
    my ($self, $name) = @_;
    $self->uploads->{$name};
}

# code taken from MooseX::Param and changed a bit
sub param {
    my $self = shift;

    my $params = $self->params;

    # if they want the list of keys ...
    return $params->keys if scalar @_ == 0;

    # if they want to fetch a particular key ...
    if (scalar @_ == 1) {
        return wantarray ? $params->get_all($_[0]) : $params->get($_[0]);
    }

    ( ( scalar @_ % 2 ) == 0 ) || confess "parameter assignment must be an even numbered list";

    my %new = @_;
    while ( my ( $key, $value ) = each %new ) {
        my @values = ref $value eq 'ARRAY' ? @$value : ($value);
        $self->params->set($key, @values);
    }
    return;
}

sub _build_params {
    my $self = shift;
    my $params = {};
    for my $field (@{$self->fields}) {
        if ($self->widgets->can('field_filter')) {
            # e.g. DateField
            $self->widgets->field_filter($self, $field, $params);
        }
        if ($field->can('field_filter')) {
            # e.g. FileField
            $field->field_filter($self, $params);
        }

        my $name = $field->name;

        my @val = $self->request->param($name);
        if (@val != 0) {
            if ( my $filters = $field->{filters} ) {
                @val = map { HTML::Shakan::Filters->filter( $filters, $_ ) } @val;
            }
            $params->{$name} = @val==1 ? $val[0] : \@val;
        }
    }

    Hash::MultiValue->from_mixed($params);
}

no Mouse;
__PACKAGE__->meta->make_immutable;
__END__