Reporterstellung aus Grufu-Netzwerk-Dump

create-report.pl

#!/usr/bin/perl

use strict;
use diagnostics;
#use warnings qw(all);
#no warnings qw(uninitialized);
no warnings;

use Data::Dumper;
use DateTime;

# stx  type            null time           etx crc 
# 01   05   60 03 00   00   66 02 05 05 05 03  06 

# 0692	0	01	01648	16.03.2015	00:27:32	00:31:01000400	+013200	+012800	21	2
# 0588	0	01	01649	16.03.2015	00:50:51	00:52:02000160	+012820	+012660	21	2

#  Stallnummer (numerisch)
#  Transpondernummer
#  Datum (Start)
#  Anfangszeit
#  Endzeit
#  Menge (in g)

my $line_regex = '^(\s*\d{10}\s+)[A-Z0-9]{1,2}(\s[A-Z0-9]{1,2})*\s?$';
my $chunk_regex = '([A-Z0-9]{1,2})\s+';
my $day_regex = '(\d\d)\.(\d\d)\.(\d\d\d\d)';
my $tz = "Europe/Berlin";

my $day  = $ARGV[0];
my $file = $ARGV[1];

if (!$day or $day !~ /$day_regex/) {
    warn "Usage: $0 <DD.MM.YYYY> [FILE]\n\n";
    exit(42);
}

if ($file and not -r $file) {
    warn "File $file not readable\n\n";
    exit(23);
}

my $DEBUG = 0;

my $STH = 1; # start of headers
my $STX = 2; # start of text
my $ETX = 3; # end of text

my $sw;
if ($file) {
    open $sw, '<', $file or die "Unable to open file '$file' for reading.\n";
}
else {
    $sw = *STDIN;
}

sub trim;
sub merge_lines;

my @day_p = $day =~ /$day_regex/;

my $time_from = DateTime->new(
  year       => $day_p[2],
  month      => $day_p[1],
  day        => $day_p[0],
  hour       => 0,
  minute     => 0,
  second     => 0,
  time_zone  => $tz,
);

my $time_to = DateTime->new(
  year       => $day_p[2],
  month      => $day_p[1],
  day        => $day_p[0],
  hour       => 23,
  minute     => 59,
  second     => 59,
  time_zone  => $tz,
);

my @packet;
my $linectr = 0;
my $line;
my $last_tail;
my $time;
while ($line = <$sw>) {
    $linectr++;

    my $ptr;

    if ($line =~ /$line_regex/) {
        $ptr = length($1);
        $time = DateTime->from_epoch(epoch => trim($1), time_zone => $tz);
    }
    else {
        warn "invalid file format in $file line $linectr: $line\n";
    }

    if ($last_tail) {
        $line = merge_lines($last_tail, $line);
        undef $last_tail;
        $ptr = 0;
    }

    next if ($time < $time_from or $time > $time_to);

    my @packet = (substr($line, $ptr, length($line)) =~ /$chunk_regex/g);

    my $parsed_packet = parsepacket($time, @packet);

    if ($parsed_packet->{error} =~ /packet not correctly terminated/) {
        die("packet in line $line not cor term\n");
    }

    my $parsed_tail_packet;
    if ($parsed_packet->{tail}) {
        my @tail_packet = ($parsed_packet->{tail} =~ /$chunk_regex/g);
        $parsed_tail_packet = parsepacket($time, @tail_packet);
    }

    print_log_entry($parsed_packet->{packet}) unless $parsed_packet->{error};

    if ($parsed_tail_packet) {
        if ($parsed_tail_packet->{error}) {
            $last_tail = $parsed_packet->{tail};
        }
        else {
            print_log_entry($parsed_tail_packet->{packet}, "tail");
        }
    }

    if ($parsed_packet->{packet}->{mess}->{feed} and $DEBUG > 1) {
        for my $chunk (@packet) {
            print "-> $chunk\n";
        }
        print "\n";
    }

}

sub merge_lines {
    my $line1 = shift; # has no timestamp
    my $line2 = shift; # appendix, has timestamp


    my $time;
    my $ptr;
    if ($line2 =~ /$line_regex/) {
        $ptr = length($1);
        $time = trim($1);
    }
    else {
        warn "invalid file format when mergine: line1: $line1, line2: $line2\n";
    }

    my $line2_no_ts = substr($line, $ptr, length($line));

    my @subpacket1 = ($line1 =~ /$chunk_regex/g);
    my @subpacket2 = ($line2_no_ts =~ /$chunk_regex/g);

    if (length($subpacket1[-1]) == length($subpacket2[0])) {
        if (length($subpacket1[-1]) == 1) {
            $subpacket1[-1] .= $subpacket2[0];
            push @subpacket1, @subpacket2[1 .. scalar @subpacket2];
        }
        else {
            push @subpacket1, @subpacket2;
        }
    }

    return join ' ', @subpacket1;
}




