pbot/applets/gencstd.pl

#!/usr/bin/env perl

# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT

# ugly and hacked together

# n1256: pdftotext -layout -y 75 -H 650 -W 1000 n1256.pdf n1256.in
# n1570: pdftotext -layout -y 80 -H 650 -W 1000 n1570.pdf n1570.in
# n3047: pdftotext -layout -y 75 -H 700 -W 1000 n3047.pdf n3047.in

use warnings;
use strict;

use HTML::Entities;
use Data::Dumper;

my $debug = 100;

binmode(STDOUT, ":utf8");
binmode(STDERR, ":utf8");

my $input = "@ARGV";

if (not length $input) {
    print STDERR "Usage: $0 <input file>\n";
    exit 1;
}

open FH, "<:encoding(UTF-8)", $input or die "Could not open $input: $!";
my @contents = <FH>;
close FH;

my $text = join '', @contents;
$text =~ s/\r//g;

my $section_title;
my $this_section = '';
my %sections;
my @last_section_number;
my @section_number;
my $last_section = '';
my @footnotes;
my $footnote      = 0;
my $last_footnote = 0;

gen_data();
gen_txt();
#gen_html();

sub gen_data {
    while ($text =~ m/^\f?\s{0,5}([0-9A-Z]+\.[0-9\.]*)/msg) {
        $last_section = $this_section;
        $this_section = $1;

        @last_section_number = @section_number;
        @section_number = split /\./, $this_section;

        print STDERR "----------------------------------\n" if $debug;
        print STDERR "Processing section [$this_section]\n" if $debug;

        validate_section_difference();

        my $section_text;

        if ($text =~ m/(.*?)^(?=\f?\s{0,4}[0-9A-Z]+\.)/msg) {
            $section_text = $1;
        } else {
            print STDERR "No section text, end of file marker found.\n";
            last;
        }

        if ($section_text =~ m/(.*?)$/msg) {
            if (length $1) {
                $section_title = $1;
                $section_title =~ s/^\s+//;
                $section_title =~ s/\s+$//;
                print STDERR "+++ set new section title: [$section_title]\n" if $debug;
            } else {
                print STDERR "--- no length for section title\n" if $debug;
            }
        } else {
            print STDERR "--- no new section title\n" if $debug;
        }

        $sections{$this_section}{title} = $section_title;

        ($section_text) = $section_text =~ m/\s*(.*)/msg;

        print STDERR "+++ $this_section [$section_title]\n" if $debug >= 2;
        print STDERR "+++ section text: [$section_text]\n" if $debug >= 2;

        if (not $section_text =~ m/^(?=\d+\s)/msg) {
            print STDERR "??? no paragraphs in section\n" if $debug;
            $section_text =~ s/~~//msg;
            $section_text =~ s/ZZZ//msg;
            $sections{$this_section}{text} = $section_text;
        } else {
            my $last_p = 0;
            my $p      = 0;

            print STDERR "+++ getting paragraphs for $this_section\n" if $debug;

            my $pretext;

            if ($section_text =~ m/^(?!\f?\d+\s)/) {
                ($pretext) = $section_text =~ m/^(.*?)^(?=\f?\d+\s)/ms;
                print STDERR "pretext captured: [$pretext]\n";
            }

            while ($section_text =~ m/^\f?(\d+)\s(.*?)^(?=\f?\d)/msgc or $section_text =~ m/^\f?(\d+)\s(.*)/msg) {
                $last_p = $p;
                $p      = $1;
                my $t   = $2;

                if (length $pretext) {
                    $t = "$pretext $t";
                    $pretext = '';
                }

                print STDERR "paragraph $p: [$t]\n" if $debug >= 3;

                if ($p - $last_p != 1) {
                    die "Paragraph diff invalid" unless ($input eq 'n1570.in' && $this_section =~ /^(?:K.3.9.(?:2|3))/);
                }

                # check for footnotes
                my @new_footnotes;
                while ($t =~ m/^\s*(\d+)\)\s*(.*?)$/mgc) {
                    $footnote = $1;
                    my $footnote_text = "$2\n";

                    print STDERR "processing 1st footnote $footnote [last: $last_footnote]\n" if $debug;
                    print STDERR "footnote text [$footnote_text]\n" if $debug;

                    if ($last_footnote - $footnote != -1) {
                        die "Footnote diff invalid";
                    }

                    $last_footnote = $footnote;

                    push @new_footnotes, $footnote;

                    print STDERR "footnote $footnote text: [$footnote_text]\n" if $debug >= 4;

                    while ($t =~ m/^(.*?)$/mgc) {
                        my $line = $1;
                        print STDERR "processing [$line]\n" if $debug;

                        if ($line =~ m/^\f/mg) {
                            print STDERR "end of footnote $footnote\n";
                            last;
                        }

                        if (not length $line or $line =~ m/^\s+$/) {
                            print STDERR "skipping empty line\n";
                            next;
                        }

                        if ($line =~ m/^\s*(\d+)\)\s*(.*?)$/mg) {
                            print STDERR "----------------\n" if $debug >= 1;
                            print STDERR "+++ added footnote $footnote: [$footnote_text]\n" if $debug >= 1;
                            $footnotes[$footnote] = $footnote_text;
                            print STDERR "----------------\n" if $debug >= 1;

                            $footnote       = $1;
                            $footnote_text  = "$2\n";

                            print STDERR "processing 2nd footnote $footnote [last: $last_footnote]\n" if $debug;

                            if ($last_footnote - $footnote != -1) {
                                die "Footnote diff invalid";
                            }

                            $last_footnote = $footnote;

                            push @new_footnotes, $footnote;

                            print STDERR "footnote $footnote text: [$footnote_text]\n" if $debug >= 4;
                            next;
                        }

                        if (not length $line or $line =~ m/^\s+$/) {
                            print STDERR "footnote $footnote: skipping empty line\n";
                        } else {
                            $footnote_text .= "$line\n";
                            print STDERR "footnote $footnote text: appending [$line]\n" if $debug >= 3;
                        }
                    }

                    print STDERR "----------------\n" if $debug >= 1;
                    print STDERR "+++ added footnote $footnote: [$footnote_text]\n" if $debug >= 1;
                    $footnotes[$footnote] = $footnote_text;
                    print STDERR "----------------\n" if $debug >= 1;
                }

                # strip footnotes from section text
                foreach my $fn (@new_footnotes) {
                    my $sub = quotemeta $footnotes[$fn];
                    $sub =~ s/(\\ )+/\\s*/g;
                    #print STDERR "subbing out [$footnote) $sub]\n";
                    $t =~ s/^\s*$fn\)\s*$sub//ms;
                }

                $t =~ s/\f//g;
                $t =~ s/~~//msg;
                $t =~ s/ZZZ//msg;

                $sections{$this_section . "p$p"}{text} = "$p $t";
                print STDERR "+++ added ${this_section}p$p:\n$p $t\n" if $debug;
            }
            print STDERR "+++ paragraphs done\n" if $debug;
        }
    }
}

