File Coverage

lib/Web/ComposableRequest.pm
Criterion Covered Total %
statement 69 69 100.0
branch 13 18 72.2
condition 8 13 61.5
subroutine 17 17 100.0
pod 1 1 100.0
total 108 118 91.5


line stmt bran cond sub pod time code
1             package Web::ComposableRequest;
2              
3 1     1   1323 use 5.010001;
  1         2  
4 1     1   4 use namespace::autoclean;
  1         1  
  1         7  
5 1     1   59 use version; our $VERSION = qv( sprintf '0.18.%d', q$Rev: 1 $ =~ /\d+/gmx );
  1         1  
  1         5  
6              
7 1     1   85 use Scalar::Util qw( blessed );
  1         1  
  1         47  
8 1     1   454 use Web::ComposableRequest::Base;
  1         2  
  1         34  
9 1     1   642 use Web::ComposableRequest::Config;
  1         2  
  1         25  
10 1     1   4 use Web::ComposableRequest::Constants qw( NUL );
  1         1  
  1         6  
11 1         4 use Web::ComposableRequest::Util qw( is_hashref list_config_roles
12 1     1   146 merge_attributes trim );
  1         1  
13 1         3 use Unexpected::Types qw( CodeRef HashRef NonEmptySimpleStr
14 1     1   307 Object Undef );
  1         1  
15 1     1   551 use Moo::Role ();
  1         1  
  1         12  
16 1     1   3 use Moo;
  1         0  
  1         3  
17              
18             # Attribute constructors
19             my $_build_config = sub {
20 2     2   43 return $_[ 0 ]->config_class->new( $_[ 0 ]->config_attr );
21             };
22              
23             my $_build_config_class = sub {
24 2     2   18 my $base = __PACKAGE__.'::Config';
25 2 50       8 my @roles = list_config_roles; @roles > 0 or return $base;
  2         7  
26              
27 2         7 return Moo::Role->create_class_with_roles( $base, @roles );
28             };
29              
30             my $_build_request_class = sub {
31 2     2   14 my $self = shift;
32 2         4 my $base = __PACKAGE__.'::Base';
33 2 50       10 my $conf = $self->config_attr or return $base;
34 2         5 my $dflt = { request_class => $base, request_roles => [] };
35 2         4 my $attr = {};
36              
37 2         4 merge_attributes $attr, $conf, $dflt, [ keys %{ $dflt } ];
  2         10  
38              
39 2         3 my @roles = @{ $attr->{request_roles} };
  2         6  
40              
41 2 50       5 @roles > 0 or return $attr->{request_class};
42              
43 2 50       4 @roles = map { (substr $_, 0, 1 eq '+')
  9         31  
44             ? substr $_, 1 : __PACKAGE__."::Role::${_}" } @roles;
45              
46 2         23 return Moo::Role->create_class_with_roles( $attr->{request_class}, @roles );
47             };
48              
49             # Public attributes
50             has 'buildargs' => is => 'lazy', isa => CodeRef,
51 7     7   153 builder => sub { sub { return $_[ 1 ] } };
  2     2   41  
52              
53             has 'config' => is => 'lazy', isa => Object,
54             builder => $_build_config, init_arg => undef;
55              
56             has 'config_attr' => is => 'ro', isa => HashRef | Object | Undef,
57             init_arg => 'config';
58              
59             has 'config_class' => is => 'lazy', isa => NonEmptySimpleStr,
60             builder => $_build_config_class;
61              
62             has 'request_class' => is => 'lazy', isa => NonEmptySimpleStr,
63             builder => $_build_request_class;
64              
65             # Public methods
66             sub new_from_simple_request {
67 7   50 7 1 2003735 my ($self, $opts, @args) = @_; my $attr = { %{ $opts // {} } }; my $query;
  7         10  
  7         29  
  7         7  
68              
69 7         168 my $request_class = $self->request_class; # Trigger role application
70              
71 7         5705 $attr->{config} = $self->config; # Composed after request_class
72 7 100 66     150 @args and is_hashref $args[ -1 ] and $attr->{env } = pop @args;
73 7 100 66     23 @args and is_hashref $args[ -1 ] and $attr->{params} = pop @args;
74              
75             $query = $attr->{env}->{ 'Web::Dispatch::ParamParser.unpacked_query' }
76 7 50       18 and $attr->{params} = $query;
77              
78 7 100 66     39 if ((@args and blessed $args[ 0 ])) { $attr->{upload} = $args[ 0 ] }
  1         2  
79             else {
80 6 100       9 for my $arg (grep { defined && length } @args) {
  6         25  
81 2   50     2 push @{ $attr->{args} //= [] }, map { trim $_ } split m{ / }mx, $arg;
  2         15  
  6         11  
82             }
83             };
84              
85 7         113 return $request_class->new( $self->buildargs->( $self, $attr ) );
86             }
87              
88             1;
89              
90             __END__