| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Perinci::Sub::ConvertArgs::Array; | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | our $DATE = '2015-09-03'; # DATE | 
| 4 |  |  |  |  |  |  | our $VERSION = '0.07'; # VERSION | 
| 5 |  |  |  |  |  |  |  | 
| 6 | 1 |  |  | 1 |  | 20555 | use 5.010001; | 
|  | 1 |  |  |  |  | 3 |  | 
| 7 | 1 |  |  | 1 |  | 4 | use strict; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 24 |  | 
| 8 | 1 |  |  | 1 |  | 4 | use warnings; | 
|  | 1 |  |  |  |  | 3 |  | 
|  | 1 |  |  |  |  | 31 |  | 
| 9 |  |  |  |  |  |  |  | 
| 10 | 1 |  |  | 1 |  | 4 | use Exporter; | 
|  | 1 |  |  |  |  | 2 |  | 
|  | 1 |  |  |  |  | 375 |  | 
| 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 | 22606 | my %input_args   = @_; | 
| 47 | 10 | 50 |  |  |  | 30 | my $args         = $input_args{args} or return [400, "Please specify args"]; | 
| 48 | 10 | 50 |  |  |  | 24 | my $meta         = $input_args{meta} or return [400, "Please specify meta"]; | 
| 49 | 10 |  | 50 |  |  | 27 | my $args_prop    = $meta->{args} // {}; | 
| 50 |  |  |  |  |  |  |  | 
| 51 | 10 |  | 100 |  |  | 38 | my $v = $meta->{v} // 1.0; | 
| 52 | 10 | 100 |  |  |  | 35 | 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 |  |  |  |  | 11 | my @array; | 
| 58 |  |  |  |  |  |  |  | 
| 59 | 9 |  |  |  |  | 32 | while (my ($k, $v) = each %$args) { | 
| 60 | 11 |  |  |  |  | 15 | my $as = $args_prop->{$k}; | 
| 61 | 11 | 100 |  |  |  | 27 | return [412, "Argument $k: Not specified in args property"] unless $as; | 
| 62 | 10 |  |  |  |  | 13 | my $pos = $as->{pos}; | 
| 63 | 10 | 50 |  |  |  | 20 | return [412, "Argument $k: No pos specified in arg spec"] | 
| 64 |  |  |  |  |  |  | unless defined $pos; | 
| 65 | 10 | 100 |  |  |  | 20 | if ($as->{greedy}) { | 
| 66 | 3 | 100 |  |  |  | 13 | $v = [$v] if ref($v) ne 'ARRAY'; | 
| 67 |  |  |  |  |  |  | # splice can't work if $pos is beyond array's length | 
| 68 | 3 |  |  |  |  | 12 | for (@array .. $pos-1) { | 
| 69 | 0 |  |  |  |  | 0 | $array[$_] = undef; | 
| 70 |  |  |  |  |  |  | } | 
| 71 | 3 |  |  |  |  | 16 | splice @array, $pos, 0, @$v; | 
| 72 |  |  |  |  |  |  | } else { | 
| 73 | 7 |  |  |  |  | 27 | $array[$pos] = $v; | 
| 74 |  |  |  |  |  |  | } | 
| 75 |  |  |  |  |  |  | } | 
| 76 | 8 |  |  |  |  | 32 | [200, "OK", \@array]; | 
| 77 |  |  |  |  |  |  | } | 
| 78 |  |  |  |  |  |  |  | 
| 79 |  |  |  |  |  |  | 1; | 
| 80 |  |  |  |  |  |  | # ABSTRACT: Convert hash arguments to array | 
| 81 |  |  |  |  |  |  |  | 
| 82 |  |  |  |  |  |  | __END__ |