- works a bit
authorHeiko Schlittermann <hs@schlittermann.de>
Tue, 09 Dec 2008 15:58:11 +0100
changeset 3 200d69222aed
parent 2 a19ea3b8c48d
child 4 6f1e9c4bee3c
- works a bit
Quancom.pm
Quancom/.perltidyrc
Quancom/Result.pm
example
qq
--- 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<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<last_result>( )
 
-=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).
+This returns an object containing the last result.
 
 =back
 
--- /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
--- /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<ok> ( )
+
+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
--- /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;
+}
+
--- 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;
-
-}
-