maintenance/authors.pl

   1 #!/usr/bin/perl
   2 #
   3 =head1 NAME
   4
   5 authors.pl - check modules and scripts for authors not in AUTHORS file
   6
   7 =head1 SYNOPSIS
   8
   9 B<authors.pl> [B<-d|--dir> path ] [B<-v|--verbose>] B<-a|--authorsfile>
  10     [B<-?|-h|--help>]
  11
  12 =head1 DESCRIPTION
  13
  14 Checks Plain Old Documentation (POD) of all bioperl live modules for
  15 AUTHORS and CONTRIBUTORS tags and prints out any emails missing from
  16 the AUTHORS file
  17
  18 =cut
  19
  20 use Data::Dumper;
  21 use File::Find;
  22 use Getopt::Long;
  23 use strict;
  24
  25 sub findauthors;
  26
  27 #
  28 # command line options
  29 #
  30
  31 my ($verbose, $dir, $authorsfile, $help) = (0, undef, "../AUTHORS", undef);
  32 GetOptions(
  33            'v|verbose' => \$verbose,
  34            'dir:s' => \$dir,
  35            'authorsfile:s' => \$authorsfile,
  36            'h|help|?' => sub{ exec('perldoc',$0); exit(0) }
  37            );
  38
  39 #
  40 # global variables
  41 #
  42
  43 # known authors from the AUTHORS file are read into
  44 # the hash which is initialized with known synonymes
  45 our %AUTHORS = map {$_=>1} qw{
  46                               birney@sanger.ac.uk
  47                               jinsana@gmx.net
  48                               Insana@ebi.ac.uk
  49                               fugui@worf.fugu-sg.org
  50                               cjm@fruitfly.bdgp.berkeley.edu
  51                               elia@tll.org.sg
  52                               heikki-at-bioperl-dot-org
  53                               bioinformatics@dieselwurks.com
  54                               bioinformatics1@dieselwurks.com
  55                               bioperl-l@bio.perl.org
  56                               paul@systemsbiology.org
  57                               gattiker@isb-sib.ch
  58                               elia@fugu-sg.org
  59                               jason@cgt.mc.duke.edu
  60                               jason@chg.mc.duke.edu
  61                               jason@open-bio.org
  62                               hilmar.lapp@pharma.novartis.com
  63                               richard.adams@ed.ac.uk
  64                               dblock@gene.pbi.nrc.ca
  65                               ak@ebi.ac.uk
  66                               day@cshl.org
  67                               bala@tll.org.sg
  68                               mrp@sanger.ac.uk
  69                               m.w.e.j.fiers@plant.wag-ur.nl
  70                               cmzmasek@yahoo.com
  71                               fuguteam@fugu-sg.org
  72                               shawnh@gmx.net
  73                           };
  74 our %NEWAUTHORS;     # new authors
  75 our %FIND_OPTIONS = ( wanted => \&findauthors, no_chdir => 1 );
  76
  77
  78 # Directories to check
  79 my @dirs = qw( ../Bio/ ../scripts . );
  80
  81 #print Dumper \%AUTHORS;
  82
  83 #
  84 # Read the AUTHORS file
  85 #
  86
  87
  88 open (F, $authorsfile) || die "can't open file $authorsfile: $!";
  89
  90
  91 while (<F>) {
  92     my ($email) = /([\.\w_-]+ at [\.\w_-]+)/;
  93     next unless $email;
  94     #print $email, "\n";
  95     $email =~ s/ at /@/;
  96     $AUTHORS{$email} = 1;
  97 }
  98 close F;
  99
 100
 101 #
 102 # run
 103 #
 104
 105 if ($dir) {
 106     find \%FIND_OPTIONS, $dir;
 107 } else {
 108     find \%FIND_OPTIONS, @dirs;
 109 }
 110
 111 #
 112 # results
 113 #
 114 print Dumper \%NEWAUTHORS;
 115
 116
 117 #
 118 ##
 119 ### end main
 120 ##
 121 #
 122
 123 #
 124 # this is where the action is
 125 #
 126 sub findauthors {
 127     return unless /\.PLS$/ or /\.p[ml]$/ ;
 128     return unless -e $_;
 129     print "$_\n" if $verbose;
 130     my $filename = $_;
 131     #local $/=undef;
 132     open F, $_ || die "Could not open file $_";
 133     while (<F>) {
 134         #print;
 135         last if /=head1 +AUTHOR/;
 136     }
 137     my $authorblock;
 138     while (<F>) {
 139         last if /=head/ and not /CONTRIBUTORS/;
 140         $authorblock .= $_;
 141     }
 142     return unless $authorblock;
 143     while ( $authorblock =~ /([\.\w_-]+@[\.a-z_-]+)/g) {
 144         #my $email = $1;
 145         #$email =~ //
 146         next if $AUTHORS{$1};
 147         #print "$filename\t$1\n";
 148
 149         push @{$NEWAUTHORS{$1}}, $filename;
 150
 151     }
 152 }
 153
 154
 155
 156 =head1 OPTIONS
 157
 158 =over 3
 159
 160 =item B<-d | --dir> path
 161
 162 Overides the default directories to check by one directory 'path' and
 163 all its subdirectories.
 164
 165 =item B<-a | --authorsfile>
 166
 167 path from working directory the AUTHORS file.
 168
 169 Redundant as this information could be had from --dir option butI am
 170 feeling too lazy to change the code.
 171
 172 =cut
 173
 174 sub blankline {
 175     return unless /\.PLS$/ or /\.p[ml]$/ ;
 176     return unless -e $_;
 177     my $file = $_;
 178     open (F, $_) or warn "can't open file $_: $!" && return;
 179     local $/="";
 180     while (<F>) {
 181         print "$file: +|$1|\n" if /[ \t]\n(=[a-z][^\n]+$)/m and $verbose;
 182         print "$file: ++|$1|\n" if /\w\n(=[a-z][^\n]+$)/m and $verbose;
 183         print "$file:|$1|+\n" if /(^=[a-z][^\n]+)\n[\t ]/m;
 184         #print "$file:|$1|++\n" if /(^=[^\n]+)\n\w/m;
 185     }
 186     close F;
 187 }
 188
 189 __END__
 190
 191 =item B<-v | --verbose>
 192
 193 Show the progress through files during the POD checking.
 194
 195 =item B<-? | -h  | --help>
 196
 197 This help text.
 198
 199 =back
 200
 201 =head1 FEEDBACK
 202
 203 =head2 Mailing Lists
 204
 205 User feedback is an integral part of the evolution of this and other
 206 Bioperl modules. Send your comments and suggestions preferably to
 207 the Bioperl mailing list.  Your participation is much appreciated.
 208
 209   bioperl-l@bioperl.org                  - General discussion
 210   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
 211
 212 =head2 Reporting Bugs
 213
 214 Report bugs to the Bioperl bug tracking system to help us keep track
 215 of the bugs and their resolution. Bug reports can be submitted via the
 216 web:
 217
 218   https://redmine.open-bio.org/projects/bioperl/
 219
 220 =head1 AUTHOR - Heikki Lehvaslaiho
 221
 222 Email heikki-at-bioperl-dot-org
 223
 224 =cut
 225
 226
 227 # find . -name '*.pm' -print | xargs  perl -e '$/=""; while (<>) {$n = $1 if /^package\s+([\w:]+)/; print "$n:|$1|"  if  /(\s\s^=[^\n]+$)/m ; }'  ;
 228
 229 # find . -name '*.pm' -print | xargs  perl -e '$/=""; while (<>) {$n = $1 if /^package\s+([\w:]+)/; print "$n:|$1|\n"  if /(^=[^\n]+\n[\t ])/m ; }'  ;