git.rot13.org Git - zc/blob - unpack.pl

   1 #!/usr/bin/perl
   2 use warnings;
   3 use strict;
   4
   5 use Data::Dump qw(dump);
   6
   7 use lib '.';
   8 use Protocol;
   9
  10 my $debug = $ENV{DEBUG};
  11
  12 $| = 1;
  13
  14 warn "## protocol = ",dump( $protocol ) if $debug;
  15
  16 my $pkg_nr = 0;
  17
  18 sub protocol_decode {
  19         my ( $up_down, $hex ) = @_;
  20
  21 warn "up/down: $up_down hex = ",dump($hex);
  22
  23 my $bin = join('', map { chr(hex($_)) } split(/\s+/,$hex));
  24
  25 warn "bin = ", dump($bin);
  26
  27 if ( $debug ) {
  28         open(my $dump, '>', "/dev/shm/zc.$pkg_nr.$up_down");
  29         print $dump $bin;
  30         close($dump);
  31         $pkg_nr++;
  32 }
  33
  34 my $cksum = substr($bin, -2, 2);
  35
  36 if ( my $crc = modbus_crc16( substr($bin,0,-2) ) ) {
  37         if ( $crc ne $cksum ) {
  38                 warn "CRC error, got ",unpack('H*',$crc), " expected ", unpack('H*',$cksum), "\n";
  39         } else {
  40                 warn "CRC OK ", unpack('H*',$crc), "\n";
  41         }
  42 }
  43
  44 my ( $header, $ver, $function_code, $len ) = unpack("CCCv", $bin);
  45
  46 my $data = substr($bin,5,-2);
  47
  48 warn "header = $header ver = $ver function_code = $function_code len = $len == ",length($data), " data = ",dump($data), " cksum = ", unpack('H*',$cksum);
  49
  50 warn "header corrupt: $header" if $header != 0x5a;
  51 warn "invalid length $len got ",length($data) if length($data) != $len;
  52
  53 my $function_code_upstream = {
  54 0x07 => 'Upstream Heartbeat Frame',
  55 0x08 => 'Upstream alarm frame',
  56 0x03 => 'Upstream Read Parameter Frame',
  57 0x06 => 'Upstream return write parameter frame',
  58 };
  59
  60 my $function_code_downstream = {
  61 0x03 => 'Downstream read parameter frame',
  62 0x06 => 'Downstream write parameter frame',
  63 };
  64
  65 print "Function code: $function_code ",
  66         $up_down eq 'up' ? $function_code_upstream->{ $function_code } : $function_code_downstream->{ $function_code }, "\n";
  67
  68
  69
  70
  71 while ( $data ) {
  72         my $hex = unpack('H*', $data);
  73         $hex =~ s/(..)/$1 /g;
  74         warn "XXX data = $hex\n";
  75
  76         my $data_id = unpack( 'C', substr($data,0,1) );
  77         if ( ! exists( $protocol->{$data_id}->{description} ) ) {
  78                 my $len = unpack('C', substr($data,1,1));
  79                 printf "ERROR: no description for data_id %d 0x%2x len %d [%s] SKIPPING!\n", $data_id, $data_id, $len, unpack('H*', substr($data,2,$len));
  80                 $data = substr($data,2 + $len);
  81                 next;
  82         }
  83         my $data_id_desc = $protocol->{$data_id}->{description};
  84         my $pack_fmt = $protocol->{$data_id}->{pack_fmt} || die "can't find pack_fmt for data_id $data_id";
  85
  86         my $data_range;
  87         my $data_len;
  88
  89         if ( $data_id == 0x00 ) {
  90                 # sequence number
  91
  92                 $data_range = substr($data,2,4);
  93                 $data = substr($data,6);
  94
  95         } elsif ( $up_down eq 'down' && $function_code == 0x03 ) {
  96                 # type A
  97
  98                 $data_range = substr($data,0,1);
  99                 $data = substr($data,1);
 100
 101         } elsif ( $up_down eq 'up'   && ( $function_code == 0x07 || $function_code == 0x08 || $function_code == 0x03 ) ) {
 102                 # type B
 103
 104                 $data_len = unpack('C', substr($data,1,1));
 105                 $data_range = substr($data,2, $data_len);
 106
 107                 $data = substr($data,2 + $data_len);
 108
 109         } elsif ( $up_down eq 'down' && $function_code == 0x06 ) {
 110                 # type B
 111
 112                 $data_len = unpack('C', substr($data,1,1));
 113                 $data_range = substr($data,2, $data_len);
 114
 115                 $data = substr($data,2 + $data_len);
 116
 117         } elsif ( $up_down eq 'up' && $function_code == 0x06 ) {
 118                 # type C
 119
 120                 # FIXME check first byte?
 121                 my $data_range = substr($data,1,1);
 122
 123                 $data = substr($data,2);
 124
 125         } else {
 126                 warn "ERROR unknown function_code = $function_code";
 127         }
 128
 129         my @v = unpack($pack_fmt, $data_range);
 130
 131         my $v = join(' ', @v);
 132
 133         if ( $data_id == 0x0c ) {
 134                 $v = $v / 100;
 135         } elsif ( $data_id == 0x0d ) {
 136                 $v = $v / 100;
 137         }
 138
 139         my $description = $protocol->{$data_id}->{description} || die "can't find description for data_id $data_id";
 140         print "$up_down | $data_id 0x",unpack('H*', chr($data_id))," $data_len | $description | v=$v | hex:", unpack('H*', $data_range), " fmt:$pack_fmt | range:",$protocol->{$data_id}->{range}, " | remark:", $protocol->{$data_id}->{remark},"\n";
 141 }
 142
 143
 144 } # protocol_decode
 145
 146 my $raw;
 147 my ( $timestamp, $sensor, $imei, $up_down );
 148 my $stat;
 149 while(<>) {
 150         chomp;
 151
 152         if ( m{^(\d\d\d\d-\d\d-\d\d\s\d\d:\d\d:\d\d).*Inclinometer/([^/]+)/([^/]+)/(\w+)} ) {
 153                 if ( $raw ) {
 154                         $raw =~ s{^\s+}{}; # strip leading spaces
 155                         print "## $timestamp $sensor $imei $up_down $raw\n";
 156                         protocol_decode( $up_down, $raw );
 157                         $raw = '';
 158                 }
 159                 ( $timestamp, $sensor, $imei, $up_down ) = ( $1, $2, $3, $4 );
 160                 $stat->{$sensor}->{$imei}->{$up_down}++;
 161         } elsif ( m{^\s+} ) {
 162                 s/^\s+/ /;
 163                 s/\s\s.+$//g; # remove ascii
 164                 $raw .= $_;
 165                 warn "++ $_\n";
 166         } else {
 167                 warn "IGNORE: $_\n";
 168         }
 169
 170 }
 171
 172 if ( $raw ) {
 173         $raw =~ s{^\s+}{}; # strip leading spaces
 174         print "## $timestamp $sensor $imei $up_down $raw\n";
 175         protocol_decode( $up_down, $raw );
 176 }
 177
 178 print "stat = ",dump($stat), "\n";
 179