compare-cooking.perl

   1 #!/usr/bin/perl -w
   2
   3 my ($old, $new);
   4
   5 if (@ARGV == 7) {
   6         # called as GIT_EXTERNAL_DIFF script
   7         $old = parse_cooking($ARGV[1]);
   8         $new = parse_cooking($ARGV[4]);
   9 } else {
  10         # called with old and new
  11         $old = parse_cooking($ARGV[0]);
  12         $new = parse_cooking($ARGV[1]);
  13 }
  14 compare_cooking($old, $new);
  15
  16 ################################################################
  17
  18 use File::Temp qw(tempfile);
  19
  20 sub compare_them {
  21         local($_);
  22         my ($a, $b, $force, $soft) = @_;
  23
  24         if ($soft) {
  25                 $plus = $minus = ' ';
  26         } else {
  27                 $plus = '+';
  28                 $minus = '-';
  29         }
  30
  31         if (!defined $a->[0]) {
  32                 return map { "$plus$_\n" } map { split(/\n/) } @{$b};
  33         } elsif (!defined $b->[0]) {
  34                 return map { "$minus$_\n" } map { split(/\n/) } @{$a};
  35         } elsif (join('', @$a) eq join('', @$b)) {
  36                 if ($force) {
  37                         return map { " $_\n" } map { split(/\n/) } @{$a};
  38                 } else {
  39                         return ();
  40                 }
  41         }
  42         my ($ah, $aname) = tempfile();
  43         my ($bh, $bname) = tempfile();
  44         my $cnt = 0;
  45         my @result = ();
  46         for (@$a) {
  47                 print $ah $_;
  48                 $cnt += tr/\n/\n/;
  49         }
  50         for (@$b) {
  51                 print $bh $_;
  52                 $cnt += tr/\n/\n/;
  53         }
  54         close $ah;
  55         close $bh;
  56         open(my $fh, "-|", 'diff', "-U$cnt", $aname, $bname);
  57         $cnt = 0;
  58         while (<$fh>) {
  59                 next if ($cnt++ < 3);
  60                 push @result, $_;
  61         }
  62         close $fh;
  63         unlink ($aname, $bname);
  64         return @result;
  65 }
  66
  67 sub flush_topic {
  68         my ($cooking, $name, $desc) = @_;
  69         my $section = $cooking->{SECTIONS}[-1];
  70
  71         return if (!defined $name);
  72
  73         $desc =~ s/\s+\Z/\n/s;
  74         $desc =~ s/\A\s+//s;
  75         my $topic = +{
  76                 IN_SECTION => $section,
  77                 NAME => $name,
  78                 DESC => $desc,
  79         };
  80         $cooking->{TOPICS}{$name} = $topic;
  81         push @{$cooking->{TOPIC_ORDER}}, $name;
  82 }
  83
  84 sub parse_section {
  85         my ($cooking, @line) = @_;
  86
  87         while (@line && $line[-1] =~ /^\s*$/) {
  88                 pop @line;
  89         }
  90         return if (!@line);
  91
  92         if (!exists $cooking->{SECTIONS}) {
  93                 $cooking->{SECTIONS} = [];
  94                 $cooking->{TOPICS} = {};
  95                 $cooking->{TOPIC_ORDER} = [];
  96         }
  97         if (!exists $cooking->{HEADER}) {
  98                 my $line = join('', @line);
  99                 $line =~ s/\A.*?\n\n//s;
 100                 $cooking->{HEADER} = $line;
 101                 return;
 102         }
 103         if (!exists $cooking->{GREETING}) {
 104                 $cooking->{GREETING} = join('', @line);
 105                 return;
 106         }
 107
 108         my ($section_name, $topic_name, $topic_desc);
 109         for (@line) {
 110                 if (!defined $section_name && /^\[(.*)\]$/) {
 111                         $section_name = $1;
 112                         push @{$cooking->{SECTIONS}}, $section_name;
 113                         next;
 114                 }
 115                 if (/^\* (\S+) /) {
 116                         my $next_name = $1;
 117                         flush_topic($cooking, $topic_name, $topic_desc);
 118                         $topic_name = $next_name;
 119                         $topic_desc = '';
 120                 }
 121                 $topic_desc .= $_;
 122         }
 123         flush_topic($cooking, $topic_name, $topic_desc);
 124 }
 125
 126 sub dump_cooking {
 127         my ($cooking) = @_;
 128         print $cooking->{HEADER};
 129         print "-" x 50, "\n";
 130         print $cooking->{GREETING};
 131         for my $section_name (@{$cooking->{SECTIONS}}) {
 132                 print "\n", "-" x 50, "\n";
 133                 print "[$section_name]\n";
 134                 for my $topic_name (@{$cooking->{TOPIC_ORDER}}) {
 135                         $topic = $cooking->{TOPICS}{$topic_name};
 136                         next if ($topic->{IN_SECTION} ne $section_name);
 137                         print "\n", $topic->{DESC};
 138                 }
 139         }
 140 }
 141
 142 sub parse_cooking {
 143         my ($filename) = @_;
 144         my (%cooking, @current, $fh);
 145         open $fh, "<", $filename
 146             or die "cannot open $filename: $!";
 147         while (<$fh>) {
 148                 if (/^-{30,}$/) {
 149                         parse_section(\%cooking, @current);
 150                         @current = ();
 151                         next;
 152                 }
 153                 push @current, $_;
 154         }
 155         close $fh;
 156         parse_section(\%cooking, @current);
 157
 158         return \%cooking;
 159 }
 160
 161 sub compare_topics {
 162         my ($a, $b) = @_;
 163         if (!@$a || !@$b) {
 164                 print compare_them($a, $b, 1, 1);
 165                 return;
 166         }
 167
 168         # otherwise they both have title.
 169         $a = [map { "$_\n" } split(/\n/, join('', @$a))];
 170         $b = [map { "$_\n" } split(/\n/, join('', @$b))];
 171         my $atitle = shift @$a;
 172         my $btitle = shift @$b;
 173         print compare_them([$atitle], [$btitle], 1);
 174
 175         my (@atail, @btail);
 176         while (@$a && $a->[-1] !~ /^\s/) {
 177                 unshift @atail, pop @$a;
 178         }
 179         while (@$b && $b->[-1] !~ /^\s/) {
 180                 unshift @btail, pop @$b;
 181         }
 182         print compare_them($a, $b);
 183         print compare_them(\@atail, \@btail);
 184 }
 185
 186 sub compare_class {
 187         my ($fromto, $names, $topics) = @_;
 188
 189         my (@where, %where);
 190         for my $name (@$names) {
 191                 my $t = $topics->{$name};
 192                 my ($a, $b, $in, $force);
 193                 if ($t->{OLD} && $t->{NEW}) {
 194                         $a = [$t->{OLD}{DESC}];
 195                         $b = [$t->{NEW}{DESC}];
 196                         if ($t->{OLD}{IN_SECTION} ne $t->{NEW}{IN_SECTION}) {
 197                                 $force = 1;
 198                                 $in = '';
 199                         } else {
 200                                 $in = "[$t->{NEW}{IN_SECTION}]";
 201                         }
 202                 } elsif ($t->{OLD}) {
 203                         $a = [$t->{OLD}{DESC}];
 204                         $b = [];
 205                         $in = "Was in [$t->{OLD}{IN_SECTION}]";
 206                 } else {
 207                         $a = [];
 208                         $b = [$t->{NEW}{DESC}];
 209                         $in = "[$t->{NEW}{IN_SECTION}]";
 210                 }
 211                 next if (defined $a->[0] &&
 212                          defined $b->[0] &&
 213                          $a->[0] eq $b->[0] && !$force);
 214
 215                 if (!exists $where{$in}) {
 216                         push @where, $in;
 217                         $where{$in} = [];
 218                 }
 219                 push @{$where{$in}}, [$a, $b];
 220         }
 221
 222         return if (!@where);
 223         for my $in (@where) {
 224                 my @bag = @{$where{$in}};
 225                 if (defined $fromto && $fromto ne '') {
 226                         print "\n", '-' x 50, "\n$fromto\n";
 227                         $fromto = undef;
 228                 }
 229                 print "\n$in\n" if ($in ne '');
 230                 for (@bag) {
 231                         my ($a, $b) = @{$_};
 232                         print "\n";
 233                         compare_topics($a, $b);
 234                 }
 235         }
 236 }
 237
 238 sub compare_cooking {
 239         my ($old, $new) = @_;
 240
 241         print compare_them([$old->{HEADER}], [$new->{HEADER}]);
 242         print compare_them([$old->{GREETING}], [$new->{GREETING}]);
 243
 244         my (@sections, %sections, @topics, %topics, @fromto, %fromto);
 245
 246         for my $section_name (@{$old->{SECTIONS}}, @{$new->{SECTIONS}}) {
 247                 next if (exists $sections{$section_name});
 248                 $sections{$section_name} = scalar @sections;
 249                 push @sections, $section_name;
 250         }
 251
 252         my $gone_class = "Gone topics";
 253         my $born_class = "Born topics";
 254         my $stay_class = "Other topics";
 255
 256         push @fromto, $born_class;
 257         for my $topic_name (@{$old->{TOPIC_ORDER}}, @{$new->{TOPIC_ORDER}}) {
 258                 next if (exists $topics{$topic_name});
 259                 push @topics, $topic_name;
 260
 261                 my $oldtopic = $old->{TOPICS}{$topic_name};
 262                 my $newtopic = $new->{TOPICS}{$topic_name};
 263                 $topics{$topic_name} = +{
 264                         OLD => $oldtopic,
 265                         NEW => $newtopic,
 266                 };
 267                 my $oldsec = $oldtopic->{IN_SECTION};
 268                 my $newsec = $newtopic->{IN_SECTION};
 269                 if (defined $oldsec && defined $newsec) {
 270                         if ($oldsec ne $newsec) {
 271                                 my $fromto =
 272                                     "Moved from [$oldsec] to [$newsec]";
 273                                 if (!exists $fromto{$fromto}) {
 274                                         $fromto{$fromto} = [];
 275                                         push @fromto, $fromto;
 276                                 }
 277                                 push @{$fromto{$fromto}}, $topic_name;
 278                         } else {
 279                                 push @{$fromto{$stay_class}}, $topic_name;
 280                         }
 281                 } elsif (defined $oldsec) {
 282                         push @{$fromto{$gone_class}}, $topic_name;
 283                 } else {
 284                         push @{$fromto{$born_class}}, $topic_name;
 285                 }
 286         }
 287         push @fromto, $stay_class;
 288         push @fromto, $gone_class;
 289
 290         for my $fromto (@fromto) {
 291                 compare_class($fromto, $fromto{$fromto}, \%topics);
 292         }
 293 }