File Coverage

blib/lib/JSON/Karabiner/Manipulator/Actions/To.pm
Criterion Covered Total %
statement 99 103 96.1
branch 31 40 77.5
condition 14 16 87.5
subroutine 13 13 100.0
pod 7 7 100.0
total 164 179 91.6


line stmt bran cond sub pod time code
1             package JSON::Karabiner::Manipulator::Actions::To ;
2             $JSON::Karabiner::Manipulator::Actions::To::VERSION = '0.017';
3 12     12   3790 use strict;
  12         40  
  12         590  
4 12     12   112 use warnings;
  12         54  
  12         305  
5 12     12   67 use JSON;
  12         21  
  12         61  
6 12     12   1337 use Carp;
  12         25  
  12         765  
7 12     12   1481 use parent 'JSON::Karabiner::Manipulator::Actions';
  12         977  
  12         111  
8              
9             sub new {
10 21     21 1 50 my $class = shift;
11 21         51 my ($type, $value) = @_;
12 21         107 my $obj = $class->SUPER::new($type, $value);
13             $obj->{data} = $value || [],
14             $obj->{shell_command} => 0,
15             $obj->{select_input_source} => 0,
16             $obj->{select_input_source_data} => '',
17             $obj->{set_variable} => 0,
18 21   50     245 $obj->{mouse_key} => 0,
19             return $obj;
20             }
21              
22             sub add_key_code {
23 78     78 1 20866 my $s = shift;
24 78         147 my @key_codes;
25 78 50       202 if (ref $s) {
26 78         210 @key_codes = @_;
27             } else {
28 0         0 @key_codes = ($s, @_);
29 0         0 $s = $main::current_action;
30             }
31 78         139 my $last_arg = $key_codes[-1];
32 78         124 my $input_type = 'key_code';
33 78 100 100     463 if ($last_arg && $last_arg =~ /^any|consumer_key_code|pointing_button$/) {
34 12         24 $input_type = $last_arg;
35 12         23 pop @key_codes;
36             }
37 78 100       332 croak 'No key code passed' if !@key_codes;
38 72 50       197 croak 'You can only set one key_code, consumer_key_code, pointing_button or any' if ($s->{code_set});
39             #TODO: validate $key_code
40              
41 72         264 $s->_is_exclusive($input_type);
42              
43 72         147 foreach my $key_code (@key_codes) {
44 90         208 my %hash;
45             my $letter_code;
46 90         0 my $ms;
47 90 100       377 if ($key_code =~ /-([A-Z])|(\d+)$/) {
48 24         65 $letter_code = $1;
49 24         54 $ms = $2;
50 24         120 $key_code =~ s/-(.*?)$//;
51             }
52              
53 90         208 $hash{$input_type} = $key_code;
54 90 100 100     251 $hash{lazy} = JSON::true if $letter_code && $letter_code eq 'L';
55 90 100 100     249 $hash{halt} = JSON::true if $letter_code && $letter_code eq 'H';
56 90 100 100     247 $hash{repeat} = JSON::true if $letter_code && $letter_code eq 'R';
57 90 100       223 $hash{hold_down_milliseconds} = $ms if $ms;
58 90         280 $s->_push_data(\%hash);
59 90         395 $s->{last_key_code} = \%hash;
60             }
61             }
62              
63             sub _push_data {
64 121     121   216 my $s = shift;
65 121         175 my $data = shift;
66 121 100       288 if ($s->{def_name} eq 'to_delayed_action') {
67 39 100       77 if ($s->{delayed_type} eq 'invoked') {
68 20         26 push @{$s->{data}{to_if_invoked}}, $data;
  20         73  
69             } else {
70 19         30 push @{$s->{data}{to_if_canceled}}, $data;
  19         59  
71             }
72             } else {
73 82         111 push @{$s->{data}}, $data;
  82         262  
74             }
75             }
76              
77             sub add_shell_command {
78 6     6 1 205 my $s = shift;
79              
80 6         24 $s->_is_exclusive('shell_command');
81 6         12 my $value = shift;
82 6         11 my %hash;
83 6         13 $hash{shell_command} = $value;
84 6         27 $s->_push_data(\%hash);
85             }
86              
87             sub add_select_input_source {
88 12     12 1 378 my $s = shift;
89 12         43 $s->_is_exclusive('select_input_source');
90 12         21 my $option = shift;
91 12         26 my $value = shift;
92 12 50       76 if ($option !~ /^language|input_source_id|input_mode_id$/) {
93 0         0 croak "Invalid option: $option";
94             }
95              
96             #TODO: determing if key alredy exists
97             # find existing hash ref
98 12         23 my $existing = $s->{select_input_source_data};
99 12   50     51 my $select_input_source = $existing || { };
100              
101 12         32 $select_input_source->{$option} = $value;
102 12 50       50 $s->_push_data( { select_input_source => $select_input_source } ) if !$existing;
103             }
104              
105             sub add_set_variable {
106 7     7 1 251 my $s = shift;
107 7         29 $s->_is_exclusive('set_variable');
108 7         14 my $name = shift;
109 7 50       24 croak 'No name passed' unless defined $name;
110 7         15 my $value = shift;
111 7 50       23 croak 'No value passed' unless defined $value;
112              
113 7 100       35 if ($value =~ /^\d+$/) {
114 1         3 $value = $value + 0;
115             }
116              
117 7         13 my %hash;
118 7         21 $hash{set_variable}{name} = $name;
119 7         35 $hash{set_variable}{value} = $value;
120 7         27 $s->_push_data(\%hash);
121             }
122              
123             sub add_mouse_key {
124 6     6 1 211 my $s = shift;
125 6         23 $s->_is_exclusive('mouse_key');
126 6         11 my $name = shift;
127 6 50       29 croak 'No name passed' unless $name;
128 6         11 my $value = shift;
129 6 50       25 croak 'No value passed' unless defined $value;
130              
131             #TODO: make sure $names have not been set already
132             #TODO: make sure names are valid
133 6         13 my %hash;
134 6         25 $hash{mouse_key}{$name} = $value;
135 6         19 $s->_push_data(\%hash);
136             }
137              
138             sub add_modifiers {
139 12     12 1 379 my $s = shift;
140 12         27 my $lkc = $s->{last_key_code};
141 12 100       103 croak 'Nothing to attach the modifiers to' if !$lkc;
142 6         12 my $existing = [];
143 6 50       21 if (exists $lkc->{modifiers} ) {
144 0         0 $existing = $lkc->{modifiers};
145             }
146              
147             #TODO: check that modifiers are valid
148 6         17 my @modifiers = @_;
149 6         17 push @$existing, @modifiers;
150 6         38 $lkc->{modifiers} = $existing;
151             }
152              
153             # ABSTRACT: To action
154              
155             1;
156              
157             __END__