The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Form::Factory::Result;
$Form::Factory::Result::VERSION = '0.021';
use Moose::Role;

use Form::Factory::Message;

=head1 NAME

Form::Factory::Result - Interface for the result classes

=head1 VERSION

version 0.021

=head1 SYNOPSIS

  my $result = $action->results;

  if ($result->is_validated and $result->is_valid) {
      print "Action passed validation.\n";
  }

  if ($result->is_outcome_known and $result->is_success) {
      print "Action successfully processed.\n";
  }

  print "EXTRA INFO: ", $result->content->{extra_info}, "\n";

  print "Messages: ", $result->all_messages, "\n";

=head1 DESCRIPTION

After an action has run in part or in whole, a result class will contain the current state of that sucess or failure.

=head1 METHODS

=head2 is_failure

The opposite of L</is_success>.

=cut

# requires qw(
#     is_valid is_validated
#     is_success is_outcome_known
#     content
#     messages
# );

sub is_failure {
    my $self = shift;
    return not $self->is_success;
}

=head2 all_messages

  my $messages = $result->all_messages;
  my @messages = $result->all_messages;

Returns all messages. When a scalar is expected, it returns all messages concatenated with a newline between each. When a list is expected, it returns a list of L<Form::Factory::Message> objects.

=cut

sub _return(&@) {
    my ($filter, @messages) = @_;
    
    my @filtered = grep { $filter->() } @messages;
    return wantarray ? @filtered : join "\n", map { $_->message } @filtered;
}

sub all_messages {
    my $self = shift;
    return _return { 1 } @{ $self->messages };
}

=head2 info_messages

  my $messages = $result->info_messages;
  my @messages = $result->info_messages;

Returns all mesages with type info. Handles context the same as L</all_messages>.

=cut

sub info_messages {
    my $self = shift;
    return _return { $_->type eq 'info' } @{ $self->messages };
}

=head2 warning_messages

  my $messages = $result->warning_messages;
  my @messages = $result->warning_messages;

Returns all messages with type warning. Handles context the same as L</all_messages>.

=cut

sub warning_messages {
    my $self = shift;
    return _return { $_->type eq 'warning' } @{ $self->messages };
}

=head2 error_messages

  my $messages = $result->error_messages;
  my @messages = $result->error_messages;

Returns all messages with type error. Handles context the same as L</all_messages>.

=cut

sub error_messages {
    my $self = shift;
    return _return { $_->type eq 'error' } @{ $self->messages };
}

=head2 regular_messages

  my $messages = $result->regular_messages;
  my @messages = $result->regular_messages;

Returns all messages that are not tied to a field. Handles context the same as L</all_messages>.

=cut

sub regular_messages {
    my $self = shift;
    return _return { not $_->is_tied_to_field } @{ $self->messages };
}

=head2 regular_info_messages

  my $messages = $result->regular_info_messages;
  my @messages = $result->regular_info_messages;

Returns all messages with type info that are not tied to a field. Handles context the same as L</all_messages>.

=cut

sub regular_info_messages {
    my $self = shift;
    return _return { not $_->is_tied_to_field and $_->type eq 'info' } 
               @{ $self->messages };
}

=head2 regular_warning_messages

  my $messages = $result->regular_warning_messages;
  my @messages = $result->regular_warning_messages;

Returns all messages with type warning that are not tied to a feild. Handles context the same as L</all_messages>.

=cut

sub regular_warning_messages {
    my $self = shift;
    return _return { not $_->is_tied_to_field and $_->type eq 'warning' }
               @{ $self->messages };
}

=head2 regular_error_messages

  my $messages = $result->regular_error_messages;
  my @messages = $result->regular_error_messages;

Returns all messages with type error that are not tied to a field. Handles context the same as L</all_messages>.

=cut

sub regular_error_messages {
    my $self = shift;
    return _return { not $_->is_tied_to_field and $_->type eq 'error' } 
               @{ $self->messages };
}

=head2 field_messages

  my $messages = $result->field_messages($field);
  my @messages = $result->field_messages($field);

Returns all messages that are tied to a particular field. Handles context the same as L</all_messages>.

=cut

sub field_messages {
    my ($self, $field) = @_;
    return _return { $_->is_tied_to_field and $_->field eq $field } 
               @{ $self->messages };
}

=head2 field_info_messages

  my $messages = $result->field_info_messages($field);
  my @messages = $result->field_info_messages($field);

Returns all messages with type info that are tied to a particular field. Handles context the same as L</all_messages>.

=cut

sub field_info_messages {
    my ($self, $field) = @_;
    return _return { $_->is_tied_to_field and $_->field eq $field and $_->type eq 'info'} 
               @{ $self->messages };
}

=head2 field_warning_messages

  my $messages = $result->field_warning_messages($field);
  my @messages = $result->field_warning_messages($field);

Returns all messages with type warning tied to a particular field. Handles context the same as L</all_messages>.

=cut

sub field_warning_messages {
    my ($self, $field) = @_;
    return _return { $_->is_tied_to_field and $_->field eq $field and $_->type eq 'warning'} 
               @{ $self->messages };
}

=head2 field_error_messages

  my $messages = $result->field_error_messages($field);
  my @messages = $result->field_error_messages($field);

Returns all messages with type error tied to a particular field. Handles context the same as L</all_messages>.

=cut

sub field_error_messages {
    my ($self, $field) = @_;
    return _return { $_->is_tied_to_field and $_->field eq $field and $_->type eq 'error'} 
               @{ $self->messages };
}

=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;