equal
deleted
inserted
replaced
27 use Quancom::Result; |
27 use Quancom::Result; |
28 |
28 |
29 our $VERSION = 0.1; |
29 our $VERSION = 0.1; |
30 |
30 |
31 my $DEFAULT_PORT = 1001; |
31 my $DEFAULT_PORT = 1001; |
|
32 my $STX = "\x02"; |
32 |
33 |
33 sub new { |
34 sub new { |
34 my $class = ref $_[0] ? ref shift : shift; |
35 my $class = ref $_[0] ? ref shift : shift; |
35 my $self = bless {} => $class; |
36 my $self = bless {} => $class; |
36 |
37 |
62 sub cmd { |
63 sub cmd { |
63 my $self = shift; |
64 my $self = shift; |
64 my $cmd = shift; |
65 my $cmd = shift; |
65 |
66 |
66 $self->_tx($cmd); |
67 $self->_tx($cmd); |
67 $self->_rx($cmd); |
68 $self->_rx; |
68 |
69 |
69 return $self->{last_result}; |
70 return $self->{last_result}; |
|
71 } |
|
72 |
|
73 sub reset { |
|
74 my $self = shift; |
|
75 $self->cmd("SL 0007 00.00.00.01"); |
|
76 } |
|
77 |
|
78 sub full_reset { |
|
79 my $self = shift; |
|
80 $self->reset->ok or return $self->{last_result}; |
|
81 $self->cmd("WB 0007 00"); |
70 } |
82 } |
71 |
83 |
72 sub TIESCALAR { |
84 sub TIESCALAR { |
73 my $class = shift; |
85 my $class = shift; |
74 my ($ip) = @_; |
86 my ($ip) = @_; |
88 |
100 |
89 sub _tx { |
101 sub _tx { |
90 my $self = shift; |
102 my $self = shift; |
91 my $cmd = shift; |
103 my $cmd = shift; |
92 |
104 |
|
105 $cmd =~ s/[^A-Z\d]//g; |
|
106 |
93 $self->{job} = ++$self->{job} % 255; # cap the job id on 255; |
107 $self->{job} = ++$self->{job} % 255; # cap the job id on 255; |
94 $cmd = "\x02" . sprintf("%02x", $self->{job}) . $cmd; # add STX and job id |
108 $cmd = $STX . sprintf("%02x", $self->{job}) . $cmd; # add STX and job id |
95 $cmd .= sprintf("%02x", unpack("%8C*", $cmd)); # add checksum |
109 $cmd .= sprintf("%02x", unpack("%8C*", $cmd)); # add checksum |
96 |
110 |
97 warn "sending $cmd\n"; |
111 $cmd =~ /^.(..)(......)(.*)(..)/; |
|
112 warn "sending $1 $2 $3 ($4)\n"; |
98 $self->{socket}->print($cmd . "\r"); |
113 $self->{socket}->print($cmd . "\r"); |
99 } |
114 } |
100 |
115 |
101 sub _rx { |
116 sub _rx { |
102 my $self = shift; |
117 my $self = shift; |
103 |
118 |
104 local $/ = "\r"; # CR is the delimiter |
119 local $/ = "\r"; # CR is the delimiter |
105 |
120 |
106 local $_ = $self->{socket}->getline; |
121 local $_ = $self->{socket}->getline; |
107 $self->{last_result} = new Quancom::Result($_); |
122 # chomp; warn "<<$_>>\n"; |
108 |
123 return $self->{last_result} = new Quancom::Result($_); |
109 } |
124 } |
110 |
125 |
111 1; |
126 1; |
112 |
127 |
113 __END__ |
128 __END__ |
145 |
160 |
146 The only tested I<string> is currently "WB0101FF", which should set |
161 The only tested I<string> is currently "WB0101FF", which should set |
147 all bits on the first relais. Some other (untested) string for setting |
162 all bits on the first relais. Some other (untested) string for setting |
148 just the lowest bit on the first relais should be "WB010001". |
163 just the lowest bit on the first relais should be "WB010001". |
149 |
164 |
|
165 =item B<reset>( ) |
|
166 |
|
167 This resets the device by setting the reset control flag. |
|
168 B<Note:> It doesn't reset timeouts etc. To reset these, use |
|
169 L<full_reset()>. |
|
170 |
|
171 =item B<full_reset>( ) |
|
172 |
|
173 This clears the outputs AND resets timeouts by writing zero |
|
174 to all control bits. |
|
175 |
|
176 |
150 =item B<last_result>( ) |
177 =item B<last_result>( ) |
151 |
178 |
152 This returns an object containing the last result. |
179 This returns an object containing the last result. |
153 See L<Quancom::Result> for more information. |
180 See L<Quancom::Result> for more information. |
154 |
181 |