File Coverage

blib/lib/Perinci/Sub/GetArgs/WebForm.pm
Criterion Covered Total %
statement 24 24 100.0
branch 3 4 75.0
condition 2 2 100.0
subroutine 5 5 100.0
pod 1 1 100.0
total 35 36 97.2


line stmt bran cond sub pod time code
1             package Perinci::Sub::GetArgs::WebForm;
2              
3             our $DATE = '2015-09-04'; # DATE
4             our $VERSION = '0.02'; # VERSION
5              
6 1     1   29556 use 5.010001;
  1         4  
7 1     1   7 use strict;
  1         2  
  1         27  
8 1     1   5 use warnings;
  1         1  
  1         38  
9              
10 1     1   5 use Exporter;
  1         1  
  1         418  
11             our @ISA = qw(Exporter);
12             our @EXPORT_OK = qw(get_args_from_webform);
13              
14             our %SPEC;
15              
16             $SPEC{get_args_from_webform} = {
17             v => 1.1,
18             summary => 'Get subroutine arguments (%args) from web form',
19             args => {
20             form => {
21             schema => 'hash*',
22             req => 1,
23             pos => 0,
24             description => <<'_',
25              
26             Either from `Plack::Request`'s `query_parameters()` or `CGI`'s `Vars()`.
27              
28             _
29             },
30             meta => {
31             schema => ['hash*' => {}],
32             description => <<'_',
33              
34             Actually not required and not currently used.
35              
36             _
37             },
38             meta_is_normalized => {
39             summary => 'Can be set to 1 if your metadata is normalized, '.
40             'to avoid duplicate effort',
41             schema => 'bool',
42             default => 0,
43             },
44             },
45             # for performance
46             args_as => 'array',
47             result_naked => 1,
48             };
49             sub get_args_from_webform {
50 3     3 1 3981 my $form = shift;
51              
52 3         6 my $args = {};
53 3         11 for (keys %$form) {
54 7 100       19 if (m!/!) {
55 3         11 my @p = split m!/!, $_;
56 3 50       8 next if @p > 10; # hardcode limit
57 3         4 my $a0 = $args;
58 3         8 for my $i (0..@p-2) {
59 5   100     21 $a0->{$p[$i]} //= {};
60 5         8 $a0 = $a0->{$p[$i]};
61             }
62 3         11 $a0->{$p[-1]} = $form->{$_};
63             } else {
64 4         9 $args->{$_} = $form->{$_};
65             }
66             }
67 3         8 $args;
68             }
69              
70             1;
71             # ABSTRACT: Get subroutine arguments (%args) from web form
72              
73             __END__