checkcustomized.pl

#!perl
use strict;
use warnings;
use Getopt::Long;

my $code;
my $missing;
GetOptions('code|c' => \$code,
	   'missing|m' => \$missing)
  or die "usage: $0 [-code] [ base-commit [ base-path ] ]\n";

-d "Porting"
  or die "$0: this does not look like a perl tree\n";

-d ".git"
  or die "$0: this requires a git checkout\n";

BEGIN { push @INC, "Porting"; }

use Maintainers qw(%Modules);;

my $base_commit = shift;

unless ($base_commit) {
  $base_commit = `git describe --abbrev=0 HEAD`;
  chomp($base_commit);
}
my $base_path = shift || '';

my %file_map = map
  {
    $Modules{$_}{FILES} => $_
  } keys %Modules;
my %cust = map {
  my $dist = $_;
  $dist =>
    {
     map { $_ => 1 } @{$Modules{$dist}{CUSTOMIZED} || []}
    }
  } keys %Modules;

my %missing;
for my $file (sort `git diff --name-only $base_commit`) {
  chomp $file;
  $file =~ /^\Q$base_path/
    or next;

  my ($prefix, $base) = $file =~ m(^(cpan/[^/]+)/(.*))
    or next;

  my $dist = $file_map{$prefix}
    or die "Dist not found for $file\n";

  unless ($cust{$dist}{$base}) {
    print "$file missing\n" unless $code;
    push @{$missing{$dist}}, $base;
  }
}

my $indent1 = " " x 12;
my $indent2 = $indent1 . "   ";
if ($code) {
  for my $dist (sort keys %missing) {
    print <<EOS;
# $dist
        'CUSTOMIZED'   => [
EOS
    my @files = @{$missing{$dist}};
    unless ($missing) {
      @files = sort ( @files, @{$Modules{$dist}{CUSTOMIZED} || []} );
    }
    if (length("@files") < 40) {
      print "${indent1}qw( @files )\n";
    }
    else {
      print "${indent1}qw(\n";
      while (@files) {
	my @row = shift @files;
	while (@files && length("@row") + 1 + length($files[0]) < 50) {
	  push @row, shift @files;
	}
	print "$indent2@row\n";
      }
      print "${indent1})\n";
    }
    print "        ],\n";
  }
}