maintenance/dependencies.pl

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