Test server works for command "W"!
Now you can start the test server:
perl -Mblib examples/test-server :5555
and run the client
perl -Mblib examles/client 127.0.0.1:555
--- a/examples/client Sun Jan 04 18:42:46 2009 +0100
+++ b/examples/client Sun Jan 04 23:44:45 2009 +0100
@@ -4,7 +4,6 @@
use warnings;
use Quancom;
use Data::Dumper;
-# use blib;
MAIN: {
my $q = new Quancom $ARGV[0];
--- a/examples/test-server Sun Jan 04 18:42:46 2009 +0100
+++ b/examples/test-server Sun Jan 04 23:44:45 2009 +0100
@@ -8,16 +8,9 @@
use warnings;
use POSIX qw(tmpnam);
use Getopt::Long;
-
-use blib;
use Quancom::Test::Server;
$SIG{INT} = sub { warn "got INT, exit now\n"; exit 0; };
-my $opt_socket = 0;
-
-GetOptions("socket!" => \$opt_socket)
- or die "wrong option!\n";
-
-my $server = new Quancom::Test::Server $opt_socket ? tmpnam() : ();
+my $server = new Quancom::Test::Server @ARGV ? $ARGV[0] : tmpnam();
$server->run;
--- a/lib/Quancom.pm Sun Jan 04 18:42:46 2009 +0100
+++ b/lib/Quancom.pm Sun Jan 04 23:44:45 2009 +0100
@@ -102,7 +102,11 @@
my $self = shift;
local $/ = "\r"; # CR is the delimiter
- $self->{last_result} = new Quancom::Result($self->{socket}->getline);
+
+ local $_ = $self->{socket}->getline;
+ #chomp; warn "got:<$_>\n";
+ $self->{last_result} = new Quancom::Result($_);
+
}
1;
--- a/lib/Quancom/Result.pm Sun Jan 04 18:42:46 2009 +0100
+++ b/lib/Quancom/Result.pm Sun Jan 04 23:44:45 2009 +0100
@@ -24,7 +24,7 @@
my $class = ref $_[0] ? ref shift : shift;
my $self = bless {} => $class;
my $r = shift;
- $r = s/\s*$//; # should match any \r or \n too
+ $r =~ s/\s*$//; # should match any \r or \n too
# decode the status
if (($self->{error_code}) = $r =~ /^E(.)/) {
@@ -49,7 +49,7 @@
sub data {
my $self = shift;
return undef if not $self->{ok};
- return $self->{result};
+ return $self->{data};
}
sub error {
--- a/lib/Quancom/Test/Server.pm Sun Jan 04 18:42:46 2009 +0100
+++ b/lib/Quancom/Test/Server.pm Sun Jan 04 23:44:45 2009 +0100
@@ -7,7 +7,7 @@
use strict;
use warnings;
use Carp;
-use IO::Socket::UNIX;
+use IO::Socket;
use IO::Select;
my $STX = "\x02";
@@ -16,23 +16,39 @@
my $class = ref $_ ? ref shift : shift;
my $self = bless {} => $class;
+ my $addr = shift or croak "need socket address";
- # if there's a filename passed, then we assume it as
- # the UNIX socket for communication, otherwise we communicate
- # via STDIN/STDOUT
- if (@_) {
- $self->{fifo} = shift;
- $self->{socket} = new IO::Socket::UNIX(
- Listen => 1,
- Local => $self->{fifo}
- ) or croak "Can't create IO::Socket::UNIX: $!\n";
- warn "listening on: $self->{fifo}\n";
+ $self->{debug} = 0;
+
+ # if there's a parameter passed we understand it as
+ # a socket address for communication
+ if ($addr eq "-") {
+ warn "listening on: stdio\n";
}
else {
- warn "listening on: stdio\n";
+ if ($addr =~ /\//) {
+ $self->{file} = $addr;
+ $self->{socket} = new IO::Socket::UNIX(
+ Listen => 1,
+ Local => $self->{file}
+ ) or croak "Can't create IO::Socket::UNIX: $!\n";
+ }
+ else {
+ $addr = "127.0.0.1:$1" if $addr =~ /^:?(\d+)/;
+
+ $self->{socket} = new IO::Socket::INET(
+ Listen => 1,
+ ReuseAddr => 1,
+ LocalAddr => $addr
+ ) or croak "Can't create IO::Socket::INET: $!\n";
+ }
+
+ warn "listening on: $addr\n";
}
# we can't use 64bit as Vector (vec()), since not all platforms support it
+ # with this length
+
@{ $self->{outputs} } = map { pack "c", $_ } (0, 0, 0, 0, 0, 0, 0, 0);
$self->show;
@@ -46,7 +62,7 @@
sub DESTROY {
my $self = shift;
- unlink $self->{fifo} if $self->{fifo};
+ unlink $self->{file} if $self->{file};
}
sub run {
@@ -71,8 +87,8 @@
# data
if ($c == $self->{socket}) {
- my $n = $self->{socket}->accept;
- $n->autoflush(1);
+ my $n = $self->{socket}->accept;
+ $n->autoflush(1);
$s->add($n);
next;
}
@@ -81,10 +97,8 @@
my $l = <$c>;
$s->remove($c), next if not defined $l;
chomp $l;
- $l = $self->_process($l);
- warn "sending $l\n";
- $self->{socket}->print($l . "\r");
- warn "done\n";
+ $l = $self->_process($l);
+ $c->print($l . "\r");
}
}
return;
@@ -106,7 +120,7 @@
$line =~ s/^$STX//; # cut STX, if any
$line =~ s/(..)$//; # cut checksum
- warn "got: <STX>$line($1)\n";
+ warn "got: <STX>$line($1)\n" if $self->{debug};
return pack("ac", "E", 1) # checksum error
if $1 ne ".." and hex($1) != unpack("%8C*", "$STX$line");
@@ -137,18 +151,15 @@
my $offset = $addr - 0x100;
- warn "@data\n";
-
- $self->show;
@{ $self->{outputs} }[ $offset .. $offset + $width - 1 ] =
map { pack "C", hex($_) } @data;
$self->show;
- $retval = "O$jid";
+ $retval = "O$jid";
}
else {
- warn "command \"$cmd\" not supported\n";
- $retval = pack("ac", "E", 2);
+ warn "command \"$cmd\" not supported\n";
+ $retval = pack("ac", "E", 2);
}
return $retval . sprintf("%02x", unpack("%8C*", $retval));