File Coverage

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

linestmtbrancondsubpodtimecode
1package Linux::Input::Capabilities;
2#ABSTRACT: Check capabilities of Linux input devices using sysfs.
3
2
2
2
105794
4
use 5.028;
4
2
2
2
2
5
1
23
use strict;
5
2
2
2
2
4
1
42
use warnings;
6
2
2
2
2
390
15355
7
use autodie qw(opendir readdir closedir);
7
2
2
2
2
687
2
89
use Carp;
8
2
2
2
2
4
2
24
use Exporter qw(import);
9
2
2
2
2
448
3163
150
use File::chdir;
10
2
2
2
2
421
4
58
use Linux::Input::Capabilities::Dev;
11
2
2
2
2
7
2
4
use Moo;
12
2
2
2
2
397
2
7
use namespace::autoclean;
13
14has sysfs_root => (
15        is => 'rw',
16        default => '/sys',
17        trigger => sub { shift->reload() },
18);
19
20has _devices => (
21        is => 'ro',
22        lazy => 1,
23        clearer => '_clear_devices',
24        builder => '_build_devices',
25);
26
27sub BUILD {
28
1
1
0
4
        my ($self, $args) = @_;
29
30        # force reading sysfs, so we get errors on new not first use.
31
1
7
        $self->_devices;
32
33
1
6
        return;
34}
35
36sub _build_devices {
37
1
1
6
        my ($self) = @_;
38
39
1
6
        local $CWD = $self->sysfs_root;
40
1
42
        push @CWD, 'class', 'input';
41
42
1
64
        opendir my $dh, '.';
43
1
755
        my @entries = readdir($dh);
44
1
329
        closedir($dh);
45
46
1
324
        my %devs;
47
1
3
        foreach my $entry (@entries) {
48
8
100
94
                next unless $entry =~ /^input(\d+)$/;
49
6
67
                $devs{$1} = Linux::Input::Capabilities::Dev->new(dir => $entry);
50        }
51
52
1
17
        return \%devs;
53}
54
55sub reload {
56
1
1
1
2
        my ($self) = @_;
57
58
1
8
        $self->_clear_devices;
59
1
9
        $self->_devices;
60
61
1
18
        return;
62}
63
64sub list {
65
1
1
1
580
        my ($self) = @_;
66
67
1
1
1
15
        return keys %{$self->_devices};
68}
69
70sub get {
71
8
8
1
1370
        my ($self, $input) = @_;
72
73
8
50
89
        my $d = $self->_devices->{$input}
74                or croak "Unknown input device $input";
75
76
8
57
        return $d;
77}
78
79sub find {
80
1
1
1
6
        my ($self, $type, $min, @reports) = @_;
81
82
1
2
        my @res;
83
1
7
1
42
        while (my ($num, $dev) = each %{$self->_devices}) {
84
6
100
30
                push @res, $dev if $min <= $dev->count_supported($type, @reports);
85        }
86
87
1
8
        return @res;
88}
89
901;
91