File Coverage

lib/Web/ComposableRequest.pm

Criterion	Covered	Total	%
statement	49	49	100.0
branch	9	10	90.0
condition	6	10	60.0
subroutine	12	12	100.0
pod	1	1	100.0
total	77	82	93.9

package Web::ComposableRequest;

use 5.010001;
use namespace::autoclean;
use version; our $VERSION = qv( sprintf '0.22.%d', q$Rev: 1 $ =~ /\d+/gmx );

use Web::ComposableRequest::Constants qw( NUL );
use Unexpected::Types                 qw( CodeRef HashRef NonEmptySimpleStr
                                          Object Undef );
use Web::ComposableRequest::Util      qw( first_char is_hashref
                                          list_config_roles merge_attributes
                                          trim );
use Scalar::Util                      qw( blessed );
use Web::ComposableRequest::Base;
use Web::ComposableRequest::Config;
use Moo::Role ();
use Moo;

has 'buildargs' =>
   is      => 'lazy',
   isa     => CodeRef,
   default => sub { sub { return $_[1] } };

has 'config' =>
   is       => 'lazy',
   isa      => Object,
   default  => sub { $_[0]->config_class->new($_[0]->config_attr) },
   init_arg => undef;

has 'config_attr' =>
   is       => 'ro',
   isa      => HashRef|Object|Undef,
   init_arg => 'config';

has 'config_class' =>
   is      => 'lazy',
   isa     => NonEmptySimpleStr,
   default => sub {
      my $base  = __PACKAGE__ . '::Config';
      my @roles = list_config_roles;

      return $base unless @roles > 0;

      return Moo::Role->create_class_with_roles($base, @roles);
   };

has 'request_class' =>
   is      => 'lazy',
   isa     => NonEmptySimpleStr,
   default => sub {
      my $self = shift;
      my $base = __PACKAGE__ . '::Base';
      my $conf = $self->config_attr or return $base;
      my $dflt = { request_class => $base, request_roles => [] };
      my $attr = {};

      merge_attributes $attr, $conf, $dflt, [keys %{$dflt}];

      my @roles = @{$attr->{request_roles}};

      return $attr->{request_class} unless @roles > 0;

      @roles = map { (first_char $_ eq '+')
                     ? substr $_, 1 : __PACKAGE__ . "::Role::${_}" } @roles;

      return Moo::Role->create_class_with_roles($attr->{request_class}, @roles);
   };

sub new_from_simple_request {
   my ($self, $opts, @args) = @_;

   my $attr = { %{ $opts // {} } };
   my $request_class = $self->request_class; # Trigger role application

   $attr->{config} = $self->config;          # Composed after request_class
   $attr->{env   } = pop @args if @args and is_hashref $args[-1];
   $attr->{params} = pop @args if @args and is_hashref $args[-1];

   my $query = $attr->{env}->{'Web::Dispatch::ParamParser.unpacked_query'};

   $attr->{params} = $query if $query;

   for my $arg (grep { defined && length } @args) {
      if (blessed $arg) { $attr->{upload} = $arg }
      else {
         push @{ $attr->{args} //= [] }, map { trim $_ } split m{ / }mx, $arg;
      }
   }

   return $request_class->new($self->buildargs->($self, $attr));
}

1;

__END__