# HG changeset patch
# User Heiko Schlittermann <hs@schlittermann.de>
# Date 1228829133 -3600
# Node ID a19ea3b8c48d0d7e003ea78b798e721e280ac70f
# Parent  1caa457b59d0bf7171e1e3d3f5fe436cd62eb232
- more api

diff -r 1caa457b59d0 -r a19ea3b8c48d Quancom.pm
--- a/Quancom.pm	Tue Dec 09 13:35:16 2008 +0100
+++ b/Quancom.pm	Tue Dec 09 14:25:33 2008 +0100
@@ -20,6 +20,7 @@
     );
 
     $self->{job} = 0;
+    $self->{ok} = undef;
 
     return $self;
 }
@@ -30,6 +31,35 @@
 
     $self->_tx($cmd);
     $self->_rx($cmd);
+
+    return $self->{ok};
+}
+
+
+sub status {
+    my $self = shift;
+    return $self->{ok};
+}
+
+sub result {
+    my $self = shift;
+    return undef if not $self->{ok};
+    return $self->{result};
+}
+
+sub error {
+    my $self = shift;
+    return undef if $self->{ok};
+    return $self->{error_code};
+}
+
+sub error_message {
+    my $self = shift;
+
+    return undef if !@_ and $self->{ok};
+
+    return ("checksum error", "character error", "invalid command",
+        "invalid width")[ @_ ? $_[0] : $self->{error_code} ];
 }
 
 sub _tx {
@@ -46,8 +76,81 @@
 
 sub _rx {
     my $self = shift;
-    local $/ = "\r";
-    my $r = $self->{socket}->getline;
-    chomp($r);
+
+    local $/ = "\r";    # CR is the delimiter
+    my $r = $self->{socket}->getline;    # now it's a line
+    chomp($r);                           # we do not need the delimiter
+
+    # decode the status
+    if (($self->{error_code}) = $r =~ /^E(.)/) {
+        $self->{ok} = 0;
+    }
+    elsif (my ($jobid, $data, $csum) = $r =~ /^[DO](..)(.*)(..)$/) {
+        $self->{ok} = 1;
+	$self->{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;
+    $q->cmd("xxxxxx") 
+	or die $q->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<status> ( )
+
+Use this method to query the last operations status.
+
+=item B<result> ( )
+
+Returns the last result. This is valid only if the last status is ok,
+otherwise you'll get "undef".
+
+=item B<error_message> ( [I<error code>] )
+
+Returns a message describing the last error. Of if you pass an error
+code it will the return the associated message.
+
+=item B<error> ( )
+
+Returns the last error code (numerical).
+
+=back
+
+=head1 AUTHOR
+
+    Maik Schueller
+    Heiko Schlittermann
+
+=cut
diff -r 1caa457b59d0 -r a19ea3b8c48d qq
--- a/qq	Tue Dec 09 13:35:16 2008 +0100
+++ b/qq	Tue Dec 09 14:25:33 2008 +0100
@@ -8,7 +8,8 @@
 
 MAIN: {
     my $q = new Quancom $ARGV[0];
-    my $r = $q->cmd("WB010000");
-    die Dumper $r;
+    my $r = $q->cmd("WB0100FF");
+    print Dumper $r;
+
 }