sub bysection {
    my $inverse = 1;

    my ($a1, $p1) = split /p/, $a;
    my ($b1, $p2) = split /p/, $b;

    $p1 //= 0;
    $p2 //= 0;

    my @k1 = split /\./, $a1;
    my @k2 = split /\./, $b1;
    my @r;

    if ($#k2 > $#k1) {
        my @tk = @k1;
           @k1 = @k2;
           @k2 = @tk;
        my $tp = $p1;
           $p1 = $p2;
           $p2 = $tp;
        $inverse = -1;
    } else {
        $inverse = 1;
    }

    my $i = 0;
    for (; $i < $#k1 + 1; $i++) {
        if (not defined $k2[$i]) { $r[$i] = 1; }
        else {
            if   ($i == 0) { $r[$i] = $k1[$i] cmp $k2[$i]; }
            else           { $r[$i] = $k1[$i] <=> $k2[$i]; }
        }
    }

    $r[$i] = ($p1 <=> $p2);

    my $ret = 0;
    foreach my $rv (@r) {
        if ($rv != 0) {
            $ret = $rv;
            last;
        }
    }

    return $ret * $inverse;
}

sub gen_txt {
    my $footer = "";
    my $paren  = 0;
    my $section_head;
    my $section_title;

    foreach my $this_section (sort bysection keys %sections) {
        print STDERR "writing section $this_section\n" if $debug;
        if (not $this_section =~ m/p/) {
            print "$this_section $sections{$this_section}{title}\n";
            $section_head  = $this_section;
            $section_title = $sections{$this_section}{title};
        }

        my $section_text = $sections{$this_section}{text};

        while ($section_text =~ m/^(.*?)$/msg) {
            my $line = $1;

            print STDERR "paren reset, line [$line]\n" if $debug >= 8;
            my $number = "";
            while ($line =~ m/(.)/g) {
                my $c = $1;

                if    ($c =~ m/[0-9]/) { $number .= $c; }
                elsif ($c eq ' ')      { $number = ""; }
                elsif ($c eq '(') {
                    $paren++;
                    print STDERR "got $paren (\n" if $debug >= 8;
                } elsif ($c eq ')') {
                    $paren--;
                    print STDERR "got $paren )\n" if $debug >= 8;

                    if ($paren == -1) {
                        if (length $number and defined $footnotes[$number]) {
                            print STDERR "Got footnote $number here!\n" if $debug;
                            $footer .= "\nFootnote.$number) $footnotes[$number]\n";
                        }

                        $paren = 0;
                    }
                } else {
                    $number = "";
                }
            }
        }

        print "$section_text\n";

        if (length $footer) {
            print $footer;
            $footer = "";
        }
    }
}

