XPort GPIO from Perl

The library is still a bit basic but it can do the following things:

• turn on GPIO ports
• turn off GPIO ports
• read what ports are configured for GPIO
• get/set INPUT/OUTPUT
• get/set High or low active

#!/usr/bin/perl
# based on xport.pl from http://cancoffee2.at.webry.info/200808/article_66.html 
# my japanese is not that well 8-)

# version: 0.5

package xport;

use strict;
use warnings;
use IO::Socket;

# XPORT COMMANDS
use constant XPORT_GET_FUNCTIONS => 0x10;
use constant XPORT_GET_DIRECTIONS => 0x11;
use constant XPORT_GET_ACTIVE_LEVELS => 0x12;
use constant XPORT_GET_CURRENT_STATES => 0x13;
use constant XPORT_SET_DIRECTIONS => 0x19;
use constant XPORT_SET_ACTIVE_LEVELS => 0x1A;
use constant XPORT_SET_CURRENT_STATES => 0x1B;

use constant XPORT_CP1 => 0x01;
use constant XPORT_CP2 => 0x02;
use constant XPORT_CP3 => 0x04;

use constant XPORT_GPIO_MASK => 0x07; # there are only 3 gpio pins in xport

use constant XPORT_DEBUG => 1;

#xport_test();
#rol_dicht();
#sleep 10;
#rol_open();

#exit;

sub rol_open() {
	#set_cp1_on();
	#sleep 5;
	set_cp2_on();
	sleep 10;
	set_cp2_off();
	#sleep 5;
	#set_cp1_off();
}

sub rol_dicht() {
	set_cp1_on();
	sleep 3;
	set_cp2_on();
	sleep 10;
	set_cp2_off();
	sleep 3;
	set_cp1_off();
}

sub xport_test 
{
	#my @ds0 = (XPORT_GET_DIRECTIONS , 0x00,0x00,0x00,0x00, 0x02,0x00,0x00,0x00);
	#my $sRes = con(@ds0);
	#my @ds0;
	#my $sRes = con(XPORT_GET_DIRECTIONS , 0x00,0x00,0x00,0x00, 0x02,0x00,0x00,0x00);
	#my $sRes = connect('192.168.1.20','30704');

	print "GPIO            : " . unpack("B32", pack("N", &get_gpio() )). "\n";
	print "Direction       : " . unpack("B32", pack("N", &get_direction() )). "\n";
	# print "Set Direction   : " . unpack("B32", pack("N", &set_direction(0, 0x07))) . "\n";
	print "get activeHL    : " .unpack("B32", pack("N", &get_activeHL())) . "\n";

	print "Get on/off state: ". unpack("B32", pack("N", &get_on_off_stat()) ). "\n";
	set_cp1_on();
	set_cp2_off();
	set_cp3_on();
	print "Get on/off state: ". unpack("B32", pack("C", &get_on_off_stat() )). "\n";
	set_cp1_off();
	set_cp2_on();
	set_cp3_off();
	print "Get on/off state: ". unpack("B32", pack("C", &get_on_off_stat() )). "\n";

	print_gpio_state();

	#print "Set on/off state: " .unpack("B32", pack("C", &set_on_off_stat(3, 3))) . "\n";
	print "Get on/off state: ". unpack("B32", pack("C", &get_on_off_stat() )). "\n";
	print_gpio_state();

	print "Set on/off state: " .unpack("B32", pack("C", &set_on_off_stat(0, 0))) . "\n";
	exit;
}

# print the state of the GPIO in readable text.
sub print_gpio_state {
	my $state = &get_on_off_stat(0) ;
	my $gpio = &get_gpio();
	my $dir = &get_direction(0);

	print "CP1 is ". (( $gpio & XPORT_CP1 )?(( $state & XPORT_CP1 )?"on":"off" ):"No GPIO").(( $dir & XPORT_CP1 )?" OUTPUT":" INPUT")."\n";
	print "CP2 is ". (( $gpio & XPORT_CP2 )?(( $state & XPORT_CP2 )?"on":"off" ):"No GPIO").(( $dir & XPORT_CP2 )?" OUTPUT":" INPUT")."\n";
	print "CP3 is ". (( $gpio & XPORT_CP3 )?(( $state & XPORT_CP3 )?"on":"off" ):"No GPIO").(( $dir & XPORT_CP3 )?" OUTPUT":" INPUT")."\n";
}

