Merge branch 'update-perl-firmata'

git-svn-id: https://svn.fhem.de/fhem/trunk/fhem@4113 2b470e98-0d58-463d-a4d8-8e2adae1ed80

FHEM/10_FRM.pm

@@ -14,7 +14,6 @@ BEGIN {
 };
 
 use Device::Firmata::Constants qw/ :all /;
-use Device::Firmata::IO;
 use Device::Firmata::Protocol;
 use Device::Firmata::Platform;
 

FHEM/lib/Device/Firmata.pm

@@ -19,7 +19,7 @@ Version 0.50
 
 =cut
 
-our $VERSION = '0.51';
+our $VERSION = '0.52';
 our $DEBUG = 0;
 
 
@@ -60,13 +60,29 @@ sub open {
 # We're going to try and create the device connection first...
     my $package = "Device::Firmata::Platform";
     eval "require $package";
-    my $device = $package->open($serial_port,$opts) or die "Could not connect to Firmata Server";
+    my $serialio = "Device::Firmata::IO::SerialIO"; 
+    eval "require $serialio";
 	
-# Figure out what platform we're running on
+  	my $io = $serialio->open( $serial_port, $opts );
-    $device->probe;
+  	my $platform = $package->attach( $io, $opts ) or die "Could not connect to Firmata Server";
 
-    return $device;
+	# Figure out what platform we're running on
+    $platform->probe;
+
+    return $platform;
 }
 
+sub listen {
+# --------------------------------------------------
+# Listen on socket and wait for Arduino to establish a connection
+#
+	my ( $pkg, $ip, $port, $opts ) = @_;
+
+    my $netio = "Device::Firmata::IO::NetIO"; 
+    eval "require $netio";
+	
+  	return $netio->listen( $ip, $port, $opts ) or die "Could not bind to socket";
+  	
+}
 
 1;

FHEM/lib/Device/Firmata/IO/NetIO.pm

