equal
deleted
inserted
replaced
1 package Quancom; |
1 package Quancom; |
2 |
2 |
3 use strict; |
3 use strict; |
4 use warnings; |
4 use warnings; |
5 use IO::Socket::INET; |
5 use IO::Socket::INET; |
|
6 use Quancom::Result; |
6 |
7 |
7 my $DEFAULT_PORT = 1001; |
8 my $DEFAULT_PORT = 1001; |
8 |
9 |
9 sub new { |
10 sub new { |
10 my $class = ref $_[0] ? ref shift : shift; |
11 my $class = ref $_[0] ? ref shift : shift; |
23 $self->{ok} = undef; |
24 $self->{ok} = undef; |
24 |
25 |
25 return $self; |
26 return $self; |
26 } |
27 } |
27 |
28 |
|
29 sub last_result { $_[0]->{last_result} } |
|
30 |
28 sub cmd { |
31 sub cmd { |
29 my $self = shift; |
32 my $self = shift; |
30 my $cmd = shift; |
33 my $cmd = shift; |
31 |
34 |
32 $self->_tx($cmd); |
35 $self->_tx($cmd); |
33 $self->_rx($cmd); |
36 $self->_rx($cmd); |
34 |
37 |
35 return $self->{ok}; |
38 return $self->{last_result}; |
36 } |
|
37 |
|
38 |
|
39 sub status { |
|
40 my $self = shift; |
|
41 return $self->{ok}; |
|
42 } |
|
43 |
|
44 sub result { |
|
45 my $self = shift; |
|
46 return undef if not $self->{ok}; |
|
47 return $self->{result}; |
|
48 } |
|
49 |
|
50 sub error { |
|
51 my $self = shift; |
|
52 return undef if $self->{ok}; |
|
53 return $self->{error_code}; |
|
54 } |
|
55 |
|
56 sub error_message { |
|
57 my $self = shift; |
|
58 |
|
59 return undef if !@_ and $self->{ok}; |
|
60 |
|
61 return ("checksum error", "character error", "invalid command", |
|
62 "invalid width")[ @_ ? $_[0] : $self->{error_code} ]; |
|
63 } |
39 } |
64 |
40 |
65 sub _tx { |
41 sub _tx { |
66 my $self = shift; |
42 my $self = shift; |
67 my $cmd = shift; |
43 my $cmd = shift; |
79 |
55 |
80 local $/ = "\r"; # CR is the delimiter |
56 local $/ = "\r"; # CR is the delimiter |
81 my $r = $self->{socket}->getline; # now it's a line |
57 my $r = $self->{socket}->getline; # now it's a line |
82 chomp($r); # we do not need the delimiter |
58 chomp($r); # we do not need the delimiter |
83 |
59 |
|
60 $self->{last_result} = new Quancom::Result; |
|
61 |
84 # decode the status |
62 # decode the status |
85 if (($self->{error_code}) = $r =~ /^E(.)/) { |
63 if (($self->{last_result}{error_code}) = $r =~ /^E(.)/) { |
86 $self->{ok} = 0; |
64 $self->{last_result}{ok} = 0; |
87 } |
65 } |
88 elsif (my ($jobid, $data, $csum) = $r =~ /^[DO](..)(.*)(..)$/) { |
66 elsif (my ($jobid, $data, $csum) = $r =~ /^[DO](..)(.*)(..)$/) { |
89 $self->{ok} = 1; |
67 $self->{last_result}{ok} = 1; |
90 $self->{result} = defined $data ? $data : ""; |
68 $self->{last_result}{result} = defined $data ? $data : ""; |
91 } |
69 } |
92 else { |
70 else { |
93 die "unknown response $r"; |
71 die "unknown response $r"; |
94 } |
72 } |
95 |
73 |
96 return $r; |
74 return $r; |
97 } |
75 } |
|
76 |
98 |
77 |
99 1; |
78 1; |
100 |
79 |
101 __END__ |
80 __END__ |
102 |
81 |
107 =head1 SYNOPSIS |
86 =head1 SYNOPSIS |
108 |
87 |
109 use Quancom; |
88 use Quancom; |
110 |
89 |
111 my $q = new Quancom 172.16.0.22; |
90 my $q = new Quancom 172.16.0.22; |
112 $q->cmd("xxxxxx") |
91 my $r = $q->cmd("xxxxxx") |
113 or die $q->error_message; |
92 or die $r->error_message; |
114 |
93 |
115 =head1 METHODS |
94 =head1 METHODS |
116 |
95 |
117 =over |
96 =over |
118 |
97 |
126 Send a Quancom string to the device. The string here should be |
105 Send a Quancom string to the device. The string here should be |
127 B<without> the leading STX and Jobid as well without the trailing CR. |
106 B<without> the leading STX and Jobid as well without the trailing CR. |
128 |
107 |
129 It returns TRUE on success, FALSE otherwise. |
108 It returns TRUE on success, FALSE otherwise. |
130 |
109 |
131 =item B<status> ( ) |
110 =item B<last_result>( ) |
132 |
111 |
133 Use this method to query the last operations status. |
112 This returns an object containing the last result. |
134 |
|
135 =item B<result> ( ) |
|
136 |
|
137 Returns the last result. This is valid only if the last status is ok, |
|
138 otherwise you'll get "undef". |
|
139 |
|
140 =item B<error_message> ( [I<error code>] ) |
|
141 |
|
142 Returns a message describing the last error. Of if you pass an error |
|
143 code it will the return the associated message. |
|
144 |
|
145 =item B<error> ( ) |
|
146 |
|
147 Returns the last error code (numerical). |
|
148 |
113 |
149 =back |
114 =back |
150 |
115 |
151 =head1 AUTHOR |
116 =head1 AUTHOR |
152 |
117 |