require Exporter;
our @ISA = qw(Exporter);
-our @EXPORT = qw( modbus_crc16 $protocol read_parameter_frame );
+our @EXPORT = qw( modbus_crc16 $protocol read_parameter_frame write_parameter_frame $function_code_description hex_dump protocol_decode );
use Data::Dump qw(dump);
return $frame . modbus_crc16($frame);
}
+sub write_parameter_frame {
+ my $params = join('', @_);
+
+ my $frame
+ = "\x5A" # header
+ . "\x0B" # protocol version
+ . "\x06" # function code
+ . pack("v", length($params)) # data length
+ ;
+
+ $frame .= $params;
+
+ return $frame . modbus_crc16($frame);
+}
+
+our $function_code_description = {
+ up => {
+ 0x07 => 'Upstream Heartbeat Frame',
+ 0x08 => 'Upstream alarm frame',
+ 0x03 => 'Upstream Read Parameter Frame',
+ 0x06 => 'Upstream return write parameter frame',
+ },
+ down => {
+ 0x03 => 'Downstream read parameter frame',
+ 0x06 => 'Downstream write parameter frame',
+ }
+};
+
+sub hex_dump {
+ my $bin = shift;
+ my $hex = unpack('H*', $bin);
+ $hex =~ s{(..)}{$1 }g;
+ return $hex;
+}
+
+sub protocol_decode {
+ my ( $up_down, $bin ) = @_;
+
+ $SIG{__WARN__} = sub {
+ return unless $debug;
+ print STDERR @_;
+ };
+
+ my $hash = {
+ up_down => $up_down,
+ bin => $bin,
+ };
+
+ my $cksum = substr($bin, -2, 2);
+
+ if ( my $crc = modbus_crc16( substr($bin,0,-2) ) ) {
+ if ( $crc ne $cksum ) {
+ $hash->{error}->{crc} = "got " . unpack('H*',$crc) . " expected " . unpack('H*',$cksum);
+ }
+ }
+
+ my ( $header, $ver, $function_code, $len ) = unpack("CCCv", $bin);
+
+ $hash->{function_code} = $function_code;
+ $hash->{ver} = $ver;
+ $hash->{len} = $len;
+
+ my $data = substr($bin,5,-2);
+
+ warn "header = $header 0x", hex_dump($header)," ver = $ver function_code = $function_code len = $len == ",length($data), " data = ",hex_dump($data), " cksum = ", unpack('H*',$cksum);
+
+ if ( $header != 0x5a ) {
+ $hash->{error}->{header} = "$header expected 0x5a";
+ }
+
+ my $length_data = length($data);
+ if ( $length_data != $len ) {
+ $hash->{error}->{length} = "$length_data expected $len";
+ }
+
+
+ while ( $data ) {
+
+ warn "XXX data = ", hex_dump($data);
+
+ my $data_id = unpack( 'C', substr($data,0,1) );
+
+ if ( ! exists( $protocol->{$data_id} ) ) {
+ my $len = unpack('C', substr($data,1,1));
+ push @{ $hash->{error}->{data_id} }, sprintf "data_id %d 0x%2x len %d [%s]", $data_id, $data_id, $len, unpack('H*', substr($data,2,$len));
+ $data = substr($data,2 + $len);
+ next;
+ }
+ my $pack_fmt = $protocol->{$data_id}->{pack_fmt} || die "can't find pack_fmt for data_id $data_id";
+
+ my $data_range;
+ my $data_len;
+
+ if ( $data_id == 0x00 ) {
+ # sequence number
+
+ $data_range = substr($data,2,4);
+ $data = substr($data,6);
+
+ } elsif ( $up_down eq 'down' && $function_code == 0x03 ) {
+ # type A
+ # 0x03 => 'Downstream read parameter frame',
+
+ $data_range = substr($data,0,1);
+ $data = substr($data,1);
+
+ } elsif ( $up_down eq 'up' && ( $function_code == 0x07 || $function_code == 0x08 || $function_code == 0x03 ) ) {
+ # type B
+ # 0x07 => 'Upstream Heartbeat Frame',
+ # 0x08 => 'Upstream alarm frame',
+ # 0x03 => 'Upstream Read Parameter Frame',
+
+ $data_len = unpack('C', substr($data,1,1));
+ $data_range = substr($data,2, $data_len);
+
+ $data = substr($data,2 + $data_len);
+
+ } elsif ( $up_down eq 'down' && $function_code == 0x06 ) {
+ # type B
+ # 0x06 => 'Downstream write parameter frame',
+
+ $data_len = unpack('C', substr($data,1,1));
+ $data_range = substr($data,2, $data_len);
+
+ $data = substr($data,2 + $data_len);
+
+ } elsif ( $up_down eq 'up' && $function_code == 0x06 ) {
+ # type C
+ # 0x06 => 'Upstream return write parameter frame',
+
+ $data_len = unpack('C', substr($data,1,1));
+ $data_range = substr($data,2, $data_len);
+ if ( $data_len == 1 ) {
+ # XXX return is OK/not OK
+ $pack_fmt = 'C';
+ }
+
+ $data = substr($data,2 + $data_len);
+
+ } else {
+ $hash->{error}->{function_code_unknown} = $function_code;
+ print STDERR "ERROR unknown function_code = $function_code\n";
+ return $hash;
+ }
+
+ my @v = unpack($pack_fmt, $data_range);
+
+ my $v = join(' ', @v);
+
+ if ( $data_id == 0x0c ) {
+ $v = $v / 100;
+ } elsif ( $data_id == 0x0d ) {
+ $v = $v / 100;
+ }
+
+ push @{ $hash->{data_id_order} }, $data_id;
+ $hash->{data_id}->{$data_id} = $v;
+ $hash->{data_len}->{$data_id} = $data_len;
+ $hash->{data_range}->{$data_id} = $data_range;
+
+ }
+
+ return $hash;
+
+} # protocol_decode
+
+
1;
# 6. Protocol Format
0x04 Y axis angle f Float(4) R -90-90 / Y axis angle
0x09 X axis relative angle f Float(4) R -90-90 0 Return the X angle value according to the set relative zero
0x0A Y axis relative angle f Float(4) R -90-90 0 Return the Y angle value according to the set relative zero
-0x0C Sensor temperature s Word(2) R -32768-32767 / signed,sensor temperature =Data/100, unit \83
+0x0C Sensor temperature s Word(2) R -32768-32767 / signed,sensor temperature =Data/100, unit celsius
0x0D Power source voltage S Word(2) R 0~65535 / Voltage= Data/100, unit V
0x0E Heartbeat interval l DWord(4) R/W 60~2160000 86400 ZCT330E Interval at which the device periodically uploads data to the server
0x0F Failure interval l DWord(4) R/W 60~2160000 3600 ZCT330E Interval at which the device failure is retransmitted