The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Form::Factory::Feature::Control::Length;
BEGIN {
  $Form::Factory::Feature::Control::Length::VERSION = '0.020';
}
use Moose;

with qw( 
    Form::Factory::Feature 
    Form::Factory::Feature::Role::Check
    Form::Factory::Feature::Role::Control
    Form::Factory::Feature::Role::CustomControlMessage
);

use Carp ();

=head1 NAME

Form::Factory::Feature::Control::Length - A control feature for checking length

=head1 VERSION

version 0.020

=head1 SYNOPSIS

  has_control login_name => (
      control => 'text',
      feature => {
          length => {
              minimum => 3,
              maximum => 15,
          },
      },
  );

=head1 DESCRIPTION

Linked to a control, it checks to see that the string is not too short or too long.

=head1 ATTRIBUTES

=head2 minumum

The optional minimum length permitted for the string.

=cut

has minimum => (
    is        => 'ro',
    isa       => 'Int',
    predicate => 'has_minimum',
);

=head2 maximum

The optional maximum length permitted for the string.

=cut

has maximum => (
    is        => 'ro',
    isa       => 'Int',
    predicate => 'has_maximum',
);

sub BUILDARGS {
    my $class = shift;
    my $args  = @_ == 1 ? $_[0] : { @_ };

    if (defined $args->{minimum} and defined $args->{maximum}
            and $args->{minimum} >= $args->{maximum}) {
        Carp::croak('length minimum must be less than maximum');
    }

    return $class->SUPER::BUILDARGS(@_);
}

=head1 METHODS

=head2 check_control

Makes sure the value is a L<Form::Factory::Control::Role::ScalarValue>.

=cut

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

    return if $control->does('Form::Factory::Control::Role::ScalarValue');

    Carp::croak("the length feature only works with scalar values\n");
}

=head2 check

Verifies that the value of the control is not too short or too long.

=cut

sub check {
    my $self  = shift;
    my $value = $self->control->current_value;

    return if length($value) == 0;

    if ($self->has_minimum and length($value) < $self->minimum) {
        $self->control_error(
            "the %s must be at least @{[$self->minimum]} characters long"
        );
        $self->result->is_valid(0);
    }

    if ($self->has_maximum and length($value) > $self->maximum) {
        $self->control_error(
            "the %s must be no longer than @{[$self->maximum]} characters"
        );
        $self->result->is_valid(0);
    }

    $self->result->is_valid(1) unless $self->result->is_validated;
}

=head1 AUTHOR

Andrew Sterling Hanenkamp C<< <hanenkamp@cpan.org> >>

=head1 COPYRIGHT AND LICENSE

Copyright 2009 Qubling Software LLC.

This library is free software. You can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;