maintenance/dependencies.pl

   1 # $Id: dependencies.pl 10084 2006-07-04 22:23:29Z cjfields $
   2 #
   3 #!/usr/bin/perl
   4
   5 use strict;
   6 use warnings;
   7 use File::Find;
   8 use Perl6::Form;
   9 use Getopt::Long;
  10 use Module::CoreList;
  11 use CPANPLUS::Backend;
  12
  13 my $dep_header = <<HEADER;
  14 BioPerl Dependencies
  15
  16 NOTE : This file was auto-generated by the helper script
  17 maintenance/dependencies.pl. Do not edit directly!
  18
  19 The following packages are used by BioPerl. While not all are required for
  20 BioPerl to operate properly, some functionality will be missing without them.
  21 You can easily choose to install all of these during the normal installation
  22 process. Note that the PPM version of the BioPerl packages always tries to
  23 install all dependencies.
  24
  25 The DBD::mysql, DB_File and XML::Parser modules require other applications or
  26 databases: MySQL, Berkeley DB, and expat respectively.
  27
  28 NB: This list of packages is not authoritative. See the 'requires',
  29 'build_requires' and 'recommends' sections of Build.PL instead.
  30
  31 HEADER
  32
  33 #
  34 # command line options
  35 #
  36
  37 my ($verbose, $dir, $depfile, $help, $version, $skipbio) = (0, undef, "../DEPENDENCIES.NEW", undef, "5.006001", 0);
  38 GetOptions(
  39         'v|verbose' => \$verbose,
  40         'dir:s' => \$dir,
  41         'depfile:s' => \$depfile,
  42         'p|perl:s' => \$version,
  43         's|skipbio' => \$skipbio,
  44         'h|help|?' => sub{ exec('perldoc',$0); exit(0) }
  45            );
  46
  47 # Directories to check
  48 my @dirs = qw(../Bio/ );
  49
  50 #
  51 # run
  52 #
  53
  54 my %dependencies;
  55 my %bp_packages;
  56 my %core = %{$Module::CoreList::version{$version}};
  57
  58 # pragmas and BioPerl modules not in core (not required)
  59 my %SKIP = map {$_ => 1} qw(base
  60 vars
  61 warnings
  62 strict
  63 constant
  64 overload
  65 Bio::Tools::Run::Ensembl
  66 Bio::Ext::HMM
  67 );
  68
  69 if ($dir) {
  70     find {wanted => \&parse_core, no_chdir => 1}, $dir;
  71 } else {
  72     find {wanted => \&parse_core, no_chdir => 1}, @dirs;
  73 }
  74
  75 #
  76 # process results
  77 #
  78
  79 for my $k (keys %dependencies) {
  80     if (exists $bp_packages{$k} || exists $core{$k}) {
  81         delete $dependencies{$k};
  82     }
  83 }
  84
  85 my $b = CPANPLUS::Backend->new();
  86
  87 # sort by distribution into a hash, keep track of modules
  88
  89 my %distrib;
  90
  91 for my $key (sort keys %dependencies) {
  92     MODULE:
  93     for my $m ($b->module_tree($key)) {
  94         if (!$m) {
  95             warn "$key not found, skipping";
  96             next MODULE;
  97         }
  98         push @{$distrib{$m->package_name}}, [$m, @{$dependencies{$m->module}}]
  99     }
 100 }
 101
 102 open my $dfile, '>', $depfile or die "Could not write dependency file '$depfile': $!\n";
 103
 104 print $dfile $dep_header;
 105
 106 for my $d (sort keys %distrib) {
 107     my $min_ver = 0;
 108     for my $moddata (@{$distrib{$d}}) {
 109         my ($mod, @bp) = @$moddata;
 110         for my $bp (@bp) {
 111             $min_ver = $bp->{ver} if $bp->{ver} >  $min_ver;
 112         }
 113     }
 114     print $dfile
 115             form
 116     {bullet => "* "},
 117     " ============================================================================== ",
 118     "| Distribution              | Module used - Description            | Min. ver. |",
 119     "|---------------------------+--------------------------------------+-----------|",
 120     "| {<<<<<<<<<<<<<<<<<<<<<<<} | * {[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[} | {|||||||} |",
 121     $d,
 122     [
 123         map {
 124             $_->[0]->module.' - '.$_->[1]
 125         } map {
 126             [$_->[0], $_->[0]->description || 'NA']
 127         } @{$distrib{$d}}
 128     ],
 129     $min_ver eq 0 ? 'None' : $min_ver,
 130     "|==============================================================================|",
 131     "| Used by:                                                                     |",
 132     "|------------------------------------------------------------------------------|",
 133     "| * {[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[} |",
 134     [
 135      map {
 136         my $md = $_->[0]->module;
 137         map {join(' - ',( $_->{file}.' - '. $md ))} @{$_}[1..$#{$_}] # obfuscated ain't it!!!
 138      } @{$distrib{$d}}
 139     ],
 140     " ============================================================================== ";
 141 }
 142
 143 close $dfile;
 144
 145 exit;
 146 #
 147 ##
 148 ### end main
 149 ##
 150 #
 151
 152 #
 153 # this is where the action is
 154 #
 155
 156 sub parse_core {
 157     my $file = $_;
 158     return unless $file =~ /\.PLS$/ || $file =~ /\.p[ml]$/ ;
 159     return unless -e $file;
 160     open my $F, '<', $file or die "Could not read file '$file': $!\n";
 161     my $pod = '';
 162     MODULE_LOOP:
 163     while (my $line = <$F>) {
 164         # skip POD, starting comments
 165         next if $line =~ /^\s*\#/xms;
 166         if ($line =~ /^=(\w+)/) {
 167             $pod = $1;
 168         }
 169         if ($pod) {
 170             if ($pod eq 'cut') {
 171                 $pod = '';
 172             } else {
 173                 next MODULE_LOOP;
 174             }
 175         }
 176         # strip off end comments
 177         $line =~ s/\#[^\n]+//;
 178         if ($line =~ /^\bpackage\s+(\S+)\s*;/) {
 179             $bp_packages{$1}++;
 180         } elsif ($line =~ /(?:['"])?\b(use|require)\s+([A-Za-z0-9:_\.\(\)]+)\s*([^;'"]+)?(?:['"])?\s*;/) {
 181             my ($use, $mod, $ver) = ($1, $2, $3);
 182             if ($mod eq 'one') {
 183                 print "$File::Find::name: $. $line";
 184             }
 185             if (exists $SKIP{$mod}) {
 186                 next MODULE_LOOP;
 187             }
 188             if ($ver && $ver !~ /^v?[\d\.]+$/) {
 189                 next MODULE_LOOP;
 190             }
 191             my $nm = $File::Find::name;
 192             $nm =~ s{.*(Bio.*)\.pm}{$1};
 193             $nm =~ s{[\\\/]}{::}g;
 194             if (!exists $dependencies{$mod} ||
 195                 !(grep {$_->{file} eq $nm} @{$dependencies{$mod}})) {
 196                 push @{ $dependencies{$mod} }, {
 197                     ver => $ver || 0,
 198                     file => $nm};
 199                 }
 200         }
 201     }
 202     close $F;
 203 }
 204
 205 __END__
 206
 207 =head1 NAME
 208
 209 dependencies.pl - check modules and scripts for dependencies not in core
 210
 211 =head1 SYNOPSIS
 212
 213 B<dependencies.pl> [B<--dir> path ] [B<-v|--verbose>] [B<--depfile> file]
 214     [B<-?|-h|--help>] [B<-p|--perl> version]
 215
 216 =head1 DESCRIPTION
 217
 218 Recursively parses directory tree given (defaults to '../Bio') and checks files
 219 for possible dependencies and versions (use/require statements).  Checks that
 220 modules aren't part of perl core (--version, defaults to 5.006001).  Module
 221 information is returned using CPANPLUS and data is output to a table using
 222 Perl6::Form (yes I managed to get perl6 in here somehow).
 223
 224 Requires:
 225
 226 File::Find        - core
 227 Getopt::Long      - core
 228 CPANPLUS::Backend
 229 Perl6::Form
 230 Module::CoreList
 231
 232 =head1 OPTIONS
 233
 234 =over 3
 235
 236 =item B<--dir> path
 237
 238 Overides the default directories to check by one directory 'path' and
 239 all its subdirectories.
 240
 241 =item B<--depfile> file
 242
 243 The name of the output file for the dependencies table.  Default is
 244 '../DEPENDENCIES.NEW'
 245
 246 =item B<-v | --verbose>
 247
 248 Show the progress through files during the checking.  Not used currently.
 249
 250 =item B<-p | --perl> version
 251
 252 Perl version (in long form, i.e. 5.010, 5.006001).  Used to weed out the
 253 core modules that should be already present (ActiveState, we're staring at
 254 you sternly).
 255
 256 =item B<-s | --skipbio>
 257
 258 Skips BioPerl-related modules in DEPENDENCIES.
 259
 260 We may add something in the future to allow other forms.
 261
 262 =item B<-? | -h  | --help>
 263
 264 This help text.
 265
 266 =back
 267
 268 =head1 FEEDBACK
 269
 270 =head2 Mailing Lists
 271
 272 User feedback is an integral part of the evolution of this and other
 273 Bioperl modules. Send your comments and suggestions preferably to
 274 the Bioperl mailing list.  Your participation is much appreciated.
 275
 276   bioperl-l@bioperl.org                  - General discussion
 277   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
 278
 279 =head2 Reporting Bugs
 280
 281 Report bugs to the Bioperl bug tracking system to help us keep track
 282 of the bugs and their resolution. Bug reports can be submitted via the
 283 web:
 284
 285   https://github.com/bioperl/bioperl-live/issues
 286
 287 =head1 AUTHOR - Chris Fields
 288
 289 Email cjfields-at-bioperl-dot-org
 290
 291 =cut