diff --git a/FHEM/10_FRM.pm b/FHEM/10_FRM.pm index 41828f502..16ed20cb3 100755 --- a/FHEM/10_FRM.pm +++ b/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; diff --git a/FHEM/lib/Device/Firmata.pm b/FHEM/lib/Device/Firmata.pm index 44c7a5935..7e1c2a156 100644 --- a/FHEM/lib/Device/Firmata.pm +++ b/FHEM/lib/Device/Firmata.pm @@ -8,7 +8,7 @@ use Device::Firmata::Base ISA => 'Device::Firmata::Base', FIRMATA_ATTRIBS => { }; - + =head1 NAME Device::Firmata - Perl interface to Firmata for the arduino platform. @@ -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"; + + my $io = $serialio->open( $serial_port, $opts ); + my $platform = $package->attach( $io, $opts ) or die "Could not connect to Firmata Server"; -# Figure out what platform we're running on - $device->probe; + # Figure out what platform we're running on + $platform->probe; - return $device; + 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; diff --git a/FHEM/lib/Device/Firmata/IO/NetIO.pm b/FHEM/lib/Device/Firmata/IO/NetIO.pm new file mode 100644 index 000000000..b33c2f2be --- /dev/null +++ b/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; diff --git a/FHEM/lib/Device/Firmata/IO.pm b/FHEM/lib/Device/Firmata/IO/SerialIO.pm similarity index 93% rename from FHEM/lib/Device/Firmata/IO.pm rename to FHEM/lib/Device/Firmata/IO/SerialIO.pm index 6229c8fd6..e33c7e5f4 100644 --- a/FHEM/lib/Device/Firmata/IO.pm +++ b/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 diff --git a/FHEM/lib/Device/Firmata/Platform.pm b/FHEM/lib/Device/Firmata/Platform.pm index 33a493636..bba7c36d2 100644 --- a/FHEM/lib/Device/Firmata/Platform.pm +++ b/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 {