#!/usr/bin/env perl
use strict;
$^W=1;

my $file_in = 'hyperref.dtx';

my $line = 0;
my $cline = 0;

my $ok = 1;

open(IN, '<', $file_in) or die "!!! Error: Cannot open `$file_in'!\n";
while (<IN>) {
    $line++;
    chomp;
    
    next if /^\s*\\(fontencoding|DeclareFont(Family|Shape|Substitution|Encoding)){PU}/;
    
    if (/^\\DeclareTextCommand{\\[A-Za-z]+}{PU}{\\(8[0-7]|9[0-3][0-7]{2})\\([0-3][0-7]{2})}%\*? U\+([0-9A-F]{4})$/) {
        $cline++;
        my $octA = $1;
        my $octB = $2;
        my $hex = $3;
        my $num_oct = oct(substr $octA, 1) * 256 + oct($octB);
        my $num_hex = oct("0x$hex");
        if ($num_oct != $num_hex) {
            print "!!! Error (line $line): Mismatch \\$octA\\$octB <> U+$hex!\n";
            $ok = 0;
        }
        next;
    }
    if (/^\\DeclareTextCommand{\\[A-Za-z]+}{PU}{\\(8[0-7]|9[0-3][0-7]{2})\\([0-3][0-7]{2})\\(8[0-7]|9[0-3][0-7]{2})\\([0-3][0-7]{2})}%\*? U\+([0-9A-F]{4}) U\+([0-9A-F]{4})$/) {
        $cline++;
        my $octA = $1;
        my $octB = $2;
        my $octC = $3;
        my $octD = $4;
        my $hexA = $5;
        my $hexB = $6;
        my $num_octA = oct(substr $octA, 1) * 256 + oct($octB);
        my $num_octB = oct(substr $octC, 1) * 256 + oct($octD);
        my $num_hexA = oct("0x$hexA");
        my $num_hexB = oct("0x$hexB");
        if ($num_octA != $num_hexA) {
            print "!!! Error (line $line): Mismatch \\$octA\\$octB <> U+$hexA!\n";
            $ok = 0;
        }
        if ($num_octB != $num_hexB) {
            print "!!! Error (line $line): Mismatch \\$octC\\$octD <> U+$hexB!\n";
            $ok = 0;
        }
        next;
    }
    if (/^\\DeclareTextCommand{\\[A-Za-z]+}{PU}{\\(9[0-3][0-7]{2})\\([0-3][0-7]{2})\\(9[0-3][0-7]{2})\\([0-3][0-7]{2})}%\*? U\+([0-9A-F]{5})$/) {
        $cline++;
        my $octA = $1;
        my $octB = $2;
        my $octC = $3;
        my $octD = $4;
        my $hex = $5;
        my $num_octA = oct(substr $octA, 1) * 256 + oct($octB);
        my $num_octB = oct(substr $octC, 1) * 256 + oct($octD);
        my $num_oct = ($num_octA - oct("0xD800")) * 1024 + $num_octB - oct("0xDC00") + 65536;
        my $num_hex = oct("0x$hex");
        if ($num_oct != $num_hex) {
            print "!!! Error (line $line): Mismatch \\$octA\\$octB\\$octC\\$octD <> U+$hex!\n";
            $ok = 0;
        }
        next;
    }
    if (/^\\DeclareTextCommand{\\[A-Za-z]+}{PU}{\\(9[0-3][0-7]{2})\\([0-3][0-7]{2})\\(9[0-3][0-7]{2})\\([0-3][0-7]{2})\\(8[0-7]|9[0-3][0-7]{2})\\([0-3][0-7]{2})}%\*? U\+([0-9A-F]{5}) U\+([0-9A-F]{4})$/) {
        $cline++;
        my $octA = $1;
        my $octB = $2;
        my $octC = $3;
        my $octD = $4;
        my $octE = $5;
        my $octF = $6;
        my $hexA = $7;
        my $hexB = $8;
        my $num_octA = oct(substr $octA, 1) * 256 + oct($octB);
        my $num_octB = oct(substr $octC, 1) * 256 + oct($octD);
        my $num_octAA = ($num_octA - oct("0xD800")) * 1024 + $num_octB - oct("0xDC00") + 65536;
        my $num_octBB = oct(substr $octE, 1) * 256 + oct($octF);
        my $num_hexA = oct("0x$hexA");
        my $num_hexB = oct("0x$hexB");
        if ($num_octAA != $num_hexA) {
            print "!!! Error (line $line): Mismatch \\$octA\\$octB\\$octC\\$octD <> U+$hexA!\n";
            $ok = 0;
        }
        if ($num_octBB != $num_hexB) {
            print "!!! Error (line $line): Mismatch \\$octE\\$octF <> U+$hexB!\n";
            $ok = 0;
        }
        next;
    }
    if (/^\\DeclareTextCommand{\\([A-Za-z]+|[^}])}{PU}\[1\]{#1\\(8[0-7]|9[0-3][0-7]{2})\\([0-3][0-7]{2})}% U\+([0-9A-F]{4})$/) {
        $cline++;
        my $octA = $2;
        my $octB = $3;
        my $hex = $4;
        my $num_oct = oct(substr $octA, 1) * 256 + oct($octB);
        my $num_hex = oct("0x$hex");
        if ($num_oct != $num_hex) {
            print "!!! Error (line $line): Mismatch #1\\$octA\\$octB <> U+$hex!\n";
            $ok = 0;
        }
        next;
    }    
    if (/^\\DeclareTextCompositeCommand{\\([A-Za-z]+|[^}])}{PU}{(\\ |\\\@empty|[A-Za-z]|\\[A-Za-z]+|[0-9]{1,2})}{\\(8[0-7]|9[0-3][0-7]{2})\\([0-3][0-7]{2})}%\*? U\+([0-9A-F]{4})$/) {
        $cline++;    
        my $octA = $3;
        my $octB = $4;
        my $hex = $5;
        my $num_oct = oct(substr $octA, 1) * 256 + oct($octB);
        my $num_hex = oct("0x$hex");
        if ($num_oct != $num_hex) {
            print "!!! Error (line $line): Mismatch \\$octA\\$octB <> U+$hex!\n";
            $ok = 0;
        }
        next;
    }
    if (/^\\DeclareTextCommand{\\[A-Za-z]+}{PU}{ \\(83)\\([0-3][0-7]{2})}%\*? U\+([0-9A-F]{4})$/) {
        $cline++;
        my $octA = $1;
        my $octB = $2;
        my $hex = $3;
        my $num_oct = oct(substr $octA, 1) * 256 + oct($octB);
        my $num_hex = oct("0x$hex");
        if ($num_oct != $num_hex) {
            print "!!! Error (line $line): Mismatch \\$octA\\$octB <> U+$hex!\n";
            $ok = 0;
        }
        if ($num_oct < oct("0x0300") or $num_oct > oct("0x036F")) {
            print "!!! Error (line $line): Out of range (0x0300..0x036F): $num_oct!\n";
            $ok = 0;
        }
        next;
    }
    if (/^\\DeclareTextCommand{\\[A-Za-z]+}{PU}{(\\[A-Za-z]+|[|<>"]|SS)}%/) {
        $cline++;
        next;
    }
    if (/^\\DeclareTextCompositeCommand{\\\.}{PU}{(\\[A-Za-z]+|[A-Za-z])}{[A-Za-z]}%/) {
        $cline++;
        next;
    }
    if ($_ eq '\DeclareTextCommand{\textccnd}{PU}{=\9040\335}%* U+003D U+20DD') {
        $cline++;
        next;
    }
    if (/^\\DeclareTextCompositeCommand{\\([A-Za-z]+|[^}])}{PU}{\\(\@empty| )}{\\[A-Za-z]+}/) {
        $cline++;
        next;
    }
    if (/^\\DeclareTextCommand{\\[A-Za-z]+}{PU}\[1\]{#1\\(8[0-7]|9[0-3][0-7]{2})\\([0-3][0-7]{2})\\(8[0-7]|9[0-3][0-7]{2})\\([0-3][0-7]{2})}% U\+([0-9A-F]{4}) U\+([0-9A-F]{4})$/) {
        $cline++;
        my $octA = $1;
        my $octB = $2;
        my $octC = $3;
        my $octD = $4;
        my $hexA = $5;
        my $hexB = $6;
        my $num_octA = oct(substr $octA, 1) * 256 + oct($octB);
        my $num_octB = oct(substr $octC, 1) * 256 + oct($octD);
        my $num_hexA = oct("0x$hexA");
        my $num_hexB = oct("0x$hexB");
        if ($num_octA != $num_hexA) {
            print "!!! Error (line $line): Mismatch \\$octA\\$octB <> U+$hexA!\n";
            $ok = 0;
        }
        if ($num_octB != $num_hexB) {
            print "!!! Error (line $line): Mismatch \\$octC\\$octD <> U+$hexB!\n";
            $ok = 0;
        }
        next;
    }
    if (/^\\DeclareTextCommand{\\[A-Za-z]+}{PU}\[1\]{\\([A-Za-z]+|[^{}]){#1}}%/) {
        $cline++;
        next;
    }
    if (/^\\DeclareTextCompositeCommand{\\[A-Za-z]+}{PU}{\\(\@empty| )}{{ \\(8[0-7]|9[0-3][0-7]{2})\\([0-3][0-7]{2})}}% U\+([0-9A-F]{4})$/) {
        $cline++;
        my $octA = $2;
        my $octB = $3;
        my $hex = $4;
        my $num_oct = oct(substr $octA, 1) * 256 + oct($octB);
        my $num_hex = oct("0x$hex");
        if ($num_oct != $num_hex) {
            print "!!! Error (line $line): Mismatch \\$octA\\$octB <> U+$hex!\n";
            $ok = 0;
        }
        next;
    }
    
    if (/^\\DeclareTextCompositeCommand{\\[A-Za-z]+}{PU}{\\(\@empty| )}{{ \\(8[0-7]|9[0-3][0-7]{2})\\([0-3][0-7]{2})\\(8[0-7]|9[0-3][0-7]{2})\\([0-3][0-7]{2})}}% U\+([0-9A-F]{4}) U\+([0-9A-F]{4})$/) {
        $cline++;
        my $octA = $2;
        my $octB = $3;
        my $octC = $4;
        my $octD = $5;
        my $hexA = $6;
        my $hexB = $7;
        my $num_octA = oct(substr $octA, 1) * 256 + oct($octB);
        my $num_octB = oct(substr $octC, 1) * 256 + oct($octD);
        my $num_hexA = oct("0x$hexA");
        my $num_hexB = oct("0x$hexB");
        if ($num_octA != $num_hexA) {
            print "!!! Error (line $line): Mismatch \\$octA\\$octB <> U+$hexA!\n";
            $ok = 0;
        }
        if ($num_octB != $num_hexB) {
            print "!!! Error (line $line): Mismatch \\$octC\\$octD <> U+$hexB!\n";
            $ok = 0;
        }
        next;
    }
    
    if (/{PU}/) {
        print "!!! Error: Unmatched line: [$_]\n";
        $ok = 0;
        next;
    }
}
    
close(IN);

print "--> $cline lines.\n";

print "==> Errors!\n" unless $ok;

exit(1) unless $ok;
__END__
