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