# exec_cmd ( $command , $mask , $value )
# command is the 0x1N command 
# mask is needed  
sub exec_cmd {
	(my $cmd, my $mask, my $value) = @_ ;
	unless ( $mask ) {
		$mask = XPORT_GPIO_MASK;	
	} 
	###FIXME###
	# the 0x00 should be replaced by some pack or unpack thing...
	my $sRes = con(($cmd, $mask,0x00,0x00,0x00, $value,0x00,0x00,0x00));
	#reply is (CMD, B1,B2,B3,B4), only when command was successfull the CMD is in the response.	

	my $res_cmd = unpack("C1", $sRes);
	my $result = unpack("x1H2", $sRes);
 	
	if ($cmd == $res_cmd) {
		return $result;
	} else {
		print "ERROR\n";
		return -1;
	}
}

# return what ports are defined as GPIO ports
sub get_gpio {
	return xport::exec_cmd( XPORT_GET_FUNCTIONS , 0x00, 0x00);
}

# return what ports are defined as OUTPUT ports
sub get_direction {
	return xport::exec_cmd( XPORT_GET_DIRECTIONS , 0x00, 0x00);
}

sub set_direction {
	(my $mask, my $value) = @_ ;
	return xport::exec_cmd( XPORT_SET_DIRECTIONS , $mask, $value);
}

sub get_activeHL {
	return xport::exec_cmd( XPORT_GET_ACTIVE_LEVELS , 0x00 , 0x00);
}

sub set_activeHL {
	(my $mask, my $value) = @_ ;
	return xport::exec_cmd( XPORT_SET_ACTIVE_LEVELS , $mask, $value);
}

sub get_on_off_stat {
	return xport::exec_cmd( XPORT_GET_CURRENT_STATES , 0x00, 0x00);
}

sub set_on_off_stat {
	(my $mask, my $value) = @_ ;
	return xport::exec_cmd( XPORT_SET_CURRENT_STATES , $mask, $value);
}

sub set_cp1_on {
	return xport::exec_cmd( XPORT_SET_CURRENT_STATES , XPORT_CP1, XPORT_CP1);
}

sub set_cp1_off {
	return xport::exec_cmd( XPORT_SET_CURRENT_STATES , XPORT_CP1, 0x00);
}

sub set_cp2_on {
	return xport::exec_cmd( XPORT_SET_CURRENT_STATES , XPORT_CP2, XPORT_CP2);
}

sub set_cp2_off {
	return xport::exec_cmd( XPORT_SET_CURRENT_STATES , XPORT_CP2, 0x00);
}

sub set_cp3_on {
	return xport::exec_cmd( XPORT_SET_CURRENT_STATES , XPORT_CP3, XPORT_CP3);
}

sub set_cp3_off {
	return xport::exec_cmd( XPORT_SET_CURRENT_STATES , XPORT_CP3, 0x00);
}

sub connect
{
	(my $xport_ip, my $xport_port) = @_ ;
	if( $xport_port == undef ) { $xport_port='30704'; } 
	my $sock = IO::Socket::INET->new(
		PeerAddr => $xport_ip,
		PeerPort => $xport_port,
		Proto => 'tcp');
	$sock->send(pack('C*',XPORT_GET_DIRECTIONS , 0x00,0x00,0x00,0x00, 0x00,0x00,0x00,0x00 ));
	$sock->flush();
	read($sock, my $res, 5);
	$sock->close();
	return $res;
}

# Connect to the Xport, send commandstring and read result.
sub con
{
	my $sock = IO::Socket::INET->new(
		PeerAddr => '192.168.1.47',
		PeerPort => '30704',
		Proto => 'tcp');
	$sock->send(pack('C*', @_));
	$sock->flush();
	read($sock, my $res, 5);
	$sock->close();
	return $res;
}

1;