/ tests / cmd_helpers.pm
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;