maintenance/deprecated.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use version;
   7 use Bio::Root::Version;
   8 use File::Find;
   9 use Getopt::Long;
  10 use Perl6::Form;
  11 use Carp;
  12
  13 #
  14 # command line options
  15 #
  16
  17 my ($verbose, $dir, $depfile, $help, $new, $outfile, $write, $version) =
  18 (0, undef, "../DEPRECATED", undef, [], '../DEPRECATED.NEW', 0, $Bio::Root::Version::VERSION);
  19 GetOptions(
  20         'v|verbose' => \$verbose,
  21                 'b|bp_version:s' => \$version,
  22         'dir:s' => \$dir,
  23         'depfile:s' => \$depfile,
  24         'n|new=s@' => \$new,
  25         'o|outfile:s' => \$outfile,
  26         'w|write' => \$write,
  27         'h|help|?' => sub{ exec('perldoc',$0); exit(0) }
  28            );
  29
  30 # Default directories to check
  31 my @dirs = qw(../Bio/ );
  32
  33 # use version to consolidate old vs new versioning schemes
  34 my $base_version = version->new( $version );
  35
  36 print "Version: $base_version\n";
  37
  38 my %deprecated;
  39 my %removed;
  40 my @dep_data;
  41
  42 # parse DEPRECATED file
  43
  44 open my $DFILE, '<', $depfile || die "Can't open $depfile: $!";
  45 my $seen_top;
  46 while (my $data = <$DFILE>) {
  47     if ($data =~ /^-+$/) {
  48         $seen_top = 1;
  49         next;
  50     }
  51     next unless $seen_top;
  52     chomp $data;
  53     my ($module, $dep, $rem, $note) = split(/\s+/,$data,4);
  54     next unless $module;
  55     my $d = version->new($dep);
  56     my $r = version->new($rem);
  57         print "$module Dep: $d Rem: $r\n" if $verbose;
  58     if ($rem <= $base_version) {
  59         $removed{$module}++;
  60     } elsif ($dep <= $base_version) {
  61         $deprecated{$module}++;
  62     }
  63     push @dep_data, {module => $module,
  64                      dep => $dep,
  65                      remove => $rem,
  66                      note => $note}
  67 }
  68
  69 close $DFILE;
  70
  71 for my $new (@$new) {
  72     my ($module, $dep, $rem, $note) = split(',',$new,4);
  73     last if !$module || !$dep || !$rem;
  74     if ($module !~ /Bio/) {
  75         croak "Can only deprecate BioPerl modules, not $module"
  76     }
  77     push @dep_data, {module => $module,
  78                  dep => $dep,
  79                  remove => $rem,
  80                  note => $note}
  81 }
  82
  83 # run through all files in core (checks to see if anything is still present)
  84
  85 if ($dir) {
  86     find {wanted => \&parse_core, no_chdir => 1}, $dir;
  87 } else {
  88     find {wanted => \&parse_core, no_chdir => 1}, @dirs;
  89 }
  90
  91 #
  92 # results
  93 #
  94
  95 # uses Perl6::Form
  96
  97 if ($write || @$new) {
  98
  99 open (my $NEWDEP, '>', $outfile) || croak "Can't open $outfile :$!";
 100
 101 print $NEWDEP <<HEAD;
 102 # These are modules which are deprecated and later removed from the toolkit
 103 # See http://www.bioperl.org/wiki/Deprecated_modules for the latest details
 104
 105 HEAD
 106
 107 # may replace with better formatting, but it needs to be round-tripped
 108
 109 print $NEWDEP form
 110 "Deprecated                     Version    Version                                             ",
 111 "Module                        Deprecated  Removed  Notes                                      ",
 112 "----------------------------------------------------------------------------------------------";
 113
 114 for my $datum (@dep_data) {
 115     my ($mod, $dep, $rem, $note) = map {$datum->{$_}} qw (module dep remove note);
 116
 117 print $NEWDEP form
 118 "{[[[[[[[[[[[[[[[[[[[[[[[[[[[[[} {|||||}  {|||||}   {[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[}",
 119     $mod,     $dep,        $rem,       $note;
 120 }
 121
 122 }
 123
 124 #
 125 ##
 126 ### end main
 127 ##
 128 #
 129
 130 #
 131 # this is where the action is
 132 #
 133
 134 sub parse_core {
 135     my $file = $_;
 136     return unless $file =~ /\.PLS$/ || $file =~ /\.p[ml]$/ ;
 137     return unless -e $file;
 138     open my $F, $file || die "Could not open file $file";
 139     while (my $line = <$F>) {
 140         if ($line =~ /(?:['"])?\b(use|require)\s+([A-Za-z0-9:_\.\(\)]+)\s*([^;'"]+)?(?:['"])?\s*;/) {
 141             my ($use, $mod) = ($1, $2);
 142                         if (exists $removed{$mod}) {
 143                 print "$File::Find::name: Line $.: $mod is removed\n";
 144             } elsif (exists $deprecated{$mod}) {
 145                 print "$File::Find::name: Line $.: $mod is deprecated\n";
 146             }
 147         }
 148     }
 149     close $F;
 150 }
 151
 152 # $Id: deprecated.pl 10084 2006-07-04 22:23:29Z mauricio $
 153 #
 154 =head1 NAME
 155
 156 deprecated.pl - Check modules and scripts for use of deprecated modules and
 157 methods, indicates presence in a file to STDERR. Optionally accepts new modules
 158 and adds them to a newly formatted deprecation file.
 159
 160 =head1 SYNOPSIS
 161
 162 B<deprecated.pl> [B<-d|--dir> path ] [B<-v|--verbose>] [B<-a|--depfile>]
 163     [B<-n|--new>] [B<-w|--write>] [B<-o|--outfile>]
 164     [B<-?|-h|--help>]
 165
 166 =head1 OPTIONS
 167
 168 =over 3
 169
 170 =item B<-d | --dir> path
 171
 172 Overides the default directories to check by one directory 'path' and
 173 all its subdirectories.
 174
 175 =item B<-a | --depfile>
 176
 177 path from working directory that contains the DEPRECATED file.
 178
 179 =item B<-n | --new>
 180
 181 New addition to the deprecation list; this should be in the form of
 182 'Module,dep_release,remove_release,notes'. Notes should only be 40 chars long.
 183
 184 =item B<-b | --bp_version>
 185
 186 BioPerl version.  This only appears to work correctly when using numerical
 187 versions (1.5.2 instead of 1.005002)
 188
 189 =item B<-w | --write>
 190
 191 Write out new deprecation file to $outfile.  If --new is used this is assumed.
 192
 193 =item B<-o | --outfile>
 194
 195 Name of output file to write deprecation table to. DEPRECATED.NEW is the default
 196 name
 197
 198 =item B<-v | --verbose>
 199
 200 Show the progress through files during the checking.
 201
 202 =item B<-? | -h  | --help>
 203
 204 This help text.
 205
 206 =back
 207
 208 =head1 FEEDBACK
 209
 210 =head2 Mailing Lists
 211
 212 User feedback is an integral part of the evolution of this and other
 213 Bioperl modules. Send your comments and suggestions preferably to
 214 the Bioperl mailing list.  Your participation is much appreciated.
 215
 216   bioperl-l@bioperl.org                  - General discussion
 217   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
 218
 219 =head2 Reporting Bugs
 220
 221 Report bugs to the Bioperl bug tracking system to help us keep track
 222 of the bugs and their resolution. Bug reports can be submitted via the
 223 web:
 224
 225   https://redmine.open-bio.org/projects/bioperl/
 226
 227 =head1 AUTHOR - Chris Fields
 228
 229 Email cjfields-at-bioperl-dot-org
 230
 231 =cut