File Coverage

blib/lib/Perinci/Sub/ConvertArgs/Array.pm
Criterion Covered Total %
statement 31 31 100.0
branch 12 16 75.0
condition 3 4 75.0
subroutine 5 5 100.0
pod 1 1 100.0
total 52 57 91.2


line stmt bran cond sub pod time code
1             package Perinci::Sub::ConvertArgs::Array;
2              
3             our $DATE = '2015-12-29'; # DATE
4             our $VERSION = '0.08'; # VERSION
5              
6 1     1   20863 use 5.010001;
  1         3  
7 1     1   4 use strict;
  1         2  
  1         21  
8 1     1   5 use warnings;
  1         2  
  1         30  
9              
10 1     1   4 use Exporter;
  1         2  
  1         410  
11             our @ISA = qw(Exporter);
12             our @EXPORT_OK = qw(convert_args_to_array);
13              
14             our %SPEC;
15              
16             $SPEC{convert_args_to_array} = {
17             v => 1.1,
18             summary => 'Convert hash arguments to array',
19             description => <<'_',
20              
21             Using information in 'args' property (particularly the 'pos' and 'greedy' of
22             each argument spec), convert hash arguments to array.
23              
24             Example:
25              
26             my $meta = {
27             v => 1.1,
28             summary => 'Multiply 2 numbers (a & b)',
29             args => {
30             a => ['num*' => {arg_pos=>0}],
31             b => ['num*' => {arg_pos=>1}],
32             }
33             }
34              
35             then 'convert_args_to_array(args=>{a=>2, b=>3}, meta=>$meta)' will produce:
36              
37             [200, "OK", [2, 3]]
38              
39             _
40             args => {
41             args => {req=>1, schema=>'hash*', pos=>0},
42             meta => {req=>1, schema=>'hash*', pos=>1},
43             },
44             };
45             sub convert_args_to_array {
46 10     10 1 25091 my %input_args = @_;
47 10 50       37 my $args = $input_args{args} or return [400, "Please specify args"];
48 10 50       26 my $meta = $input_args{meta} or return [400, "Please specify meta"];
49 10   50     27 my $args_prop = $meta->{args} // {};
50              
51 10   100     29 my $v = $meta->{v} // 1.0;
52 10 100       43 return [412, "Sorry, only metadata version 1.1 is supported (yours: $v)"]
53             unless $v == 1.1;
54              
55             #$log->tracef("-> convert_args_to_array(), args=%s", $args);
56              
57 9         13 my @array;
58              
59 9         34 while (my ($k, $v) = each %$args) {
60 11 50       26 next if $k =~ /\A-/; # skip special arguments
61 11         20 my $as = $args_prop->{$k};
62 11 100       27 return [412, "Argument $k: Not specified in args property"] unless $as;
63 10         15 my $pos = $as->{pos};
64 10 50       22 return [412, "Argument $k: No pos specified in arg spec"]
65             unless defined $pos;
66 10 100       20 if ($as->{greedy}) {
67 3 100       11 $v = [$v] if ref($v) ne 'ARRAY';
68             # splice can't work if $pos is beyond array's length
69 3         12 for (@array .. $pos-1) {
70 1         3 $array[$_] = undef;
71             }
72 3         14 splice @array, $pos, 0, @$v;
73             } else {
74 7         28 $array[$pos] = $v;
75             }
76             }
77 8         33 [200, "OK", \@array];
78             }
79              
80             1;
81             # ABSTRACT: Convert hash arguments to array
82              
83             __END__