# HG changeset patch # User Heiko Schlittermann # Date 1228834691 -3600 # Node ID 200d69222aed608c521cedcb331ca545898f4d87 # Parent a19ea3b8c48d0d7e003ea78b798e721e280ac70f - works a bit diff -r a19ea3b8c48d -r 200d69222aed Quancom.pm --- a/Quancom.pm Tue Dec 09 14:25:33 2008 +0100 +++ b/Quancom.pm Tue Dec 09 15:58:11 2008 +0100 @@ -3,6 +3,7 @@ use strict; use warnings; use IO::Socket::INET; +use Quancom::Result; my $DEFAULT_PORT = 1001; @@ -25,6 +26,8 @@ return $self; } +sub last_result { $_[0]->{last_result} } + sub cmd { my $self = shift; my $cmd = shift; @@ -32,34 +35,7 @@ $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} ]; + return $self->{last_result}; } sub _tx { @@ -81,13 +57,15 @@ 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->{error_code}) = $r =~ /^E(.)/) { - $self->{ok} = 0; + if (($self->{last_result}{error_code}) = $r =~ /^E(.)/) { + $self->{last_result}{ok} = 0; } elsif (my ($jobid, $data, $csum) = $r =~ /^[DO](..)(.*)(..)$/) { - $self->{ok} = 1; - $self->{result} = defined $data ? $data : ""; + $self->{last_result}{ok} = 1; + $self->{last_result}{result} = defined $data ? $data : ""; } else { die "unknown response $r"; @@ -96,6 +74,7 @@ return $r; } + 1; __END__ @@ -109,8 +88,8 @@ use Quancom; my $q = new Quancom 172.16.0.22; - $q->cmd("xxxxxx") - or die $q->error_message; + my $r = $q->cmd("xxxxxx") + or die $r->error_message; =head1 METHODS @@ -128,23 +107,9 @@ It returns TRUE on success, FALSE otherwise. -=item B ( ) - -Use this method to query the last operations status. - -=item B ( ) - -Returns the last result. This is valid only if the last status is ok, -otherwise you'll get "undef". +=item B( ) -=item B ( [I] ) - -Returns a message describing the last error. Of if you pass an error -code it will the return the associated message. - -=item B ( ) - -Returns the last error code (numerical). +This returns an object containing the last result. =back diff -r a19ea3b8c48d -r 200d69222aed Quancom/.perltidyrc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Quancom/.perltidyrc Tue Dec 09 15:58:11 2008 +0100 @@ -0,0 +1,1 @@ +../.perltidyrc \ No newline at end of file diff -r a19ea3b8c48d -r 200d69222aed Quancom/Result.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Quancom/Result.pm Tue Dec 09 15:58:11 2008 +0100 @@ -0,0 +1,82 @@ +package Quancom::Result; + +use strict; +use warnings; + +sub new { + my $class = ref $_[0] ? ref shift : shift; + return bless {} => $class; +} + +sub ok { + 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} ]; +} + +1; + +__END__ + +=head1 NAME + +Quancom::Result - perl module to access the usb opto quancom device result + +=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 B ( ) + +Use this method to query the last operations status. + +=item B ( ) + +Returns the last result. This is valid only if the last status is ok, +otherwise you'll get "undef". + +=item B ( [I] ) + +Returns a message describing the last error. Of if you pass an error +code it will the return the associated message. + +=item B ( ) + +Returns the last error code (numerical). + +=back + +=head1 AUTHOR + + Maik Schueller + Heiko Schlittermann + +=cut diff -r a19ea3b8c48d -r 200d69222aed example --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/example Tue Dec 09 15:58:11 2008 +0100 @@ -0,0 +1,19 @@ +#! /usr/bin/perl + +use strict; +use warnings; +use Quancom; +use Data::Dumper; + + +MAIN: { + my $q = new Quancom $ARGV[0]; + + my $r; + $r = $q->cmd("WB0101FF"); + print $r->error_message, "\n" if $r->error; + + print $r->ok; + print $q->last_result->ok; +} + diff -r a19ea3b8c48d -r 200d69222aed qq --- a/qq Tue Dec 09 14:25:33 2008 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,15 +0,0 @@ -#! /usr/bin/perl - -use strict; -use warnings; -use Quancom; -use Data::Dumper; - - -MAIN: { - my $q = new Quancom $ARGV[0]; - my $r = $q->cmd("WB0100FF"); - print Dumper $r; - -} -