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