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.018';
3 12     12   3698 use strict;
  12         28  
  12         544  
4 12     12   97 use warnings;
  12         50  
  12         345  
5 12     12   71 use JSON;
  12         23  
  12         66  
6 12     12   1341 use Carp;
  12         26  
  12         832  
7 12     12   1515 use parent 'JSON::Karabiner::Manipulator::Actions';
  12         986  
  12         74  
8              
9             sub new {
10 21     21 1 48 my $class = shift;
11 21         55 my ($type, $value) = @_;
12 21         112 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     215 $obj->{mouse_key} => 0,
19             return $obj;
20             }
21              
22             sub add_key_code {
23 78     78 1 21518 my $s = shift;
24 78         131 my @key_codes;
25 78 50       206 if (ref $s) {
26 78         170 @key_codes = @_;
27             } else {
28 0         0 @key_codes = ($s, @_);
29 0         0 $s = $main::current_action;
30             }
31 78         141 my $last_arg = $key_codes[-1];
32 78         117 my $input_type = 'key_code';
33 78 100 100     446 if ($last_arg && $last_arg =~ /^any|consumer_key_code|pointing_button$/) {
34 12         25 $input_type = $last_arg;
35 12         23 pop @key_codes;
36             }
37 78 100       321 croak 'No key code passed' if !@key_codes;
38 72 50       1073 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         271 $s->_is_exclusive($input_type);
42              
43 72         175 foreach my $key_code (@key_codes) {
44 90         209 my %hash;
45             my $letter_code;
46 90         0 my $ms;
47 90 100       309 if ($key_code =~ /-([A-Z])|-(\d+)$/) {
48 24         63 $letter_code = $1;
49 24         59 $ms = $2;
50 24         122 $key_code =~ s/-(.*?)$//;
51             }
52              
53 90         255 $hash{$input_type} = $key_code;
54 90 100 100     252 $hash{lazy} = JSON::true if $letter_code && $letter_code eq 'L';
55 90 100 100     248 $hash{halt} = JSON::true if $letter_code && $letter_code eq 'H';
56 90 100 100     250 $hash{repeat} = JSON::true if $letter_code && $letter_code eq 'R';
57 90 100       214 $hash{hold_down_milliseconds} = $ms if $ms;
58 90         247 $s->_push_data(\%hash);
59 90         391 $s->{last_key_code} = \%hash;
60             }
61             }
62              
63             sub _push_data {
64 121     121   184 my $s = shift;
65 121         207 my $data = shift;
66 121 100       287 if ($s->{def_name} eq 'to_delayed_action') {
67 39 100       74 if ($s->{delayed_type} eq 'invoked') {
68 20         30 push @{$s->{data}{to_if_invoked}}, $data;
  20         65  
69             } else {
70 19         28 push @{$s->{data}{to_if_canceled}}, $data;
  19         64  
71             }
72             } else {
73 82         121 push @{$s->{data}}, $data;
  82         250  
74             }
75             }
76              
77             sub add_shell_command {
78 6     6 1 222 my $s = shift;
79              
80 6         25 $s->_is_exclusive('shell_command');
81 6         14 my $value = shift;
82 6         12 my %hash;
83 6         14 $hash{shell_command} = $value;
84 6         20 $s->_push_data(\%hash);
85             }
86              
87             sub add_select_input_source {
88 12     12 1 386 my $s = shift;
89 12         48 $s->_is_exclusive('select_input_source');
90 12         25 my $option = shift;
91 12         20 my $value = shift;
92 12 50       72 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         27 my $existing = $s->{select_input_source_data};
99 12   50     53 my $select_input_source = $existing || { };
100              
101 12         38 $select_input_source->{$option} = $value;
102 12 50       55 $s->_push_data( { select_input_source => $select_input_source } ) if !$existing;
103             }
104              
105             sub add_set_variable {
106 7     7 1 258 my $s = shift;
107 7         33 $s->_is_exclusive('set_variable');
108 7         15 my $name = shift;
109 7 50       26 croak 'No name passed' unless defined $name;
110 7         16 my $value = shift;
111 7 50       22 croak 'No value passed' unless defined $value;
112              
113 7 100       48 if ($value =~ /^\d+$/) {
114 1         4 $value = $value + 0;
115             }
116              
117 7         18 my %hash;
118 7         21 $hash{set_variable}{name} = $name;
119 7         18 $hash{set_variable}{value} = $value;
120 7         28 $s->_push_data(\%hash);
121             }
122              
123             sub add_mouse_key {
124 6     6 1 204 my $s = shift;
125 6         25 $s->_is_exclusive('mouse_key');
126 6         13 my $name = shift;
127 6 50       21 croak 'No name passed' unless $name;
128 6         13 my $value = shift;
129 6 50       19 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         11 my %hash;
134 6         22 $hash{mouse_key}{$name} = $value;
135 6         20 $s->_push_data(\%hash);
136             }
137              
138             sub add_modifiers {
139 12     12 1 383 my $s = shift;
140 12         30 my $lkc = $s->{last_key_code};
141 12 100       119 croak 'Nothing to attach the modifiers to' if !$lkc;
142 6         14 my $existing = [];
143 6 50       43 if (exists $lkc->{modifiers} ) {
144 0         0 $existing = $lkc->{modifiers};
145             }
146              
147             #TODO: check that modifiers are valid
148 6         20 my @modifiers = @_;
149 6         19 push @$existing, @modifiers;
150 6         27 $lkc->{modifiers} = $existing;
151             }
152              
153             # ABSTRACT: To action object
154              
155             1;
156              
157             __END__