1 package ME8100;

     2 

     3 # (c) 2002 Heiko Schlittermann

     4 

     5 use strict;

     6 use Fcntl;

     7 use IO::File;

     8 use IO::Select;

     9 use Carp;

    10 

    11 my %Objects = ();

    12 

    13 # If an interrupt occurs, we've to search for the file descriptor(s)

    14 # that caused the interrupt.  The file descriptor(s) should in turn

    15 # point us the the proper me8100 object ...

    16 #

    17 $SIG{IO} = sub { 

    18     my $val;

    19     warn "Got Signal $_[0]\n";

    20 

    21     my $select = new IO::Select(map { $Objects{$_}->{fd} } keys %Objects);

    22     my @ready = $select->can_read(0);

    23 

    24     foreach my $fd (@ready) {

    25 	my $current = $Objects{$fd};

    26 	my $idx = $current->{idx};

    27 	my $object = $current->{object};

    28 

    29 	my $val;

    30 	$fd->sysread($val, 2) or carp("sysread(): $!\n");

    31 	$object->{inputs}->[$idx] = $val;

    32     }

    33 

    34 };

    35 

    36 

    37 # Create a new object. Open all the named devices (read only)

    38 # and read the current values (as the driver guarantees the

    39 # very first read to succeed).

    40 # The order depends on the order the device names are passed 

    41 # to the new() method;

    42 

    43 sub new {

    44     my $self = {};

    45     my $class = shift;

    46     bless $self, $class;

    47 

    48     my (@fds, @inputs);

    49     my $idx = 0;

    50     foreach my $device (@_) {

    51 	my ($flags, $val);

    52 	my $fd = new IO::File($device, "r")

    53 	    or croak("open($device): $!\n");

    54 

    55 	fcntl($fd, F_SETOWN, $$) or croak "Can't set owner: $!\n";

    56 	$flags = fcntl($fd, F_GETFL, 0) or croak "Can't get flags: $!\n";

    57 	fcntl($fd, F_SETFL, $flags | O_ASYNC) or croak "Can't set flags: $!\n";

    58 

    59 	$Objects{$fd} = { fd => $fd, idx => $idx, object => $self };

    60 	$fd->sysread($val, 2);

    61 

    62 	push @inputs, $val;

    63 	push @fds, $fd;

    64 

    65 	++$idx;

    66     }

    67 

    68     $self->{fds} = [@fds];

    69     $self->{inputs} = [@inputs];

    70 

    71     return $self;

    72 }

    73 

    74 sub read {

    75     my $self = shift;

    76     return split //, unpack("b*", join("", @{$self->{inputs}}));

    77 }

    78 

    79 sub DESTROY

    80 {

    81     my $self = shift;

    82     delete @Objects{ @{$self->{fds}} };

    83 }

    84 

    85 

    86 1;

    87 # vim:sts=4 sw=4 aw ai sm: