#!/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;