sub make_link {
    my ($text) = @_;
    if (exists $sections{$text}) {
        return "<a href='#$text'>$text</a>";
    } else {
        return $text;
    }
}

sub linkify {
    my ($text) = @_;
    $text =~ s/\b((?:[A-Z]|[1-9])\.(?:\.?[0-9]+)*)\b/make_link($1)/ge;
    return $text;
}

sub gen_html {
    print "<html>\n<body>\n";

    foreach my $section (qw/ABSTRACT. CONTENTS. FOREWORD. INTRO./) {
        foreach my $paragraph (sort bysection keys %sections) {
            if ($paragraph =~ m/^$section/) {
                write_html_section($paragraph);
                delete $sections{$paragraph};
            }
        }
        delete $sections{$section};
    }

    foreach my $section (sort bysection keys %sections) {
        write_html_section($section);
    }

    print "\n</body>\n</html>\n";
}

sub write_html_section {
    my ($this_section) = @_;

    my $footer = "";
    my $paren  = 0;

    print STDERR "writing section [$this_section]\n" if $debug;

    print "<a name='", encode_entities($this_section), "'></a>\n";

    if (not $this_section =~ m/p/) {
        print "<hr>\n<h3>", encode_entities($this_section), " [", encode_entities($sections{$this_section}{title}), "]</h3>\n";
    }

    my $section_text = $sections{$this_section}{text};

    next if not length $section_text;

    $section_text = encode_entities $section_text;

    while ($section_text =~ m/^(.*?)$/msg) {
        my $line = $1;

        print STDERR "paren reset, line [$line]\n" if $debug >= 8;
        my $number = "";
        while ($line =~ m/(.)/g) {
            my $c = $1;

            if    ($c =~ m/[0-9]/) { $number .= $c; }
            elsif ($c eq ' ')      { $number = ""; }
            elsif ($c eq '(') {
                $paren++;
                print STDERR "got $paren (\n" if $debug >= 8;
            } elsif ($c eq ')') {
                $paren--;
                print STDERR "got $paren )\n" if $debug >= 8;

                if ($paren == -1) {
                    if (length $number and defined $footnotes[$number]) {
                        print STDERR "Got footnote $number here!\n" if $debug;
                        $section_text =~ s/$number\)/<a href='#FOOTNOTE.$number'><sup>[$number]<\/sup><\/a>/;
                        $footer .= "<a name='FOOTNOTE.$number'>\n<pre><i><b>Footnote $number)</b> ".encode_entities($footnotes[$number])."</i></pre>\n</a>\n";
                    }

                    $paren = 0;
                }
            } else {
                $number = "";
            }
        }
    }

    $section_text = linkify($section_text);
    $footer = linkify($footer);

    if ($this_section eq 'CONTENTS.') {
        $section_text =~ s/Annex ([A-Z])/<a href='#$1.'>Annex $1<\/a>/mg;
        $section_text =~ s/^(\d+\.)/<a href='#$1'>$1<\/a>/mg;
        $section_text =~ s/^Foreword/<a href='#FOREWORD.'>Foreword<\/a>/mg;
        $section_text =~ s/^Introduction/<a href='#INTRO.'>Introduction<\/a>/mg;
    }

    print "<pre>", $section_text, "</pre>\n";

    if (length $footer) {
        print $footer;
        $footer = '';
    }
}

