- first working version
authorheiko@jumper.site
Tue, 09 Dec 2008 13:31:33 +0100
changeset 0 a900786f2174
child 1 1caa457b59d0
- first working version
.perltidyrc
Quancom.pm
tt
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/.perltidyrc	Tue Dec 09 13:31:33 2008 +0100
@@ -0,0 +1,1 @@
+--paren-tightness=2
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Quancom.pm	Tue Dec 09 13:31:33 2008 +0100
@@ -0,0 +1,53 @@
+package Quancom;
+
+use strict;
+use warnings;
+use IO::Socket::INET;
+
+my $DEFAULT_PORT = 1001;
+
+sub new {
+    my $class = ref $_[0] ? ref shift : shift;
+    my $self = bless {} => $class;
+
+    $self->{peer} = shift;
+    $self->{peer} .= ":$DEFAULT_PORT"
+      unless $self->{peer} =~ /:\d+$/;
+
+    $self->{socket} = new IO::Socket::INET(
+        Proto    => "tcp",
+        PeerAddr => $self->{peer}
+    );
+
+    $self->{job} = 0;
+
+    return $self;
+}
+
+sub cmd {
+    my $self = shift;
+    my $cmd  = shift;
+
+    $self->_tx($cmd);
+    $self->_rx($cmd);
+}
+
+sub _tx {
+    my $self = shift;
+    my $cmd  = shift;
+
+    $self->{job} = ++$self->{job} % 255;    # cap the job id on 255;
+    $cmd = "\x02" . sprintf("%02x", $self->{job}) . $cmd;   # add STX and job id
+    $cmd .= sprintf("%02x", unpack("%8C*", $cmd));          # add checksum
+
+    warn "sending $cmd | " . unpack("H*", $cmd) . "\n";
+    $self->{socket}->print($cmd . "\r");
+}
+
+sub _rx {
+    my $self = shift;
+    local $/ = "\r";
+    my $r = $self->{socket}->getline;
+    chomp($r);
+    return $r;
+}
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tt	Tue Dec 09 13:31:33 2008 +0100
@@ -0,0 +1,14 @@
+#! /usr/bin/perl
+
+use strict;
+use warnings;
+use Quancom;
+use Data::Dumper;
+
+
+MAIN: {
+    my $q = new Quancom $ARGV[0];
+    my $r = $q->cmd("WB010000");
+    die Dumper $r;
+}
+