lib/Biblio/RFID/Reader/INET.pm

   1 package Biblio::RFID::Reader::INET;
   2 use warnings;
   3 use strict;
   4 use base 'IO::Socket::INET';
   5
   6 use IO::Socket::INET;
   7 use Time::HiRes qw(ualarm);
   8 use Data::Dump qw(dump);
   9
  10 my $debug = $ENV{DEBUG};
  11
  12 =head1 NAME
  13
  14 Biblio::RFID::Reader::INET - emulate serial port over TCP socket
  15
  16 =cut
  17
  18 sub write {
  19         my $self = shift;
  20         $self->_check_connected;
  21         warn ">> write ",dump(@_) if $debug;
  22         my $count = $self->SUPER::print(@_);
  23         $self->flush;
  24 #warn "XX ",ref($self), " write response: $count ", dump(@_);
  25         return $count;
  26 }
  27
  28 our $read_char_time = 1;
  29 sub read_char_time { $read_char_time = $_[1] * 1_000 || 1_000_000 };
  30 sub read_const_time {};
  31
  32 sub read(*\$$;$) {
  33         my $self = shift;
  34         my $len = shift || die "no length?";
  35
  36 #warn "XX ",ref($self), " read $len timeout $read_char_time";
  37         my $buffer;
  38         eval {
  39                 local $SIG{ALRM} = sub { die "read timeout" };
  40
  41                 #warn "## read_serial $len timeout $read_char_time\n";
  42
  43                 ualarm $read_char_time;
  44                 $len = $self->SUPER::read( $buffer, $len );
  45                 ualarm 0;
  46         };
  47         if ( $@ ) {
  48                 warn "ERROR: $@";
  49                 $len = 0;
  50         }
  51
  52         $self->_check_connected;
  53
  54         warn "<< read $len ",dump($buffer) if $debug;
  55         return ( $len, $buffer );
  56 }
  57
  58 sub _check_connected {
  59         my $self = shift;
  60         return if $self->connected;
  61
  62         warn "LOST TCP Connection";
  63         exit 1;
  64 }
  65
  66 1;
  67 __END__
  68
  69 =head1 SEE ALSO
  70
  71 L<Biblio::RFID::Reader::Serial>
  72