tools/generate_authors.pl

   1 #!/usr/bin/perl
   2
   3 #
   4 # Generate the AUTHORS file combining existing AUTHORS file with
   5 # git commit log.
   6 #
   7 # Usage: generate_authors.pl AUTHORS.src
   8
   9 #
  10 # Copyright 2016 Michael Mann (see AUTHORS file)
  11 #
  12 # Wireshark - Network traffic analyzer
  13 # By Gerald Combs <gerald@wireshark.org>
  14 # Copyright 1998 Gerald Combs
  15 #
  16 # This program is free software; you can redistribute it and/or
  17 # modify it under the terms of the GNU General Public License
  18 # as published by the Free Software Foundation; either version 2
  19 # of the License, or (at your option) any later version.
  20 #
  21 # This program is distributed in the hope that it will be useful,
  22 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 # GNU General Public License for more details.
  25 #
  26 # You should have received a copy of the GNU General Public License
  27 # along with this program; if not, write to the Free Software
  28 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  29
  30 use warnings;
  31 use strict;
  32 use Getopt::Long;
  33 use Encode qw(encode decode);
  34
  35 my $state = "";
  36 my %contributors = ();
  37 my $is_contributing = 0;
  38
  39 my $header = "
  40
  41 Original Author
  42 -------- ------
  43 Gerald Combs            <gerald[AT]wireshark.org>
  44
  45
  46 ";
  47
  48 my $trailer = "
  49
  50 Acknowledgements
  51 ------------
  52 Dan Lasley <dlasley[AT]promus.com> gave permission for his
  53 dumpit() hex-dump routine to be used.
  54
  55 Mattia Cazzola <mattiac[AT]alinet.it> provided a patch to the
  56 hex dump display routine.
  57
  58 We use the exception module from Kazlib, a C library written by
  59 Kaz Kylheku <kaz[AT]ashi.footprints.net>. Thanks go to him for
  60 his well-written library. The Kazlib home page can be found at
  61 http://users.footprints.net/~kaz/kazlib.html
  62
  63 We use Lua BitOp, written by Mike Pall, for bitwise operations
  64 on numbers in Lua. The Lua BitOp home page can be found at
  65 http://bitop.luajit.org/
  66
  67 Henrik Brix Andersen <brix[AT]gimp.org> gave permission for his
  68 webbrowser calling routine to be used.
  69
  70 Christophe Devine <c.devine[AT]cr0.net> gave permission for his
  71 SHA1 routines to be used.
  72
  73 snax <snax[AT]shmoo.com> gave permission to use his(?) weak key
  74 detection code from Airsnort.
  75
  76 IANA gave permission for their port-numbers file to be used.
  77
  78 We use the natural order string comparison algorithm, written by
  79 Martin Pool <mbp[AT]sourcefrog.net>.
  80
  81 Emanuel Eichhammer <support[AT]qcustomplot.com> granted permission
  82 to use QCustomPlot.
  83 ";
  84
  85 my $git_log_text = "
  86 From git log
  87 ---------------
  88 ";
  89
  90 # Perl trim function to remove whitespace from the start and end of the string
  91 sub trim($)
  92 {
  93         my $string = shift;
  94         $string =~ s/^\s+//;
  95         $string =~ s/\s+$//;
  96         return $string;
  97 }
  98
  99 sub parse_author_name {
 100         my $full_name = $_[0];
 101         my $email_key;
 102
 103         if ($full_name =~ /^([\w\.\-\'\x80-\xff]+(\s*[\w+\.\-\'\x80-\xff])*)\s+<([^>]*)>/) {
 104                 #Make an exception for Gerald because he's part of the header
 105                 if ($3 ne "gerald[AT]wireshark.org") {
 106                         $email_key = lc($3);
 107                         $contributors{$email_key} = $1;
 108                         print encode('UTF-8', "$full_name\n");
 109                 }
 110         } elsif ($full_name =~ /^([\w\.\-\'\x80-\xff]+(\s*[\w+\.\-\'\x80-\xff])*)\s+\(/) {
 111                 $contributors{"<no_email>"} = $1;
 112                 print encode('UTF-8', "$full_name\n");
 113         }
 114 }
 115
 116 sub parse_git_name {
 117         my $full_name = $_[0];
 118         my $name;
 119         my $email;
 120         my $email_key;
 121         my $len;
 122         my $ntab = 3;
 123         my $line;
 124
 125         #  4321 Navin R. Johnson <nrjohnson@example.com>
 126         if ($full_name =~ /^\s*\d+\s+([^<]*)\s*<([^>]*)>/) {
 127                 $name = trim($1);
 128                 #Convert real email address to "spam proof" one
 129                 $email = trim($2);
 130                 $email =~ s/@/[AT]/g;
 131                 $email_key = lc($email);
 132
 133                 if (!exists($contributors{ $email_key })) {
 134                         #Make an exception for Gerald because he's part of the header
 135                         if ($email ne "gerald[AT]wireshark.org") {
 136                                 $len = length $name;
 137                                 if ($len >= 8 * $ntab) {
 138                                         $line = "$name <$email>";
 139                                 } else {
 140                                         $ntab -= $len / 8;
 141                                         $ntab +=1 if ($len % 8);
 142                                         $line = $name . "\t" x $ntab . "<$email>";
 143                                 }
 144                                 $contributors{$email_key} = $1;
 145                                 print encode('UTF-8', "$line\n");
 146                         }
 147                 }
 148         }
 149 }
 150
 151 # ---------------------------------------------------------------------
 152 #
 153 # MAIN
 154 #
 155
 156 print $header;
 157
 158 open( my $author_fh, '<', $ARGV[0] ) or die "Can't open $ARGV[0]: $!";
 159 while ( my $line = decode('UTF-8', <$author_fh>) ) {
 160         chomp $line;
 161
 162         last if ($line =~ "Acknowledgements");
 163
 164         if ($line =~ "Contributors") {
 165                 $is_contributing = 1;
 166         } elsif ($is_contributing == 0) {
 167                 next;
 168         }
 169
 170         if ($line =~ /([^\{]*)\{/) {
 171                 parse_author_name($line);
 172                 $state = "s_in_bracket";
 173         } elsif ($state eq "s_in_bracket") {
 174                 if ($line =~ /([^\}]*)\}/) {
 175                         print encode('UTF-8', "$line\n");
 176                         $state = "";
 177                 } else {
 178                         print encode('UTF-8', "$line\n");
 179                 }
 180         } elsif ($line =~ /</) {
 181                 parse_author_name($line);
 182         } elsif ($line =~ "(e-mail address removed at contributor's request)") {
 183                 parse_author_name($line);
 184         } else {
 185                 print encode('UTF-8', "$line\n");
 186         }
 187 }
 188 close $author_fh;
 189
 190 print $git_log_text;
 191
 192 open( my $git_author_fh, 'git --no-pager shortlog -se HEAD|')
 193         or die "Can't execute git shortlog: $!";
 194
 195 while ( my $git_line = decode('UTF-8', <$git_author_fh>) ) {
 196         chomp $git_line;
 197
 198         parse_git_name($git_line);
 199 }
 200 close $git_author_fh;
 201
 202 print $trailer;
 203
 204 __END__