diff options
author | David Golden <dagolden@cpan.org> | 2010-07-30 21:57:20 +0000 |
---|---|---|
committer | David Golden <dagolden@cpan.org> | 2010-07-30 21:57:20 +0000 |
commit | 946fbe37199465bc5fb82c83bf3092ea555cb9f9 (patch) | |
tree | cb1e5e30c8779e5d294540236e8f57c45a6257cf /Porting/checkAUTHORS.pl | |
parent | 64265e98113da97bc965500d3a41fdb38648814e (diff) | |
download | perl-946fbe37199465bc5fb82c83bf3092ea555cb9f9.tar.gz |
Improve Porting/checkAUTHORS.pl
Rationalized options and usage message. The new "--who" option
now gives full names as provided in the AUTHORS file.
Updated t/porting/authors.t for the new option syntax.
Diffstat (limited to 'Porting/checkAUTHORS.pl')
-rw-r--r-- | Porting/checkAUTHORS.pl | 96 |
1 files changed, 57 insertions, 39 deletions
diff --git a/Porting/checkAUTHORS.pl b/Porting/checkAUTHORS.pl index 4db9a81164..5c457d070b 100644 --- a/Porting/checkAUTHORS.pl +++ b/Porting/checkAUTHORS.pl @@ -5,25 +5,35 @@ use Getopt::Long; use Text::Wrap; $Text::Wrap::columns = 80; -my ($rank, $percentage, $cumulative, $reverse, $ta, @authors, %authors, - %untraced, %patchers, %committers, %real_names, $as_test_output, $who); -my $result = GetOptions ("rank" => \$rank, # rank authors - "thanks-applied" => \$ta, # ranks committers - "acknowledged=s" => \@authors , # authors files +my ($rank, $ta, $ack, $who, $tap) = (0) x 5; +my ($author_file, $percentage, $cumulative, $reverse); +my (%authors, %untraced, %patchers, %committers, %real_names); + +my $result = GetOptions ( + # modes + "who" => \$who, + "rank" => \$rank, + "thanks-applied" => \$ta, + "missing" => \$ack , + "tap" => \$tap, + # modifiers + "authors" => \$author_file, "percentage" => \$percentage, # show as %age "cumulative" => \$cumulative, "reverse" => \$reverse, - "tap" => \$as_test_output, - "who" => \$who, ); -if (!$result or (($rank||0) + ($ta||0) + ($who||0) + (@authors ? 1 : 0) != 1) or !@ARGV) { +if (!$result or ( $rank + $ta + $who + $ack + $tap != 1 ) or !@ARGV) { usage(); } +$author_file ||= './AUTHORS'; +die "Can't locate '$author_file'. Specify it with '--author <path>'." + unless -f $author_file; + my $map = generate_known_author_map(); -read_authors_files(@authors); +read_authors_files($author_file); parse_commits_from_stdin(); @@ -31,12 +41,12 @@ if ($rank) { display_ordered(\%patchers); } elsif ($ta) { display_ordered(\%committers); -} elsif ($as_test_output) { +} elsif ($tap) { display_test_output(\%patchers, \%authors, \%real_names); -} elsif (%authors) { +} elsif ($ack) { display_missing_authors(\%patchers, \%authors, \%real_names); } elsif ($who) { - list_authors(\%patchers, \%real_names); + list_authors(\%patchers, \%authors); } exit(0); @@ -44,26 +54,33 @@ exit(0); sub usage { die <<"EOS"; -Usage: $0 [options] <git-log-output-file> -$0 --rank changes # rank authors by patches -$0 --acknowledged <authors file> changes # Display unacknowledged authors -$0 --thanks-applied changes # ranks committers of others' patches -$0 --percentage ... # show rankings as percentages -$0 --cumulative ... # show rankings cumulatively -$0 --reverse ... # show rankings in reverse -$0 --who ... # show list of unique authors -Specify stdin as - if needs be. Remember that option names can be abbreviated. -Generate changes with git log --pretty=fuller rev1..rev2 -For example: +Usage: $0 [modes] [modifiers] <git-log-output-file> + +Modes (use only one): + --who # show list of unique authors by full name + --rank # rank authors by patches + --thanks-applied # ranks committers of others' patches + --missing # display authors not in AUTHORS + --tap # show authors present/missing as TAP + +Modifiers: + --authors <authors-file> # path to authors file (default: ./AUTHORS) + --percentage # show rankings as percentages + --cumulative # show rankings cumulatively + --reverse # show rankings in reverse + +Generate git-log-output-file with git log --pretty=fuller rev1..rev2 +(or pipe by specifing '-' for stdin). For example: \$ git log --pretty=fuller v5.12.0..v5.12.1 > gitlog - \$ perl Porting/checkAUTHORS.pl --who gitlog + \$ perl Porting/checkAUTHORS.pl --rank --percentage gitlog EOS } sub list_authors { - my ($patchers, $real_names) = @_; - print "$_\n" for sort { lc $a cmp lc $b } - map { $real_names->{$_} } + my ($patchers, $authors) = @_; + binmode(STDOUT, ":utf8"); + print "$_\n" for sort { lc $a cmp lc $b } + map { $authors->{$_} } keys %$patchers; } @@ -177,16 +194,18 @@ sub generate_known_author_map { sub read_authors_files { my @authors = (@_); return unless (@authors); - my %raw; + my (%count, %raw); foreach my $filename (@authors) { open FH, "<$filename" or die "Can't open $filename: $!"; while (<FH>) { next if /^\#/; next if /^-- /; - if (/<([^>]+)>/) { - + if (/^([^<]+)<([^>]+)>/) { # Easy line. - $raw{$1}++; + my ($name, $email) = ($1, $2); + $name =~ s/\s*\z//; + $raw{$email} = $name; + $count{$email}++; } elsif (/^([-A-Za-z0-9 .\'À-ÖØöø-ÿ]+)[\t\n]/) { # Name only @@ -200,12 +219,11 @@ sub read_authors_files { } } foreach ( keys %raw ) { - print "E-mail $_ occurs $raw{$_} times\n" if $raw{$_} > 1; - $_ = lc $_; - $authors{ $map->{$_} || $_ }++; + print "E-mail $_ occurs $count{$_} times\n" if $count{$_} > 1; + my $lc = lc $_; + $authors{ $map->{$lc} || $lc } = $raw{$_}; } - ++$authors{'!'}; - ++$authors{'?'}; + $authors{$_} = $_ for qw(? !); } sub display_test_output { @@ -316,7 +334,7 @@ __DATA__ # List of mappings. First entry the "correct" email address, as appears # in the AUTHORS file. Second is any "alias" mapped to it. # -# If the "correct" email address is a '+', the entry above is reused; +# If the "correct" email address is a '+', the entry above is reused; # this for addresses with more than one alias. # # Note that all entries are in lowercase. Further, no '@' signs should @@ -621,7 +639,7 @@ larry\100wall.org lwall\100jpl-devvax.jpl.nasa.gov + lwall\100scalpel.netlabs.com laszlo.molnar\100eth.ericsson.se molnarl\100cdata.tvnet.hu + ml1050\100freemail.hu -lewart\100uiuc.edu lewart\100vadds.cvm.uiuc.edu +lewart\100uiuc.edu lewart\100vadds.cvm.uiuc.edu + d-lewart\100uiuc.edu lkundrak\100v3.sk lubo.rintel\100gooddata.com lstein\100cshl.org lstein\100formaggio.cshl.org @@ -692,7 +710,7 @@ perl\100greerga.m-l.org greerga\100m-l.org perl\100profvince.com vince\100profvince.com perl-rt\100wizbit.be p5p\100perl.wizbit.be # Maybe we should special case this to get real names out? -Peter.Dintelmann\100Dresdner-Bank.com peter.dintelmann\100dresdner-bank.com +Peter.Dintelmann\100Dresdner-Bank.com peter.dintelmann\100dresdner-bank.com # NOTE: There is an intentional trailing space in the line above pfeifer\100wait.de pfeifer\100charly.informatik.uni-dortmund.de + upf\100de.uu.net |