File Coverage

blib/lib/Rex/Dondley/ProcessTaskArgs.pm
Criterion Covered Total %
statement 60 62 96.7
branch 27 30 90.0
condition 15 21 71.4
subroutine 3 3 100.0
pod 1 1 100.0
total 106 117 90.6


line stmt bran cond sub pod time code
1             package Rex::Dondley::ProcessTaskArgs ;
2             $Rex::Dondley::ProcessTaskArgs::VERSION = '0.010';
3 4     4   71737 use strict;
  4         27  
  4         119  
4 4     4   22 use warnings;
  4         8  
  4         2698  
5              
6             require Exporter;
7             our @ISA = qw(Exporter);
8             our @EXPORT = 'process_task_args';
9              
10             # checks validity of args passed to functions and assigns them to appropriate keys
11             # Accept 3 sets of args:
12             # first arg is reference to parameters passed by user to task
13             # next set of args is a list of allowed params which can also indicate required params
14             # last arg is an array hash for default values corresponding to each allowed params
15             sub process_task_args {
16 34 50 33 34 1 931832 if (!$_[0] || (ref $_[0]) ne 'ARRAY') {
17 0         0 die 'First argument must be an array ref to user supplied arguments.';
18             }
19              
20             # standardize the argument data structure
21 34 100 66     496 if (ref $_[0] && ref $_[0]->[0] ne 'HASH') {
22 7         53 my @args = @{$_[0]};
  7         75  
23 7         54 shift @_;
24 7         178 @_ = ([ {}, \@args,], @_ );
25             }
26              
27 34         113 my $passed_in = shift @_;
28 34         77 my %passed_params = %{$passed_in->[0]};
  34         281  
29 34         93 my @unkeyed_args = @{$passed_in->[1]};
  34         111  
30 34 100       165 my @defaults = ref $_[-1] ? @{$_[-1]} : ();
  6         42  
31 34 100       127 pop @_ if @defaults;
32 34         240 my @valid_args = @_;
33 34 100 100     102 my @key_list = grep { $_ && $_ ne '1' && (ref $_) ne 'ARRAY' } @_;
  133         1066  
34              
35 34         93 my %defaults = ();
36 34         81 my $count = 0;
37 34         207 foreach my $key (@key_list) {
38 72         501 $defaults{$key} = $defaults[$count++];
39             }
40              
41             # create a hash of valid and required keys
42             # assumes all values are not required if @valid_args do not contain required value
43 34         94 my %valid_keys = ();
44 34 100 100     1195 if ((exists $valid_args[1] && ($valid_args[1] !~ /^0|1$/)) || scalar @valid_args == 1) { # checks to see if list contains required values
      100        
45 7         43 foreach my $arg (@valid_args) {
46 11         46 $valid_keys{$arg} = 0;
47             }
48             } else {
49 27         153 %valid_keys = @valid_args;
50             }
51              
52             # check to see if passed parameters are valid
53 34         165 my @invalid_keys;
54 34         113 foreach my $key (keys %passed_params) {
55 22         144 my $is_valid = grep { $_ eq $key } keys %valid_keys;
  48         142  
56 22 100       117 if (!$is_valid) {
57 2         16 push @invalid_keys, $key;
58             }
59 22 100       185 die ("Invalid key(s): '" . join (', ', @invalid_keys) . "' from ". (caller)[1] . ', line ' . (caller)[2]) if @invalid_keys;
60             }
61              
62              
63             # Populate the %passed_params hash with @unkeyed_args according
64             # to same order they were passed to this function via @valid_args.
65             # Throw error if there are more args than available keys.
66 32 100       101 if (@unkeyed_args) {
67 12         72 my @all_array_args = @unkeyed_args;
68 12         41 foreach my $array_arg (@unkeyed_args) {
69 19         44 foreach my $vkey (@key_list) {
70 27 100       86 if (exists $passed_params{$vkey}) {
71 9         36 next;
72             }
73 18         53 $passed_params{$vkey} = $array_arg;
74 18         33 shift @all_array_args;
75              
76 18         48 last;
77             }
78             }
79 12 100       49 die ('Too many array arguments passed from ' . (caller)[1] . ', line ' . (caller)[2] ) if @all_array_args;
80              
81             }
82              
83             # Ensure required args are present
84 31         101 my @reqd_keys = grep { $valid_keys{$_} } keys %valid_keys;
  68         276  
85 31         132 my @missing_keys;
86              
87 31         107 foreach my $rkey(@reqd_keys) {
88 23 100 66     316 if (!exists $passed_params{$rkey} || $passed_params{$rkey} eq '1') {
89 10 100       63 push @missing_keys, $rkey unless $defaults{$rkey};
90             }
91             }
92 31 100       256 die ("Missing required key(s): '" . join (', ', @missing_keys) . "' from " . (caller)[1] . ', line ' . (caller)[2]) if @missing_keys;
93              
94             # handle edge case when user passes key without value
95 27         131 foreach my $key (keys %passed_params) {
96 34 0 33     184 if ($passed_params{$key} eq '1' && $valid_keys{$key}) {
97 0         0 delete $passed_params{$key};
98             }
99             }
100 27         156 my %return_hash = (%defaults, %passed_params);
101              
102              
103 27         430 return \%return_hash;
104             }
105             # methods here
106              
107             1; # Magic true value
108             # ABSTRACT: easier Rex task argument handling
109              
110             __END__