view release on metacpan or  search on metacpan

lib/CatalystX/SimpleLogin/Form/Login.pm  view on Meta::CPAN

package CatalystX::SimpleLogin::Form::Login;
use HTML::FormHandler::Moose;
use Try::Tiny;
use namespace::autoclean;

extends 'HTML::FormHandler';
use MooseX::Types::Moose qw/ HashRef /;
use MooseX::Types::Common::String qw/ NonEmptySimpleStr /;

has '+name' => ( default => 'login_form' );

has authenticate_args => (
    is        => 'ro',
    isa       => HashRef,
    predicate => 'has_authenticate_args',
);

has authenticate_realm => (
    is        => 'ro',
    isa       => NonEmptySimpleStr,
    predicate => 'has_authenticate_realm',
);

has 'login_error_message' => (
    is => 'ro',
    isa => NonEmptySimpleStr,
    required => 1,
    default => 'Wrong username or password',
);

foreach my $type (qw/ username password /) {
    has sprintf("authenticate_%s_field_name", $type) => (
        is => 'ro',
        isa => NonEmptySimpleStr,
        default => $type
    );
    # FIXME - be able to change field names in rendered form also!
}

has_field 'username' => ( type => 'Text', tabindex => 1 );
has_field 'password' => ( type => 'Password', tabindex => 2 );
has_field 'remember' => ( type => 'Checkbox', tabindex => 3 );
has_field 'submit'   => ( type => 'Submit', value => 'Login', tabindex => 4 );

sub validate {
    my $self = shift;

    # as HTML::Formhandler doesn't handle exceptions thrown by user provided
    # validate methods and fails to clear the 'posted' attribute we need to
    # catch them
    unless (
        try {
            $self->ctx->authenticate(
            {
                (map {
                    my $param_name = sprintf("authenticate_%s_field_name", $_);
                    ($self->can($param_name) ? $self->$param_name() : $_) => $self->values->{$_};
                }
                grep { ! /remember/ }
                keys %{ $self->values }),
                ($self->has_authenticate_args ? %{ $self->authenticate_args } : ()),
            },
            ($self->has_authenticate_realm ? $self->authenticate_realm : ()),