me8100_test_perl/ME8100.pm
changeset 25 984e6da93d95
parent 20 a486940be0fb
child 28 df25c194e3ce
equal deleted inserted replaced
24:24a49943680f 25:984e6da93d95
    15 # point us the the proper me8100 object ...
    15 # point us the the proper me8100 object ...
    16 #
    16 #
    17 $SIG{IO} = sub { 
    17 $SIG{IO} = sub { 
    18     my $val;
    18     my $val;
    19     warn "Got signal $_[0]\n";
    19     warn "Got signal $_[0]\n";
    20     return;
       
    21 
    20 
    22     my $select = new IO::Select(map { $Objects{$_}->{fd} } keys %Objects);
    21     my $select = new IO::Select(map { $Objects{$_}->{fd} } keys %Objects);
    23     my @ready = $select->can_read(0);
    22     my @ready = $select->can_read(0);
    24 
    23 
    25     foreach my $fd (@ready) {
    24     foreach my $fd (@ready) {
    26 	my $current = $Objects{$fd};
    25 	my $current = $Objects{$fd};
    27 	my $idx = $current->{idx};
    26 	my $idx = $current->{idx};
    28 	my $object = $current->{object};
    27 	my $object = $current->{object};
    29 
    28 
       
    29 	#$object->_read($fd);
       
    30 
    30 	warn "read ", $fd->fileno(), "\n";
    31 	warn "read ", $fd->fileno(), "\n";
    31 
    32 
    32 	my $val;
    33 	my $val;
    33 	$fd->sysread($val, 2) or carp("sysread(): $!\n");
    34 	$fd->sysread($val, 2) or carp("sysread(): $!\n");
    34 	$object->{inputs}->[$idx] = $val;
    35 	$object->{inputs}->[$idx] = $val;
    35 	$object->{changed} = 1;
    36 	$object->{changed} = 1;
    36     }
    37     }
    37 
    38 
       
    39     #kill("ALRM", $$);
    38     warn "done signal\n";
    40     warn "done signal\n";
    39 
    41 
    40 };
    42 };
       
    43 
       
    44 sub _read {
       
    45     my $self = shift;
       
    46     my $fd = shift;
       
    47     warn "read from ", $fd->fileno(), "\n";
       
    48 }
       
    49 
    41 
    50 
    42 
    51 
    43 # Create a new object. Open all the named devices (read only)
    52 # Create a new object. Open all the named devices (read only)
    44 # and read the current values (as the driver guarantees the
    53 # and read the current values (as the driver guarantees the
    45 # very first read to succeed).
    54 # very first read to succeed).
    81 
    90 
    82 sub read {
    91 sub read {
    83     my $self = shift;
    92     my $self = shift;
    84     my $timeout = shift;
    93     my $timeout = shift;
    85 
    94 
    86     if (!$self->{irq_seen}) {
       
    87 	# This might be a race with the signal handler above,
       
    88 	# thus we'll have to really read if select returns, as
       
    89 	# we can't know for sure if the signal handler did it already.
       
    90 	warn "select() w/ timeout " 
       
    91 	    . (defined($timeout) ? $timeout : " undef") . "\n";
       
    92 	my @fds = $self->{select}->can_read($timeout);
       
    93 	warn "done select()\n";
       
    94 	foreach my $fd (@fds) {
       
    95 	    my $val;
       
    96 	    $fd->sysread($val, 2)
       
    97 		or croak("sysread(): $!\n");
       
    98 	    $self->{inputs}->[$Objects{$fd}->{idx}] = $val;
       
    99 	}
       
   100     } else {
       
   101 	$self->{irq_seen} = 0;
       
   102     }
       
   103     return split //, unpack("b*", join("", @{$self->{inputs}}));
    95     return split //, unpack("b*", join("", @{$self->{inputs}}));
   104 }
    96 }
   105 
    97 
   106 sub changed {
    98 sub changed {
   107     my $self;
    99     my $self;