From fde88b1df4ca928c8c1d48045f9a2f6360633de7 Mon Sep 17 00:00:00 2001
From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Sun, 30 Sep 2018 13:40:50 +0100
Subject: [PATCH] auditor wip perlop

---
 i18n-diff-auditor | 91 ++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 90 insertions(+), 1 deletion(-)

diff --git a/i18n-diff-auditor b/i18n-diff-auditor
index 420e25d..d947a01 100755
--- a/i18n-diff-auditor
+++ b/i18n-diff-auditor
@@ -30,10 +30,98 @@ sub l ($) {
     confess $i unless l_ok $i;
 };
 
+our $perlop_text = <<'END'; # c&p from man perlop
+           left        terms and list operators (leftward)
+           left        ->
+           nonassoc    ++ --
+           right       **
+           right       ! ~ \ and unary + and -
+           left        =~ !~
+           left        * / % x
+           left        + - .
+           left        << >>
+           nonassoc    named unary operators
+           nonassoc    < > <= >= lt gt le ge
+           nonassoc    == != <=> eq ne cmp ~~
+           left        &
+           left        | ^
+           left        &&
+           left        || //
+           nonassoc    ..  ...
+           right       ?:
+           right       = += -= *= etc. goto last next redo dump
+           left        , =>
+           nonassoc    list operators (rightward)
+           right       not
+           left        and
+           left        or xor
+
+           **=    +=    *=    &=    &.=    <<=    &&=
+                  -=    /=    |=    |.=    >>=    ||=
+                  .=    %=    ^=    ^.=           //=
+                        x=
+END
+
+our $perlop_re;
+
+sub prep_perlop () {
+    my @ops;
+    foreach (split /\n/, $perlop_text) {
+	next unless m{\S};
+	s{\s+$}{};
+	s{^\s+}{};
+	s{^(?: left | right | nonassoc ) \s+}{}x;
+	next if m{^terms and list operators};
+	next if m{^named unary};
+	next if m{^list operators};
+	s{ and unary.*}{};
+	s{ etc\. }{ };
+	foreach my $op (split /\s+/) {
+	    next unless length $op;
+	    next if $op =~ m{^\w+$};
+	    $op =~ s/\W/\\$&/g;
+	    push @ops, $op;
+	}
+    }
+    $perlop_re = '(?: '.(join ' | ', @ops).' )';
+    $perlop_re = qr{$perlop_re}x;
+    #print STDERR "$perlop_re\n";
+}
+
+prep_perlop();
+
 our ($ifilehead, $ihunkhead, $ichunkstart, $ichunkend);
 our ($before, $after);
 
+sub semiparse ($) {
+    ($_) = @_;
+    my @o;
+    for (;;) {
+	s{^\s+}{};
+	if (s{^[\$\@\%][_0-9a-zA-Z]+}{}) {
+	    push @o, { T => 'ident', V => $& };
+	} elsif (s{^\<\<('?)([A-Z_]+)\1}{}) {
+	    my ($q,$d) = ($1,$2);
+	    push @o, { T => 'heredoc', Q => $q, Delim => $d };
+	    s{^
+                (             .* \n    )
+                ( (?: (?! $d) .* \n )* )
+              }{ $1 } or die "missing end of here doc $d\n";
+	    $o[$#o]{V} = $2;
+	} elsif (s{^ (["'])( (?:  [^\\] | \\ \1  )* )}{}x) {
+	    my ($q,$v) = ($1,$2);
+	    push @o, { T => 'string', Q => $q, V => $v };
+	} else {
+	    die;
+	}
+    }
+}	    
+
 sub analyse_chunk () {
+    die "plain deletion\n" unless defined $after;
+    die "plain insertion\n" unless defined $before;
+    my @before = semiparse $before;
+    my @after = semiparse $after;
     print Dumper($ichunkstart, $ichunkend, $before, $after);
     flush STDOUT;
 }
@@ -49,7 +137,8 @@ for ($ifilehead = 0; l_ok $ifilehead; $ifilehead++) {
 	    if (!l_ok $i or m{^ } or m{^\@\@}) {
 		if (defined $ichunkstart) {
 		    $ichunkend = $i;
-		    analyse_chunk();
+		    eval { analyse_chunk(); 1; };
+		    # do something with $@
 		    $ichunkstart = $ichunkend = $before = $after = undef;
 		}
 		l_ok $i or last;
-- 
2.30.2