fhem-mirror/fhem/FHEM/lib/Device/Firmata/IO/NetIO.pm

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;