File Coverage

blib/lib/Syccess/Field.pm

Criterion	Covered	Total	%
statement	58	65	89.2
branch	13	24	54.1
condition			n/a
subroutine	7	7	100.0
pod	1	2	50.0
total	79	98	80.6

package Syccess::Field;
our $AUTHORITY = 'cpan:GETTY';
# ABSTRACT: Syccess field
$Syccess::Field::VERSION = '0.104';
use Moo;
use Module::Runtime qw( use_module );
use Module::Load::Conditional qw( can_load );

with qw(
  MooX::Traits
);

has syccess => (
  is => 'ro',
  required => 1,
  weak_ref => 1,
);

has name => (
  is => 'ro',
  required => 1,
);

has label => (
  is => 'lazy',
  init_arg => undef,
);

sub _build_label {
  my ( $self ) = @_;
  if (ref $self->validators_list eq 'HASH') {
    return $self->validators_list->{label}
      if defined $self->validators_list->{label};
  } else {
    my @validators_list = @{$self->validators_list};
    while (@validators_list) {
      my ( $key, $arg ) = splice(@validators_list,0,2);
      return $arg if $key eq 'label';
    }
  }
  my $name = $self->name;
  $name =~ s/_([a-z])/ \U$1/g;
  return ucfirst($name);
}

has validators_args => (
  is => 'ro',
  predicate => 1,
);

has validators_list => (
  is => 'ro',
  required => 1,
  init_arg => 'validators',
);

has validators => (
  is => 'lazy',
  init_arg => undef,
);

sub _build_validators {
  my ( $self ) = @_;
  my %validators_args = $self->has_validators_args
    ? (%{$self->validators_args}) : ();
  my @validators;
  my @validators_list = ref $self->validators_list eq 'HASH'
    ? ( map { $_, $self->validators_list->{$_} }
        sort { $a cmp $b }
        keys %{$self->validators_list} )
    : ( @{$self->validators_list} );
  while (@validators_list) {
    my ( $key, $arg ) = splice(@validators_list,0,2);
    next if $key eq 'label';
    my %args;
    if (ref $arg eq 'HASH') {
      %args = %{$arg};
    } else {
      $args{arg} = $arg;
    }
    $args{syccess_field} = $self;
    push @validators, $self->load_class_by_key($key)->new(
      %validators_args, %args
    );
  }
  return [ @validators ];
}

has load_class_cache => (
  is => 'ro',
  init_arg => undef,
  default => sub {{}},
);

sub load_class_by_key {
  my ( $self, $key ) = @_;
  return $self->load_class_cache->{$key} if defined $self->load_class_cache->{$key};
  my $class;
  if ($key =~ m/::/) {
    if (can_load( modules => { $key, 0 } )) {
      $class = $key;
    }
  } else {
    my $module = $key;
    $module =~ s/_([a-z])/\U$1/g;
    $module = ucfirst($module);
    my @namespaces = @{$self->syccess->validator_namespaces};
    for my $namespace (@namespaces) {
      my $can_class = $namespace.'::'.$module;
      if (can_load( modules => { $can_class, 0 } )) {
        $class = $can_class;
        last;
      }
    }
  }
  die __PACKAGE__." can't load validator for ".$key unless $class;
  return $self->load_class_cache->{$key} = use_module($class);
}

sub validate {
  my ( $self, %params ) = @_;
  my @validators = @{$self->validators};
  my @messages;
  for my $validator (@validators) {
    push @messages, $validator->validate(%params);
  }
  return @messages;
}

1;

__END__

=pod

=head1 NAME

Syccess::Field - Syccess field

=head1 VERSION

version 0.104

=head1 DESCRIPTION

This class will be used to gather all the validator objects for a specific
field of your L<Syccess> definition.

=head1 ATTRIBUTES

=head2 name

This attribute is your name for the field given on the L<Syccess> definition.

=head2 label

If not set via the validators (See L<Syccess/Label Concept>), this will be
calculated out of the L</name>, which was given on the L<Syccess/fields>
definition.

=head2 validators

Contains all the L<Syccess::Validator> object that are generated by the
fields definition on the creation of the L<Syccess> object.

=head1 METHODS

=head2 validate

This function is called by L<Syccess/validate>, and will by itself then call
I<validate> for all the validators of the field and gather the error messages
and give them back in return.

=encoding utf8

=head1 SUPPORT

IRC

  Join irc.perl.org and msg Getty

Repository

  http://github.com/Getty/p5-syccess
  Pull request and additional contributors are welcome

Issue Tracker

  http://github.com/Getty/p5-syccess/issues

=head1 AUTHOR

Torsten Raudssus <[e-mail]>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2017 by Torsten Raudssus.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut