canon: ad-hoc textual format

diff --git a/yarrg/canon b/yarrg/canon
index 78c5849f9a9b0be7c69ce3c8b005bb1931b6a669..529a314edfa2d5851fb750ae3caf67088e6b0ea1 100755 (executable)
--- a/yarrg/canon
+++ b/yarrg/canon
@@ -17,22 +17,58 @@ foreach my $ab (qw(0 1)) {
     }
     close F or die $!;
 }
-print "total rows: ", (scalar keys %s), "\n";
-my $lastk0='';
-my $changek0=0;
+
+my $nextcommod=0;
+my %commodmap;
+
+sub findcommod ($) {
+    my ($cname) = @_;
+    my $me= $commodmap{$cname};  return $me if defined $me;
+    my $val= $nextcommod++;
+    my $res= '';
+    while ($val || !length($res)) {
+        my $dig= $val % 62;
+        $val= ($val-$dig) / 62;
+        $res .= chr($dig + ($dig<10 ? 48 :
+                            $dig<36 ? 97-10 :
+                            $dig<62 ? 65-36 : die $dig));
+    }
+    $commodmap{$cname}= $res;
+#    printf "%s:%s\n", $res,$cname;
+    return $res;
+}
+
+my $laststall='';
+
 foreach my $k (sort keys %s) {
     my @r= @{ $s{$k} };
-    my $whynot=
-        !defined($r[0]) ? 'ADD' :
-        !defined($r[2]) ? 'DEL' :
-        $r[0] != $r[2] ? 'pri' :
-        $r[1] != $r[3] ? (sprintf "qt %4d",($r[3]-$r[1])) :
-        undef;
-    next unless $whynot;
     $k =~ m/\t/;
-    if ($` ne $lastk0) { $lastk0=$`; $changek0++; }
-    print $whynot,"\t",$k;
-    print "\t", defined($_) ? $_ : "-" foreach @r;
-    print "\n";
+    my ($stall,$commod) = ($`,$');
+
+    my $eol= '';
+    my $prep= sub {
+        return if $eol;
+        $eol="\n";
+        if ($stall ne $laststall) {
+            printf "\"%s\n", $stall;
+            $laststall= $stall;
+        }
+        print findcommod($commod);
+    };
+
+    if (!defined($r[2])) {
+        $prep->();
+        printf "-\n";
+        next;
+    }
+    my $qtydiff= $r[2] - ($r[0] || 0);
+    if (!defined($r[0]) || $r[0] != $r[2]) {
+        $prep->();
+        printf "\@%d",$r[2];
+    }
+    if ($qtydiff) {
+        $prep->();
+        printf "%+d",$qtydiff;
+    }
+    print $eol;
 }
-print "changes of k0: $changek0\n";