sub trim {
    my $str = shift;
    $str =~ s/^\s+|\s+$//g;
    return $str;
}

sub parsepacket {
    my $recv = shift; # time received
    my @packet_raw = @_;

    my $p = { recv => $recv->epoch() };

    my $i = 0;

    # try to parse whole packet
    return {packet => $p, error => "not a new packet (no STH at i=$i, got ".(hex($packet_raw[$i])+0).")"}
        if (hex($packet_raw[$i])+0 != $STH);
    $i++;

    $p->{time} = hex(trim($packet_raw[$i++]));
    $p->{dadr} = hex(trim($packet_raw[$i++]));
    $p->{len}  = hex(trim($packet_raw[$i++]));
    $p->{oadr} = trim($packet_raw[$i++]) + 0;

    my $null = hex($packet_raw[$i])+0;
    return {packet => $p, error => "invalid null (got $null, expected 0)"}
        if ($null != 0);
    $i++;

    my $calculated_bcch = $p->{time} ^ $p->{dadr} ^ $p->{len} ^ hex($p->{oadr});
    $p->{bcch} = hex($packet_raw[$i]);
    return {packet => $p, error => "invalid header checksum (got ".$p->{bcch}.", expected $calculated_bcch)"}
        if ($calculated_bcch != $p->{bcch});
    $i++;

    return {packet => $p, error => "not a new packet (no STX at i=$i)"}
        if (hex($packet_raw[$i])+0 != $STX);
    $i++;

    my $old_raw_len = scalar @packet_raw;

    $p->{mess} = parsemsg(@packet_raw[$i .. ($i + $p->{len} - 1)]);
    $i += $p->{len};

    my $raw_len = scalar @packet_raw;
    if (hex($packet_raw[$i])+0 != $ETX) {
        return {packet => $p, error => "packet not correctly terminated (no ETX)"};
    }
    $i += 2;

    # maybe check mchskm

    if ($i < $raw_len) {
        return {packet => $p, tail => join ' ', @packet_raw[$i .. $raw_len]}
    }

    return { packet => $p };
}

sub parsemsg {
    my @msg = @_;

    my $m = {};
    if (chr(hex($msg[0])) eq 'D') {
        # parse feed msg
        $m->{feed} = 1;

        my @transp = [];
        $transp[0] = int(hex($msg[2])/16);
        $transp[1] = int(hex($msg[2]) - $transp[0]*16);
        $transp[2] = int(hex($msg[3])/16);
        $transp[3] = int(hex($msg[3]) - $transp[2]*16);
        $m->{transp} = join('', @transp);

        $m->{time} = hex($msg[4]*256) + hex($msg[5]);
        
        $m->{weight} = hex($msg[6])*16777216 + hex($msg[7])*65536 + hex($msg[8])*256 + hex($msg[9]);
        $m->{weight} = - $m->{weight} if !($msg[10] + 0);

        $m->{lost_events} = hex($msg[11]);
    }
    elsif (chr(hex($msg[0])) eq 'B') {
        # parse fill msg
        $m->{fill} = 1;

        $m->{weight} = hex($msg[1])*16777216 + hex($msg[2])*65536 + hex($msg[3])*256 + hex($msg[4]);
        $m->{weight} = - $m->{weight} if !($msg[5] + 0);

        $m->{lost_events} = hex($msg[6]);
    }
    
    return $m;
}

sub print_log_entry {
    my $p = shift;
    my $tag = shift;

    my $start = DateTime->from_epoch(epoch => $p->{recv}, time_zone => $tz);

    if ($p->{mess}->{feed}) {
        my $end = DateTime->from_epoch(epoch => $p->{recv} + $p->{mess}->{time}, time_zone => $tz);
        printf("%02d %s %05d %s %s %s %+07d\n",
            $p->{oadr},
            'FEED',
            $p->{mess}->{transp},
            $start->dmy('.'),
            $start->hms(),
            $end->hms(),
            $p->{mess}->{weight}
        );
    }
    elsif ($p->{mess}->{fill}) {
        printf("%02d %s %05d %s %s %s %+07d\n",
            $p->{oadr},
            'FILL',
            0,
            $start->dmy('.'),
            $start->hms(),
            $start->hms(),
            $p->{mess}->{weight}
        );
    }
    else {
        printf("%02d %s %s %s %s\n",
            $p->{oadr},
            'UNKN',
            $start->dmy('.'),
            $start->hms(),
            $start->hms()
        ) if $DEBUG;
    }
}