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 my $F, '<', $authorsfile or die "Could not read file '$authorsfile': $!\n";
  89
  90
  91 while (my $line = <$F>) {
  92     my ($email) = ($line =~/([\.\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     my ($filename) = @_;
 128     return unless ($filename =~ /\.PLS$/ or $filename =~ /\.p[ml]$/);
 129     return unless -e $filename;
 130
 131     print "$filename\n" if $verbose;
 132     #local $/=undef;
 133     open my $F, '<', $filename or die "Could not read file '$filename': $!\n";
 134     while (my $line = <$F>) {
 135         #print $line;
 136         last if $line =~ /=head1 +AUTHOR/;
 137     }
 138     my $authorblock;
 139     while (my $line = <$F>) {
 140         last if $line =~ /=head/ and $line !~ /CONTRIBUTORS/;
 141         $authorblock .= $line;
 142     }
 143     close $F;
 144     return unless $authorblock;
 145
 146     while ( $authorblock =~ /([\.\w_-]+@[\.a-z_-]+)/g) {
 147         #my $email = $1;
 148         #$email =~ //
 149         next if $AUTHORS{$1};
 150         #print "$filename\t$1\n";
 151
 152         push @{$NEWAUTHORS{$1}}, $filename;
 153     }
 154 }
 155
 156
 157
 158 =head1 OPTIONS
 159
 160 =over 3
 161
 162 =item B<-d | --dir> path
 163
 164 Overides the default directories to check by one directory 'path' and
 165 all its subdirectories.
 166
 167 =item B<-a | --authorsfile>
 168
 169 path from working directory the AUTHORS file.
 170
 171 Redundant as this information could be had from --dir option butI am
 172 feeling too lazy to change the code.
 173
 174 =cut
 175
 176 sub blankline {
 177     my ($file) = @_;
 178     return unless ($file =~ /\.PLS$/ or $file =~ /\.p[ml]$/);
 179     return unless -e $file;
 180
 181     open my $F, '<', $file or warn "Could not read file '$file': $!\n" && return;
 182     local $/ = "";
 183     while (my $line = <$F>) {
 184         print "$file: +|$1|\n"  if $line =~ /[ \t]\n(=[a-z][^\n]+$)/m and $verbose;
 185         print "$file: ++|$1|\n" if $line =~ /\w\n(=[a-z][^\n]+$)/m    and $verbose;
 186         print "$file:|$1|+\n"   if $line =~ /(^=[a-z][^\n]+)\n[\t ]/m;
 187         #print "$file:|$1|++\n" if /(^=[^\n]+)\n\w/m;
 188     }
 189     close $F;
 190 }
 191
 192 __END__
 193
 194 =item B<-v | --verbose>
 195
 196 Show the progress through files during the POD checking.
 197
 198 =item B<-? | -h  | --help>
 199
 200 This help text.
 201
 202 =back
 203
 204 =head1 FEEDBACK
 205
 206 =head2 Mailing Lists
 207
 208 User feedback is an integral part of the evolution of this and other
 209 Bioperl modules. Send your comments and suggestions preferably to
 210 the Bioperl mailing list.  Your participation is much appreciated.
 211
 212   bioperl-l@bioperl.org                  - General discussion
 213   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
 214
 215 =head2 Reporting Bugs
 216
 217 Report bugs to the Bioperl bug tracking system to help us keep track
 218 of the bugs and their resolution. Bug reports can be submitted via the
 219 web:
 220
 221   https://github.com/bioperl/bioperl-live/issues
 222
 223 =head1 AUTHOR - Heikki Lehvaslaiho
 224
 225 Email heikki-at-bioperl-dot-org
 226
 227 =cut
 228
 229
 230 # find . -name '*.pm' -print | xargs  perl -e '$/=""; while (<>) {$n = $1 if /^package\s+([\w:]+)/; print "$n:|$1|"  if  /(\s\s^=[^\n]+$)/m ; }'  ;
 231
 232 # find . -name '*.pm' -print | xargs  perl -e '$/=""; while (<>) {$n = $1 if /^package\s+([\w:]+)/; print "$n:|$1|\n"  if /(^=[^\n]+\n[\t ])/m ; }'  ;