| 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__ |