diff -r 200d69222aed -r 6f1e9c4bee3c lib/Quancom.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/Quancom.pm	Tue Dec 09 16:04:23 2008 +0100
@@ -0,0 +1,124 @@
+package Quancom;
+
+use strict;
+use warnings;
+use IO::Socket::INET;
+use Quancom::Result;
+use Carp;
+
+our $VERSION = 0.1;
+
+my $DEFAULT_PORT = 1001;
+
+sub new {
+    my $class = ref $_[0] ? ref shift : shift;
+    my $self = bless {} => $class;
+
+    $self->{peer} = shift or croak "need a peer address!";
+    $self->{peer} .= ":$DEFAULT_PORT"
+      unless $self->{peer} =~ /:\d+$/;
+
+    $self->{socket} = new IO::Socket::INET(
+        Proto    => "tcp",
+        PeerAddr => $self->{peer}
+    );
+
+    $self->{job} = 0;
+    $self->{ok} = undef;
+
+    return $self;
+}
+
+sub last_result { $_[0]->{last_result} }
+
+sub cmd {
+    my $self = shift;
+    my $cmd  = shift;
+
+    $self->_tx($cmd);
+    $self->_rx($cmd);
+
+    return $self->{last_result};
+}
+
+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";    # CR is the delimiter
+    my $r = $self->{socket}->getline;    # now it's a line
+    chomp($r);                           # we do not need the delimiter
+
+    $self->{last_result} = new Quancom::Result;
+
+    # decode the status
+    if (($self->{last_result}{error_code}) = $r =~ /^E(.)/) {
+        $self->{last_result}{ok} = 0;
+    }
+    elsif (my ($jobid, $data, $csum) = $r =~ /^[DO](..)(.*)(..)$/) {
+        $self->{last_result}{ok} = 1;
+	$self->{last_result}{result} = defined $data ? $data : "";
+    }
+    else {
+        die "unknown response $r";
+    }
+
+    return $r;
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+Quancom - perl module to access the usb opto quancom device
+
+=head1 SYNOPSIS
+
+    use Quancom;
+
+    my $q = new Quancom 172.16.0.22;
+    my $r = $q->cmd("xxxxxx") 
+	or die $r->error_message;
+
+=head1 METHODS
+
+=over
+
+=item constructor B<new>( I<ip> )
+
+This method returns a new Quancom object if the connection was
+successfully established.
+
+=item B<send>( I<string> )
+
+Send a Quancom string to the device. The string here should be
+B<without> the leading STX and Jobid as well without the trailing CR.
+
+It returns TRUE on success, FALSE otherwise.
+
+=item B<last_result>( )
+
+This returns an object containing the last result.
+
+=back
+
+=head1 AUTHOR
+
+    Maik Schueller
+    Heiko Schlittermann
+
+=cut