util/addauthors.pl

   1 #!/usr/bin/perl
   2 use warnings;
   3 use strict;
   4 use IO::File;
   5 use Data::Dumper;
   6 $|++;
   7
   8 my %comitters;
   9
  10 while (<>) {
  11   next unless /^r(\d+) /;
  12   my ($r, $comitter, $date) = split /[|:]/, $_;
  13   $comitter=trim($comitter);
  14   $comitters{$comitter}++;
  15 }
  16
  17 #foreach (sort {$comitters{$a} <=> $comitters{$b}} keys %comitters) {
  18 #  print "$_: $comitters{$_}\n";
  19 #}
  20
  21 my $authors = readauthors();
  22 #print Dumper $authors;
  23
  24 foreach my $c (sort {$comitters{$b} <=> $comitters{$a}} keys %comitters) {
  25   print "$c: $comitters{$c}\n";
  26   my $author;
  27   my $re = qr/$c/i;
  28   foreach my $a (@$authors) {
  29     if ($a->{wholeline} =~ $re) {
  30       $author = $a;
  31       last;
  32     }
  33   }
  34   if (!$author) {
  35     # Time for some hurestics: Try matching _ as space -- Darren_Duncan for example.
  36     my $re = $c;
  37     $re =~ s/_/ /;
  38     $re = qr/$re/i;
  39     foreach my $a (@$authors) {
  40       if ($a->{wholeline} =~ $re) {
  41         $author = $a;
  42         last;
  43       }
  44     }
  45   }
  46   if (!$author) {
  47     # Guess first initial, last name.
  48     my ($initial, $last) = $c =~ m/^(.)(.*)/;
  49     $re = qr/^$initial.*$last/i;
  50     foreach my $a (@$authors) {
  51       if ($a->{wholeline} =~ $re) {
  52         $author = $a;
  53         last;
  54       }
  55     }
  56   }
  57
  58   if (!$author) {
  59     warn "$c missing from AUTHORS file\n";
  60   }
  61
  62   $author->{commitid}=$c;
  63   $author->{commitcount}=$comitters{$c};
  64   print Dumper $author;
  65 }
  66
  67
  68 sub trim {
  69   local $_=shift;
  70   s/^\s+//;
  71   s/\s+$//;
  72   return $_;
  73 }
  74
  75 sub readauthors {
  76   my $fh = IO::File->new("AUTHORS", "<:utf8");
  77   my @authors;
  78   my (%bycpan, %bynick);
  79
  80   while (<$fh>) {
  81     last if /^$/;
  82   }
  83   while (<$fh>) {
  84     chomp;
  85     my ($cpanid) = m/\(([A-Z]+)\)/;
  86     my ($nick)   = m/"([^"]+)"/;
  87     my $author   = {cpanid => $cpanid, nick => $nick, wholeline => $_};
  88     push @authors, $author;
  89   }
  90   return \@authors;
  91 }