# HG changeset patch
# User heiko@jumper
# Date 1231109085 -3600
# Node ID d6f68132954297b78b05936cbfd996e313c715de
# Parent  ad264ee5d5baeb4bb4002bd7b47f9325bb5f26f8
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

diff -r ad264ee5d5ba -r d6f681329542 examples/client
--- 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];
diff -r ad264ee5d5ba -r d6f681329542 examples/test-server
--- 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;
diff -r ad264ee5d5ba -r d6f681329542 lib/Quancom.pm
--- 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;
diff -r ad264ee5d5ba -r d6f681329542 lib/Quancom/Result.pm
--- 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 {
diff -r ad264ee5d5ba -r d6f681329542 lib/Quancom/Test/Server.pm
--- 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));