--- 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
--- 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;
+
}