#!perl
use strict;
use warnings;
use Data::Dumper;
my (
    @meta,
    %range,                     # base types.
    %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;
my %define;
my %define_is_str;

my $ZERO= "Sereal.git:Perl/shared/author_tools/update_from_header.pl";

sub fill_range {
    my $pfx= shift;
    $pfx =~ s/_LOW//;
    defined( my $ofs= $name_to_value_expanded{$pfx} )
        or die "unknown $pfx";
    for my $value (
        $name_to_value_expanded{ $pfx . "_LOW" } .. $name_to_value_expanded{ $pfx . "_HIGH" } )
    {
        my $n= $pfx =~ /NEG/ ? abs( $value - 32 ) : $value - $ofs;
        my $name= $pfx . "_" . $n;
        $name_to_value_expanded{$name} ||= $value;
        $value_to_name_expanded{$value}= $name;
        $value_to_comment_expanded{$value} ||= '';

        $meta[$value]{name}= $name;
        $meta[$value]{value}= $value;
        $meta[$value]{type_name}= $pfx;
        $meta[$value]{type_value}= $ofs;

        push @{ $range{$pfx} }, $meta[$value];

        #$meta[$value]{comment}= $value_to_comment_expanded{ $ofs }
        #    if exists $value_to_comment_expanded{ $ofs };

        $meta[$value]{masked_val}= $n;
        $meta[$value]{masked}= 1;

        #$define{"SRL_HDR_".$name}= $value;
    }
    $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>) {
        chomp;
        my $orig= $_;
        if (m!^#define\s+(SRL_HDR_(\S+))\s+\(\(U8\)(\d+)\)\s*(?:/\*\s*(.*?)\s*\*/)?\s*\z!i) {
            my ( $full_name, $name, $value, $comment )= ( $1, $2, $3, $4 );
            $value= 0 + $value;
            $name_to_value{$name}= $value;
            $name_to_value_expanded{$name}= $value;
            $value_to_name_expanded{$value}    ||= $name;
            $value_to_comment_expanded{$value} ||= $comment;
            push @fill, $name if substr( $name, -4 ) eq '_LOW';

            if ( $value < 128 && !( $name =~ /_LOW/ or $name =~ /_HIGH/ ) ) {
                $meta[$value]{name}= $name;
                $meta[$value]{value}= $value;
                $meta[$value]{type_name}= $name;
                $meta[$value]{type_value}= $value;
                $meta[$value]{comment}= $comment if defined $comment;
            }
            $define{$full_name}= $value;
        }
        elsif (s!^#define (SRL_\w+)\s+!!) {
            my $def= $1;
            s!/\*.*?(?:\*/|$)!!m;
            s!\(U8\)!!g;
            s!(SRL_\w+)!
                $define{$1} // die "Unknown define '$1'";
            !ge;
            s!\A\s+!!;
            s!\s+\z!!;
            my $val;
            my $code= "\$val= $_; 1";
            eval $code or die "Failed to eval $code (from $orig): $@";
            $define{$def}= $val;
            $define_is_str{$def}= 1 if /[""]/;
        }
    }
    close $fh;
    fill_range($_) for @fill;
    foreach my $pfx ( keys %name_to_value_expanded ) {
        $max_name_length= length($pfx) if $max_name_length < length($pfx);
    }

    #print Data::Dumper->new([\%define, \%define_is_str])->Useqq(1)->Sortkeys(1)->Dump();
}

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);
    my $gotit;
    READ: {

        while (<$in>) {
            print $out $_;
            last if $gotit= ( /^=for autoupdater start/ || /^# start autoupdated section/ );
        }

        unless ($gotit) {
            warn "Did NOT find autoupdater start in $file\n";
            last READ;
        }

        $blob =~ s/[ \t]+$//mg;
        $blob =~ s/\s+\z//;

        print $out "\n$blob\n\n";

        while (<$in>) {
            if ( /^=for autoupdater stop/ || /^# stop autoupdated section/ ) {
                print $out $_;
                $gotit= 0;
                last;
            }
        }

        if ($gotit) {
            warn "Did NOT find autoupdater end in $file\n";
            last READ;
        }

        while (<$in>) {
            print $out $_;
        }
    }
    close $out;
    close $in;
    return;
}

sub update_constants {
    my $dump= Data::Dumper->new( [ \@meta ], ['*TAG_INFO_ARRAY'] )->Sortkeys(1)->Useqq(1)->Indent(1)
        ->Dump();
    $dump =~ s/^(\s*)\{/$1# autoupdated by $ZERO do not modify directly!\n$1\{/mg;
    my $defines=
        Data::Dumper->new( [ \%define ], ['*DEFINE'] )->Sortkeys(1)->Useqq(1)->Indent(1)->Dump;
    $defines =~ s/^/    /mg;

    foreach my $mod_suffix (qw(Encoder Decoder Merger Splitter Path)) {
        my $file= "Perl/$mod_suffix/lib/Sereal/$mod_suffix/Constants.pm";
        replace_block(
            $file,
            join "\n",
            "BEGIN {",
            $defines,
            "}",
            "",
            "use constant \\%DEFINE;",
            "push \@EXPORT_OK, keys %DEFINE;",
            $dump,
            "\$TAG_INFO_HASH{chr \$_}= \$TAG_INFO_ARRAY[\$_] for 0 .. 127;",
            "push \@EXPORT_OK, qw(%TAG_INFO_HASH \@TAG_INFO_ARRAY);",
        );
        if (1) {
            system(   qq[perltidy -w -ple -bbb -bbc -bbs -nolq -l=100 -noll -nola -nwls='=' ]
                    . qq[-isbc -nolc -otr -kis -ci=4 -se -sot -sct -nsbl -fs -fsb='#start-no-tidy' ]
                    . qq[-fse='#end-no-tidy' -mft=1 $file] );
            -e "$file.tdy" and rename "$file.tdy", $file;
        }
    }
}

sub update_srl_taginfo_h {
    replace_block(
        "Perl/shared/srl_taginfo.h",
        join(
            "\n",
            "* NOTE this section is autoupdated by $ZERO",
            "*/", "",
            "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
            ),
            "};",
            "", (
                map {
                    sprintf "#define SRL_HDR_%-*s %3d",
                        $max_name_length + 3, $_->{name}, $_->{value}
                } grep { $_->{masked} } @meta
            ),
            "", (
                map {
                    my $n= $_;
                    my $v= $range{$n};
                    my $c=
                        join "    \\\n   ",
                        "#define CASE_SRL_HDR_$n",
                        join ":    \\\n   ",
                        map { "case SRL_HDR_$_->{name}" } @$v;

                    $c . "\n\n";
                } sort keys %range
            ),
            "",
            "/*",
            "* NOTE the above section is auto-updated by $ZERO",
        ) );
}

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

    for my $name (
        sort { $name_to_value{$a} <=> $name_to_value{$b} || $a cmp $b }
        keys %name_to_value
        )
    {
        my $byte= $name_to_value{$name};
        my $decl= sprintf( "byte SRL_HDR_%-*s = (byte) %3d;", $max_name_length, $name, $byte );
        $declarations .= sprintf(
            "  %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 $ZERO";

    replace_block(
        "Java/sereal/src/main/java/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_constants();
update_srl_taginfo_h();
update_table("sereal_spec.pod");
update_table("Perl/shared/srl_protocol.h");
update_JavaSerealHeader();