git.sur5r.net Git - bacula/rescue/blob - rescue/linux/cdrom/yaird-0.0.5/perl/Input.pm

   1 #!perl -w
   2 #
   3 # Input - a single device from the input layer
   4 #   Copyright (C) 2005  Erik van Konijnenburg
   5 #
   6 #   This program is free software; you can redistribute it and/or modify
   7 #   it under the terms of the GNU General Public License as published by
   8 #   the Free Software Foundation; either version 2 of the License, or
   9 #   (at your option) any later version.
  10 #
  11 #   This program is distributed in the hope that it will be useful,
  12 #   but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 #   GNU General Public License for more details.
  15 #
  16 #   You should have received a copy of the GNU General Public License
  17 #   along with this program; if not, write to the Free Software
  18 #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  19 #
  20 # info - info provided by low level driver for module matching
  21 # name - provided by driver
  22 # phys - provided by driver, no relation to sysfs location
  23 # handlers - input layer handlers
  24 # capabilities - kind of events that can be generated
  25 # hw - ...
  26 #
  27 # Handler 'kbd' indicates the device is used for console;
  28 # there is also a generic handler for each device, event\d+,
  29 # that may have a link to underlying sysfs device.
  30 # Capability KEY indicates there are buttons, this includes
  31 # both qwerty keys and the fire button on a joystick.
  32 #
  33
  34 use strict;
  35 use warnings;
  36 use Base;
  37 use Conf;
  38 package Input;
  39 use base 'Obj';
  40
  41 sub fill {
  42         my $self = shift;
  43         $self->SUPER::fill();
  44         $self->takeArgs ('info', 'name', 'phys', 'handlers', 'capabilities');
  45
  46         #
  47         # Find hardware link, if any.
  48         #
  49         $self->{hw} = undef;
  50         for my $handler (keys %{$self->handlers}) {
  51                 if ($handler !~ /^event\d+$/) {
  52                         next;
  53                 }
  54                 my $devLink = Conf::get('sysFs')
  55                         . "/class/input/$handler/device";
  56                 my $hw = readlink ($devLink);
  57                 if (defined ($hw)) {
  58                         unless ($hw =~ s!^(\.\./)+devices/!!) {
  59                                 # imagine localised linux (/sys/geraete ...)
  60                                 Base::fatal ("bad device link in $devLink");
  61                         }
  62                         $self->{hw} = $hw;
  63                 }
  64         }
  65 }
  66
  67 sub info        { return $_[0]->{info}; }
  68 sub name        { return $_[0]->{name}; }
  69 sub phys        { return $_[0]->{phys}; }
  70 sub handlers    { return $_[0]->{handlers}; }
  71 sub capabilities        { return $_[0]->{capabilities}; }
  72 sub hw          { return $_[0]->{hw}; }
  73
  74 sub string {
  75         my $self = shift;
  76         my $name = $self->name;
  77         my $phys = $self->phys;
  78         my $hw = $self->hw;
  79         $hw = "--" unless defined $hw;
  80         my $h = join (",", keys %{$self->handlers});
  81         my $c = join (",", keys %{$self->capabilities});
  82         my $kbd = $self->isKbd ? " (KBD)" : "";
  83         my $str = "$name is $phys at $hw [$h] [$c]$kbd";
  84         return $str;
  85 }
  86
  87 #
  88 # isKbd -- device may be useful to get an operational keyboard.
  89 # This is conservative: there are two input devices for a DELL USB
  90 # keyboard for example, and we make no effort to determine if
  91 # we can leave one of them out.
  92 #
  93 sub isKbd {
  94         my $self = shift;
  95         if (! exists ($self->capabilities->{KEY})) {
  96                 return 0;
  97         }
  98         if (! exists ($self->handlers->{kbd})) {
  99                 return 0;
 100         }
 101         return 1;
 102 }
 103
 104 1;