cmd_helpers.pm
1 package cmd_helpers; 2 3 use Exporter qw(import); 4 our @EXPORT = qw(mk_opts mk_key_from mk_sig_from mk_cmd); 5 6 use List::Util qw(pairs); 7 8 sub mk_opts { 9 my @template = @_; 10 11 return sub { 12 my %opts = @_; 13 14 my @result = (); 15 foreach (pairs @template) { 16 if (defined $opts{$_->[0]}) { 17 if ($_->[1] eq 'BOOLEAN' && $opts{$_->[0]}) { 18 push @result, $_->[0]; 19 } elsif ($_->[1] eq 'HEX') { 20 push @result, $_->[0] => "'0x$opts{$_->[0]}'"; 21 } elsif ($_->[1] eq 'STRING') { 22 push @result, $_->[0] => "'$opts{$_->[0]}'"; 23 } 24 } 25 } 26 27 @result; 28 }; 29 } 30 31 sub mk_key_from { 32 my $optkey = shift; 33 34 return sub { 35 my %opts = @_; 36 37 my @result = (); 38 foreach (sort keys %{$opts{$optkey}}) { 39 my $x = '-key:' . $_; 40 if (ref $opts{$optkey}->{$_} eq 'ARRAY') { 41 push @result, 42 $x => join(',', map { '0x' . $_ } @{$opts{$optkey}->{$_}}); 43 } else { 44 push @result, $x => '0x' . $opts{$optkey}->{$_} 45 } 46 } 47 48 @result; 49 }; 50 } 51 52 sub mk_sig_from { 53 my $optkey = shift; 54 55 return sub { 56 my %opts = @_; 57 58 return ( '-sig', '0x' . $opts{$optkey} ); 59 }; 60 } 61 62 sub mk_cmd { 63 my @template = @_; 64 return sub { 65 my %opts = @_; 66 my @cmd = map { 67 my @x; 68 if (ref($_) eq 'CODE') { 69 @x = $_->(%opts); 70 } elsif(ref($_) eq '') { 71 @x = ( $_ ); 72 } else { 73 die "Command template element is not SCALAR or CODE"; 74 } 75 @x; 76 } @template; 77 return join(' ', @cmd); 78 }; 79 } 80 81 1;