File Coverage

File:blib/lib/Linux/Input/Capabilities/Dev.pm
Coverage:86.9%

linestmtbrancondsubpodtimecode
1package Linux::Input::Capabilities::Dev;
2#ABSTRACT: Capabilities of a single input device
3
2
2
2
20
3
use 5.028;
4
2
2
2
2
6
2
26
use strict;
5
2
2
2
2
4
1
37
use warnings;
6
2
2
2
2
465
9336
4
use Moo;
7
2
2
2
2
1736
1037
55
use Bit::Vector;
8
2
2
2
2
7
2
57
use Carp;
9
2
2
2
2
5
2
114
use File::chdir;
10
2
2
2
2
378
19889
72
use File::Slurper qw(read_text);
11
2
2
2
2
736
2
554
use Linux::Input::Capabilities::Constants qw(%_REVERSE_TABLE);
12
2
2
2
2
385
18021
4
use namespace::autoclean;
13
2
2
2
2
87
12
80
use warnings::register;
14
2
2
2
2
6
2
7
use autodie qw(opendir readdir closedir);
15
16has name => (
17        is => 'rwp',
18        init_arg => undef,
19);
20
21has _bits => (
22        is => 'rw',
23        trigger => sub { shift->_clear_decoded },
24);
25
26has _decoded => (
27        is => 'ro',
28        lazy => 1,
29        clearer => '_clear_decoded',
30
1
1
8
        builder => sub { +{ } },
31);
32
33has _dir => (
34        is => 'ro',
35        init_arg => 'dir',
36        required => 1,
37);
38
39sub BUILD {
40
6
6
0
960
        my ($self, $args) = @_;
41
6
12
        local $CWD = $CWD;
42
43
6
130
        push @CWD, $self->_dir;
44
6
273
        chomp(my $name = read_text('name'));
45
6
217
        $self->_set_name($name);
46
47
6
7
        push @CWD, 'capabilities';
48
6
250
        opendir my $dh, '.';
49
6
490
        my @entries = readdir $dh;
50
6
452
        closedir $dh;
51
52
6
408
        my %bits;
53
6
7
        foreach my $ent (@entries) {
54
66
100
82
                next if $ent =~ /^\./;
55
54
50
101
                if ($ent =~ /^(abs|ev|ff|key|led|msc|rel|snd|sw)$/n) {
56
54
58
                        $bits{$ent} = _parse_bits(read_text($ent));
57                } else {
58
0
0
                        warnif("Unknown sysfs capability type '$ent' ignored; module may need updating to support it");
59                }
60        }
61
62
6
52
        $self->_bits(\%bits);
63}
64
65sub get_supported {
66
2
2
1
4
        my ($self, $type) = @_;
67
2
2
        local $_;
68
69
2
50
14
        my $v = $self->_bits->{$type}
70                or croak "Unknown type '$type'";
71
72
2
50
24
        unless (exists $self->_decoded->{$type}) {
73                $self->_decoded->{$type} = [
74
2
33
74
                        map $_REVERSE_TABLE{uc $type}{$_} // "#UNKNOWN#$_",
75                        grep $v->contains($_),
76                        0 .. ($v->Size - 1)];
77        }
78
79
2
17
        return $self->_decoded->{$type};
80}
81
82sub is_supported {
83
3
3
1
13
        my ($self, $type, $report) = @_;
84
85
3
50
19
        my $v = $self->_bits->{$type}
86                or croak "Unknown type '$type'";
87
88
3
33
32
        return $v->Size > $report && $v->contains($report);
89}
90
91sub count_supported {
92
7
7
1
34
        my ($self, $type, @reports) = @_;
93
7
6
        local $_;
94
95
7
50
38
        my $v = $self->_bits->{$type}
96                or croak "Unknown type '$type'";
97
98
7
30
        my $sz = $v->Size;
99
7
67
307
        return scalar grep $sz > $_ && $v->contains($_), @reports;
100}
101
102sub _parse_bits {
103
54
54
1443
        my ($text) = @_;
104
54
58
        local $_;
105
106        # Kernel formats this as groups separated by spaces. Each group is
107        # 32 or 64 bits long, depending on architecture. At least on Debian
108        # i386 and amd64, it matches Config longsize, and even better
109        # Bit::Vector->Word_Bits.
110        #
111        # However, the kernel doesn't print leading 0s, so we have to pad it
112        # to get it to a nice hex string.
113
54
103
        my $group_nybbles = Bit::Vector->Word_Bits() / 4;
114
54
172
        my @groups = map '0'x($group_nybbles-length($_)).$_, split(/\s+/, $text);
115
54
77
        my $size = @groups * Bit::Vector->Word_Bits();
116
54
57
        my $hex = join('', @groups);
117
118        # sanity check because if we messed up, we're about to produce
119        # nonsense. This should never happen.
120
54
50
74
        if ($size / 4 != length($hex)) {
121
0
0
0
0
0
0
                die "BUG: Hex isn't expected length; expected ${\($size/4)} got ${\length($hex)} for $hex";
122        }
123
124
54
135
        return Bit::Vector->new_Hex($size, $hex);
125}
126
1271;
128