# this mess of code verifies that two given section numbers are within 1 unit of distance of each other
# this ensures that no sections were skipped due to misparses
sub validate_section_difference {
    if (@last_section_number && $last_section_number[0] !~ /(?:ABSTRACT|CONTENTS|FOREWORD|INTRO)/) {
        my $fail = 0;
        my $skip = 0;

        print STDERR "comparing last section ", join('.', @last_section_number), " vs ", join('.', @section_number), "\n";

        if (@section_number > @last_section_number) {
            if (@section_number - @last_section_number != 1) {
                $fail = 1;
                print STDERR "size difference too great\n";
            }

            unless ($fail) {
                if ($section_number[0] =~ /^[A-Z]+$/) {
                    if ($last_section_number[0] =~ /^[A-Z]+$/) {
                        for (my $i = 0; $i < @last_section_number; $i++) {
                            if ($section_number[$i] ne $last_section_number[$i]) {
                                $fail = 1;
                                print STDERR "digits different\n";
                                last;
                            }
                        }
                    } else {
                        print STDERR "disregarding section namespace change from number to alphabet\n";
                        $skip = 1;
                    }
                } else {
                    for (my $i = 0; $i < @last_section_number; $i++) {
                        if ($section_number[$i] ne $last_section_number[$i]) {
                            $fail = 1;
                            print STDERR "digits different\n";
                            last;
                        }
                    }
                }
            }

            if (!$skip && ($fail || $section_number[$#section_number] != 1)) {
                print STDERR "difference too great ", join('.', @last_section_number), " vs ", join('.', @section_number), "\n";
                die;
            }
        } elsif (@last_section_number > @section_number) {
            if ($section_number[0] =~ /^[A-Z]+$/) {
                if ($last_section_number[0] =~ /^[A-Z]+$/) {
                    if ($section_number[0] ne $last_section_number[0]) {
                        if (ord($section_number[0]) - ord($last_section_number[0]) != 1) {
                            $fail = 1;
                            print STDERR "letter difference too great\n";
                        } else {
                            $skip = 1;
                            print STDERR "letter difference good\n";
                        }
                    }

                    unless ($fail) {
                        for (my $i = 1; $i < @section_number - 1; $i++) {
                            if ($section_number[$i] != $last_section_number[$i]) {
                                if ($section_number[$i] - $last_section_number[$i] != 1) {
                                    print STDERR "digit difference too great\n";
                                    $fail = 1;
                                }
                                last;
                            }
                        }
                    }
                } else {
                    print STDERR "disregarding section namespace change from number to alphabet\n";
                    $skip = 1;
                }
            } else {
                for (my $i = 0; $i < @section_number - 1; $i++) {
                    if ($section_number[$i] != $last_section_number[$i]) {
                        if ($section_number[$i] - $last_section_number[$i] != 1) {
                            print STDERR "digit difference too great\n";
                            $fail = 1;
                        }
                        last;
                    }
                }
            }

            if (!$skip && ($fail || $section_number[$#section_number] - $last_section_number[$#section_number] != 1)) {
                print STDERR "difference too great ", join('.', @last_section_number), " vs ", join('.', @section_number), "\n";
                die;
            }
        } else {
            my @rev_last = reverse @last_section_number;
            my @rev_curr = reverse @section_number;

            if ($rev_curr[$#rev_curr] =~ /^[A-Z]+$/) {
                if ($rev_last[$#rev_last] =~ /^[A-Z]+$/) {
                    if ($rev_curr[$#rev_curr] ne $rev_last[$#rev_last]) {
                        if (ord($rev_curr[$#rev_curr]) - ord($rev_last[$#rev_last]) != 1) {
                            $fail = 1;
                            print STDERR "letter difference too great\n";
                        }
                    }
                    for (my $i = 1; $i < @rev_curr; $i++) {
                        if ($rev_curr[$i] != $rev_last[$i]) {
                            if ($rev_curr[$i] - $rev_last[$i] > 1) {
                                $fail = 1;
                            }
                            last;
                        }
                    }
                } else {
                    print STDERR "disregarding section namespace change from number to alphabet\n";
                    $skip = 1;
                }
            } else {
                for (my $i = 0; $i < @rev_curr; $i++) {
                    if ($rev_curr[$i] != $rev_last[$i]) {
                        if ($rev_curr[$i] - $rev_last[$i] > 1) {
                            $fail = 1;
                        }
                        last;
                    }
                }
            }

            if (!$skip && $fail) {
                print STDERR "difference too great ", join('.', @last_section_number), " vs ", join('.', @section_number), "\n";
                die;
            }
        }
    }
}