The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl
use strict;
use warnings;
use Data::Dumper;
my (
    %name_to_value,             # just the names in the srl_protocol.h
    %name_to_value_expanded,    # names from srl_protocol, but with the LOW/HIGH data expanded
    %value_to_name_expanded,    # values from srl_protocol_expanded, mapping back, note value points at FIRST name
    %value_to_comment_expanded  # values from srl_protocol_expanded, with comments from file.
);
my $max_name_length= 0;

sub fill_ranges {
    my $pfx= shift;
    $pfx=~s/_LOW//;
    defined(my $ofs= $name_to_value_expanded{$pfx})
        or die "unknown $pfx";
    for my $i ( $name_to_value_expanded{$pfx . "_LOW"} .. $name_to_value_expanded{$pfx . "_HIGH"}) {
        my $n= $pfx=~/NEG/ ? abs($i - 32) : $i - $ofs;
        $name_to_value_expanded{ $pfx . "_" . $n } ||= $i;
        $value_to_name_expanded{ $i } = $pfx . "_". $n;
        $value_to_comment_expanded{ $i } ||= '';
    }
    $value_to_comment_expanded{ $name_to_value_expanded{$pfx . "_HIGH"} } = $value_to_comment_expanded{ $ofs };
}
sub read_protocol {
    open my $fh,"<", "Perl/shared/srl_protocol.h"
        or die "Perl/shared/srl_protocol.h: $!";
    my @fill;
    while (<$fh>) {
        if(m!^#define\s+SRL_HDR_(\S+)\s+\(\(char\)(\d+)\)\s*(?:/\*\s*(.*?)\s*\*/)?\s*\z!i) {
            $name_to_value{$1}= $2;
            $name_to_value_expanded{$1}= $2;
            $value_to_name_expanded{$2} ||= $1;
            $value_to_comment_expanded{$2} ||= $3;
            push @fill, $1 if substr($1,-4) eq '_LOW';
        }
    }
    close $fh;
    fill_ranges($_) for @fill;
    foreach my $pfx (keys %name_to_value_expanded) {
        $max_name_length= length($pfx) if $max_name_length < length($pfx);
    }
}
sub open_swap {
    my $file= shift;
    open my $fh,"<", $file
        or die "error opening $file for read:$!";
    rename $file,"$file.bak"
        or die "error renaming $file to $file.bak: $!";
    open my $out,">", $file
        or die "error opening $file for write (old version in $file.bak):$!";
    return ($fh,$out);
}

sub replace_block {
    my ($file,$blob)= @_;
    my ($in,$out)= open_swap($file);
    while (<$in>) {
        print $out $_;
        last if /^=for autoupdater start/;
    }
    $blob=~s/\s+$//mg;
    print $out "\n$blob\n\n";
    while (<$in>) {
        if (/^=for autoupdater stop/) {
            print $out $_;
            last;
        }
    }
    while (<$in>) {
        print $out $_;
    }
    close $out;
    close $in;
}
sub update_srl_decoder_h {
    replace_block("Perl/Decoder/srl_decoder.h",
        join("\n",
            "* NOTE this section is autoupdated by $0",
            "*/",
            "static const char * const tag_name[] = {",
            ( map {
                my $str= Data::Dumper::qquote(chr($_));
                if ($str=~/^"\\[0-9]+"\z/) { $str="";}
                sprintf qq(\t%-*s /* %-4s %3d 0x%02x 0b%08b */),
                    $max_name_length+3, qq("$value_to_name_expanded{$_}") . ($_==127 ? " " : ","), $str, $_, $_, $_
            } 0 .. 127 ),
            "};",
            "/*",
            "* NOTE the above section is auto-updated by $0",
        )
    )
}

sub update_JavaSerealHeader {
    my $declarations = "* NOTE this section is autoupdated by $0 */\n";

    for my $name (sort { $name_to_value{$a} <=> $name_to_value{$b} } keys %name_to_value) {
        my $byte = $name_to_value{$name};
        my $decl = sprintf("static final byte SRL_HDR_%-*s = (byte) %3d;", $max_name_length, $name, $byte);
        $declarations .= sprintf("\t%s /* %3d 0x%02x 0b%08b %s */\n",
            $decl, $byte, $byte, $byte, $value_to_comment_expanded{$byte}||"");
    }

    $declarations .= "/*\n* NOTE the above section is auto-updated by $0";

    replace_block("Java/src/com/booking/sereal/SerealHeader.java", $declarations);

}

sub update_table {
    replace_block($_[0],
        join("\n",
            "",
            sprintf(qq(    %*s | %-4s | %3s | %4s | %10s | %s),
                $max_name_length,qw(Tag       Char Dec Hex  Binary     Follow  )),
            sprintf(qq(    %*s-+-%-4s-+-%3s-+-%4s-+-%10s |-%s),
                $max_name_length,"-" x $max_name_length, "-" x 4, "-" x 3, "-" x 4, "-" x 10, "-" x 40),
            ( map {
                my $str= Data::Dumper::qquote(chr($_));
                if ($str=~/^"\\[0-9]+"\z/) { $str="";}
                sprintf qq(    %-*s | %-4s | %3d | 0x%02x | 0b%08b | %s),
                    $max_name_length, $value_to_name_expanded{$_}, $str, $_, $_, $_, $value_to_comment_expanded{$_} || ""
            } 0 .. 127 ),
            "",
            "",
        )
    )
}

my $git_dir = `git rev-parse --git-dir`
    or die; # we will get a message from rev-parse iirc
chomp($git_dir);
chdir "$git_dir/.."
    or die "Failed to chdir to root of repo '$git_dir/..': $!";
read_protocol();
update_srl_decoder_h();
update_table("sereal_spec.pod");
update_table("Perl/shared/srl_protocol.h");
update_JavaSerealHeader();