@@ -0,0 +1,203 @@
+package Device::Firmata::IO::NetIO;
+
+use strict;
+use warnings;
+use IO::Socket::INET;
+use IO::Select;
+
+use vars qw//;
+use Device::Firmata::Base
+    ISA => 'Device::Firmata::Base',
+    FIRMATA_ATTRIBS => {
+    };
+
+sub listen {
+# --------------------------------------------------
+    my ( $pkg, $ip, $port, $opts ) = @_;
+
+    my $self = ref $pkg ? $pkg : $pkg->new($opts);
+
+	# flush after every write
+	$| = 1;
+	
+	my $socket;
+		
+	# creating object interface of IO::Socket::INET modules which internally does
+	# socket creation, binding and listening at the specified port address.
+	$socket = new IO::Socket::INET (
+	LocalHost => $ip,
+	LocalPort => $port,
+	Proto => 'tcp',
+	Listen => 5,
+	Reuse => 1
+	) or die "ERROR in Socket Creation : $!\n";
+
+	$self->{'socket'} = $socket;
+	return $self;
+}
+
+sub accept {
+	
+	my ($self,$timeout) = @_;
+	# waiting for new client connection.
+	my $s = $self->{'select'};
+	if (!($s)) {
+		$s = IO::Select->new();
+		$s->add($self->{'socket'});
+		$self->{'select'} = $s;
+	}
+	if(my @ready = $s->can_read($timeout)) {
+		my $socket = $self->{'socket'};
+		foreach my $fh (@ready) {
+			if ($fh == $socket) {
+				if (my $client_socket = $socket->accept()) {
+					return $self->attach($client_socket);
+				}
+			}
+		}
+	}
+	return undef;
+}
+
+sub close {
+	my $self = shift;
+	if ($self->{'select'} && $self->{'socket'}) {
+		$self->{'select'}->remove($self->{'socket'});
+		delete $self->{'select'};
+	}
+	if ($self->{'socket'}) {
+		$self->{'socket'}->close();
+		delete $self->{'socket'};
+	}
+	if ($self->{clients}) {
+		foreach my $client (@{$self->{clients}}) {
+			$client->close();
+		}
+		delete $self->{clients};
+	}
+}
+
+sub attach {
+    my ( $pkg, $client_socket, $opts ) = @_;
+
+    my $self = ref $pkg ? $pkg : $pkg->new($opts);
+
+	my $clientpackage = "Device::Firmata::IO::NetIO::Client";
+	eval "require $clientpackage";
+	
+	my $clientio = $clientpackage->attach($client_socket);
+	
+    my $package = "Device::Firmata::Platform";
+    eval "require $package";
+  	my $platform = $package->attach( $clientio, $opts ) or die "Could not connect to Firmata Server";
+
+	my $s = $self->{'select'};
+	if (!($s)) {
+		$s = IO::Select->new();
+		$self->{'select'} = $s;
+	}
+	$s->add($client_socket);
+	my $clients = $self->{clients};
+	if (!($clients)) {
+		$clients = [];
+		$self->{clients} = $clients;
+	}
+	push $clients, $platform;
+
+	# Figure out what platform we're running on
+    $platform->probe();
+
+    return $platform;
+}
+
+sub poll {
+	my ($self,$timeout) = @_;
+	my $s = $self->{'select'};
+	return unless $s;
+	if(my @ready = $s->can_read($timeout)) {
+		my $socket = $self->{'socket'};
+		my $clients = $self->{clients};
+		if (! defined($clients)) {
+			$clients = [];
+			$self->{clients} = $clients;
+		}
+		my @readyclients = ();
+		foreach my $fh (@ready) {
+			if ($fh != $socket) {
+				push @readyclients, grep { $fh == $_->{io}->{client}; } @$clients;
+			}
+		}
+		foreach my $readyclient (@readyclients) {
+			$readyclient->poll();
+		}
+	}
+}
+
+package Device::Firmata::IO::NetIO::Client;
+
+use strict;
+use warnings;
+use IO::Socket::INET;
+
+use vars qw//;
+use Device::Firmata::Base
+    ISA => 'Device::Firmata::Base',
+    FIRMATA_ATTRIBS => {
+    };
+
+sub attach {
+    my ( $pkg, $client_socket, $opts ) = @_;
+
+    my $self = ref $pkg ? $pkg : $pkg->new($opts);
+
+    $self->{client} = $client_socket;
+   
+    return $self;
+}
+
+=head2 data_write
+
+Dump a bunch of data into the comm port
+
+=cut
+
+sub data_write {
+# --------------------------------------------------
+    my ( $self, $buf ) = @_;
+    $Device::Firmata::DEBUG and print ">".join(",",map{sprintf"%02x",ord$_}split//,$buf)."\n";
+    return $self->{client}->write( $buf );
+}
+
+
+=head2 data_read
+
+We fetch up to $bytes from the comm port
+This function is non-blocking
+
+=cut
+
+sub data_read {
+# --------------------------------------------------
+    my ( $self, $bytes ) = @_;
+	my ($buf, $res);
+	$res = $self->{client}->sysread($buf, 512);
+    $buf = "" if(!defined($res));
+    
+    if ( $Device::Firmata::DEBUG and $buf ) {
+        print "<".join(",",map{sprintf"%02x",ord$_}split//,$buf)."\n";
+    }
+    return $buf;
+}
+
+=head2 close
+
+close the underlying connection
+
+=cut
+
+sub close {
+	my $self = shift;
+	$self->{client}->close() if (($self->{client}) and $self->{client}->connected());
+}
+
+1;

FHEM/lib/Device/Firmata/IO/SerialIO.pm

@@ -1,8 +1,8 @@
-package Device::Firmata::IO;
+package Device::Firmata::IO::SerialIO;
 
 =head1 NAME
 
-Device::Firmata::IO - implement the low level serial IO
+Device::Firmata::IO::SerialIO - implement the low level serial IO
 
 =cut
 

FHEM/lib/Device/Firmata/Platform.pm

@@ -9,7 +9,6 @@ Device::Firmata::Platform - Platform specifics
 use strict;
 use Time::HiRes qw/time/;
 use Device::Firmata::Constants qw/ :all /;
-use Device::Firmata::IO;
 use Device::Firmata::Protocol;
 use Device::Firmata::Base
   ISA                         => 'Device::Firmata::Base',
@@ -59,14 +58,6 @@ to find out how to connect to the device
 
 =cut
 
-sub open {
-  # --------------------------------------------------
-  my ( $pkg, $port, $opts ) = @_;
-  my $self = ref $pkg ? $pkg : $pkg->new($opts);
-  my $ioport = Device::Firmata::IO->open( $port, $opts ) or return;
-  return $self->attach( $ioport, $opts );
-}
-
 sub attach {
   # --------------------------------------------------
   # Attach to an open IO port and do some basic operations
@@ -81,7 +72,27 @@ sub attach {
 
 sub detach {
   my $self = shift;
-  delete $self->{io};
+  delete $self->{io} if ($self->{io});
+  delete $self->{protocol} if ($self->{protocol});
+  $self->{sysex_data}         = [];
+  $self->{analog_pins}        = [];
+  $self->{ports}              = [];
+  $self->{pins}               = {};
+  $self->{pin_modes}          = {};
+  $self->{digital_observer}   = [];
+  $self->{analog_observer}    = [];
+  $self->{sysex_observer}     = undef;
+  $self->{i2c_observer}       = undef;
+  $self->{onewire_observer}   = [];
+  $self->{scheduler_observer} = undef;
+  $self->{tasks}              = [];
+  $self->{metadata}           = {};
+}
+
+sub close {
+  my $self = shift;
+  $self->{io}->close();
+  $self->detach();
 }
 
 sub system_reset {