branch-1-6/maintenance/authors.pl

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