From: Dobrica Pavlinusic <dpavlin@rot13.org>
Date: Mon, 23 Jan 2017 13:54:31 +0000 (+0100)
Subject: added RFID_TCP to query serial readers over tcp socket
X-Git-Url: http://git.rot13.org/?p=Biblio-RFID.git;a=commitdiff_plain;h=fc04c400151a4ac11416333d4350213978d3f652

added RFID_TCP to query serial readers over tcp socket
---

diff --git a/lib/Biblio/RFID/Reader/INET.pm b/lib/Biblio/RFID/Reader/INET.pm
new file mode 100644
index 0000000..ed0887b
--- /dev/null
+++ b/lib/Biblio/RFID/Reader/INET.pm
@@ -0,0 +1,57 @@
+package Biblio::RFID::Reader::INET;
+use warnings;
+use strict;
+use base 'IO::Socket::INET';
+
+use IO::Socket::INET;
+use Time::HiRes qw(ualarm);
+use Data::Dump qw(dump);
+
+=head1 NAME
+
+Biblio::RFID::Reader::INET - emulate serial port over TCP socket
+
+=cut
+
+sub write {
+	my $self = shift;
+	my $count = $self->SUPER::print(@_);
+	$self->flush;
+#warn "XX ",ref($self), " write response: $count ", dump(@_);
+	return $count;
+}
+
+our $read_char_time = 1;
+sub read_char_time { $read_char_time = $_[1] * 1_000 || 1_000_000 };
+sub read_const_time {};
+
+sub read {
+	my $self = shift;
+	my $len = shift || die "no length?";
+#warn "XX ",ref($self), " read $len timeout $read_char_time";
+	my $buffer;
+	eval {
+		local $SIG{ALRM} = sub { die "read timeout" };
+
+		#warn "## read_serial $len timeout $read_char_time\n";
+
+		ualarm $read_char_time;
+		$len = $self->SUPER::read( $buffer, $len );
+		ualarm 0;
+	};
+	if ( $@ ) {
+		warn "ERROR: $@";
+		$len = 0;
+	}
+
+	#warn "## read $len ",dump($buffer);
+	return ( $len, $buffer );
+}
+
+1;
+__END__
+
+=head1 SEE ALSO
+
+L<Biblio::RFID::Reader::Serial>
+
diff --git a/lib/Biblio/RFID/Reader/Serial.pm b/lib/Biblio/RFID/Reader/Serial.pm
index f954f39..24432d5 100644
--- a/lib/Biblio/RFID/Reader/Serial.pm
+++ b/lib/Biblio/RFID/Reader/Serial.pm
@@ -4,11 +4,12 @@ use warnings;
 use strict;
 
 use Device::SerialPort qw(:STAT);
+use Biblio::RFID::Reader::INET;
 use Data::Dump qw(dump);
 
 =head1 NAME
 
-Biblio::RFID::Reader::Serial - base class for serial RFID readers
+Biblio::RFID::Reader::Serial - base class for serial or serial over TCP RFID readers
 
 =head1 METHODS
 
@@ -35,6 +36,9 @@ Tries to open usb serial ports C</dev/ttyUSB*> and serial ports C</dev/ttyS*>
 
 To try just one device use C<RFID_DEVICE=/dev/ttyUSB1> enviroment variable
 
+If you want to define serial connection over TCP socket, you have to export
+enviroment variable C<RFID_TCP=hostname:port>.
+
 =cut
 
 our $serial_device;
@@ -42,8 +46,21 @@ our $serial_device;
 sub port {
 	my $self = shift;
 
+	warn "## port ",dump( $self->{port} );
+
 	return $self->{port} if defined $self->{port};
 
+	if ( my $tcp = $ENV{RFID_TCP} ) {
+		my $port = Biblio::RFID::Reader::INET->new(
+			PeerAddr => $tcp,
+			Proto    => 'tcp'
+		);
+		warn "## TCP $tcp ", ref($port);
+		$self->{port} = $port;
+		$self->init;
+		return $port;
+	}
+
 	my $settings = $self->serial_settings;
 	my @devices  = $ENV{RFID_DEVICE} ? ( $ENV{RFID_DEVICE} ) : glob '/dev/ttyUSB* /dev/ttyS*';
 	warn "# port devices ",dump(@devices);