compare-cooking.perl

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