maintenance/modules.pl

   1 #!/usr/bin/perl -w
   2 # $Id$
   3 #
   4 =head1 NAME
   5
   6 modules.pl - information about modules in BioPerl core
   7
   8 =head1 SYNOPSIS
   9
  10 B<modules.pl> [B<-V|--verbose>] [B<-c|--count>] | [B<-l|--list>] |
  11   [B<-u|--untested>] | [B<-i|--info> class] | [B<-i|--inherit> |
  12   [B<-d|--dir> path ] | [B<-v|--version> | [B<-?|-h|--help>]
  13
  14 =head1 DESCRIPTION
  15
  16 This script counts, lists and provides other information about bioperl
  17 modules. It is mainly meant to be run by bioperl maintainers.
  18
  19 The default action is to count modules in the bioperl core
  20 distribution. Based on the class name it tries to classify them into
  21 categories. The following is a tentative glossary of terms used.
  22
  23
  24 =over 4
  25
  26 =item Base
  27
  28 Synonyms: Generic class, parameterized class, generic module.
  29
  30 A class that you don't instantiate in your scripts, but that it's a
  31 template for other classes.
  32
  33 Examples: Bio::Tools::Run::WrapperBase - a base object for wrappers
  34 around executables. Bio::Tools::Analysis::SimpleAnalysisBase - an
  35 abstract superclass for SimpleAnalysis implementations
  36
  37 This are counted with C</:Base/ | /Base$/>; They have "Base" in the
  38 beginning or end of the name.
  39
  40 =item Interface
  41
  42 Synonyms: protocol, feature set.
  43
  44 Class that defines a set of features that are common to a group of
  45 classes.
  46
  47 Example: Bio::Tree::NodeI - interface describing a Tree Node.
  48
  49 This are counted with C</[^A-Z]I$/>; They have "I" at the end of the
  50 name.
  51
  52 =item Component
  53
  54 A class that implements a small subset of their superclass. They are in
  55 a directory with an identical name of the superclass. There are plenty
  56 of them. You need only a small number of methods to be overridden.
  57
  58 Example: Bio::SeqIO::fasta.
  59
  60 This is counted with C</.*:[a-z]/>; Classes are inside their base directory
  61 and all in lowercase.
  62
  63 =item Instance
  64
  65 The rest of them. It is sometimes helpful to divide them into two
  66 types:
  67
  68 =over 2
  69
  70 =item Algorithmic classes
  71
  72 Example: Bio::AlignIO - Handler for AlignIO formats
  73
  74 =item Storage classes
  75
  76 Example: Bio::SimpleAlign - Multiple alignments held as a set of
  77 sequences
  78
  79 =back
  80
  81 =back
  82
  83 =cut
  84
  85 #
  86 # The helper class to store class status;
  87 #
  88 package BioClass;
  89
  90 sub new {
  91     my $class = shift;
  92     my $name = shift;
  93     die unless $name;
  94
  95     my $self = {};
  96     $self->{'name'} = $name;
  97     $self->{'tested'} = 0;
  98     $self->{'type'} = '';
  99     $self->{'path'} = '';
 100
 101     bless $self, $class;
 102 }
 103
 104
 105 sub name {
 106     my $self = shift;
 107     return $self->{'name'};
 108 }
 109
 110 sub tested {
 111     my $self = shift;
 112     my $value = shift;
 113     $self->{'tested'} = 1 if defined $value && $value;
 114     return $self->{'tested'} || 0;
 115 }
 116
 117 sub type {
 118     my $self = shift;
 119     my $value = shift;
 120     $self->{'type'} = $value if defined $value;
 121     return $self->{'type'};
 122 }
 123
 124 sub path {
 125     my $self = shift;
 126     my $value = shift;
 127     $self->{'path'} = $value if defined $value;
 128     return $self->{'path'};
 129 }
 130
 131 sub add_superclass {
 132     my $self = shift;
 133     my $superclass = shift;
 134     return unless $superclass;
 135     $self->{'superclasses'}->{$superclass} = 1 ;
 136 }
 137
 138 sub each_superclass {
 139     my $self = shift;
 140     return  keys %{$self->{'superclasses'}};
 141 }
 142
 143 sub add_used_class {
 144     my $self = shift;
 145     my $used_class = shift;
 146     return unless $used_class;
 147     $self->{'used_classes'}->{$used_class} = 1 ;
 148 }
 149
 150 sub each_used_class {
 151     my $self = shift;
 152     return  keys %{$self->{'used_classes'}};
 153 }
 154
 155 package main;
 156
 157 use File::Find;
 158 use Getopt::Long;
 159 use Data::Dumper;
 160 use strict;
 161
 162
 163 # declare subroutines
 164 sub dir;
 165 sub modules;
 166 sub count;
 167 sub list_all;
 168 sub untested;
 169 sub info;
 170 sub inherit;
 171 sub synopsis;
 172 sub version;
 173
 174 # command line options
 175 my ($dir, $count,$list, $verbose,$info,$untested, $inherit, $synopsis,
 176     $version);
 177 GetOptions(
 178            'dir:s'      => \$dir,
 179            'count'    => \$count,
 180            'list'     => \$list,
 181            'test_BioClass' => \&_test_BioClass,
 182            'V|verbose'  => \$verbose,
 183            'untested' => \$untested,
 184            'info:s' =>  \$info,
 185            'inherit' => \$inherit,
 186            'synopsis' => \$synopsis,
 187            'version' => \$version,
 188            'h|help|?' => sub{ exec('perldoc',$0); exit(0) }
 189            );
 190
 191
 192 our %MODULES; # storage structure
 193
 194 # find modules
 195 my $pwd = $ENV{PWD};
 196 my $seachdir = "$pwd/../Bio"; #default
 197 my %FIND_OPTIONS = ( wanted => \&modules );
 198
 199 $seachdir = "$pwd/$dir" if $dir;
 200 find \%FIND_OPTIONS, $seachdir;
 201
 202
 203 # call subroutines
 204 if    ($list)     { list_all }
 205 elsif ($untested) { untested }
 206 elsif ($info)     { info($info) }
 207 elsif ($inherit)  { inherit }
 208 elsif ($synopsis) { synopsis }
 209 elsif ($version)   { version }
 210 else              { count }
 211
 212
 213 ################# end main ####################
 214
 215
 216 #
 217 # subroutines;
 218 #
 219
 220 sub _test_BioClass {
 221     $a = new BioClass('Bio::Test');
 222     print "Class name: ", $a->name(), "\n";
 223     $a->add_superclass('Bio::Super');
 224     $a->add_superclass('Bio::Super2');
 225     $a->tested(1);
 226     $a->type('instance');
 227     print Dumper [$a->each_superclass] if $a->tested;
 228     print Dumper $a;
 229     exit;
 230 }
 231
 232 sub modules {
 233     return unless /\.pm$/ ;
 234     #return unless -e $_;
 235     #print "file: $_\n" if $verbose;
 236     open (F, $_) or warn "can't open file $_: $!" && return;
 237     my $class;
 238     while (<F>) {
 239         if (/^package\s+([\w:]+)\s*;/) {
 240             #print $1, "\n" if $verbose;
 241             $_ = $1;
 242             $class = new BioClass($_);
 243             $MODULES{$_} = $class;
 244             if (/.*:[a-z]/) {
 245                 $class->type('component');
 246             } elsif (/:Base/ | /Base$/) {
 247                 $class->type('base');
 248             } elsif (/[^A-Z]I$/) {
 249                 $class->type('interface');
 250             } else {
 251                 $class->type('instance');
 252             }
 253             $class->path($File::Find::name);
 254         }
 255         if (/^\w*use/ && /(Bio[\w:]+)\W*;/ && not /base/) {
 256             next unless $class;
 257             #print "\t$1\n" if $verbose;
 258             $class->add_used_class($1);
 259         }
 260         if ((/\@ISA/ || /use base/) && /Bio/) {
 261             next unless $class;
 262             my $line = $_;
 263             while ( $line =~ /(Bio[\w:]+)/g) {
 264                 #print "\t$1\n" if $verbose;
 265                 $class->add_superclass($1);
 266             }
 267         }
 268         if (/\@ISA/ && /Bio/) {
 269             next unless $class;
 270             my $line = $_;
 271             while ( $line =~ /(Bio[\w:]+)/g) {
 272                 #print "\t$1\n" if $verbose;
 273                 $class->add_superclass($1);
 274             }
 275         }
 276     }
 277     close F;
 278 }
 279
 280 =head1 OPTIONS
 281
 282 Only one option is processed on each run of the script. The --verbose
 283 is an exception, it modifies the amount of output.
 284
 285 =over 4
 286
 287 =item B<-V | --verbose>
 288
 289 B<INACTIVE>
 290
 291 Set this option if you want to see more verbose output. Often that
 292 will mean seeing warnings normally going into STDERR.
 293
 294 =cut
 295
 296 =item B<-d | --dir> path
 297
 298 Overides the default directories to check by one directory 'path' and
 299 all its subdirectories.
 300
 301 =item B<-c | --count>
 302
 303 The default action if no other option is given. Gives the count of
 304 modules broken to B<instance> ("usable"), B<base> ( (abstract)?
 305 superclass) , B<interface> (the "I" files) and B<component> (used from
 306 instantiable parent) modules, in addition to total number of modules.
 307
 308 Note that abstract superclass in bioperl is not an enforced concept and
 309 they are not clearly indicateded in the class name.
 310
 311 =cut
 312
 313 sub count {
 314     printf "Instance : %3d\n",
 315         scalar (grep $MODULES{$_}->type =~ /instance/ , keys %MODULES);
 316     printf "Base     : %3d\n",
 317         scalar (grep $MODULES{$_}->type =~ /base/ , keys %MODULES);
 318     printf "Interface: %3d\n",
 319         scalar (grep $MODULES{$_}->type =~ /interface/ , keys %MODULES);
 320     printf "Component: %3d\n",
 321         scalar (grep $MODULES{$_}->type =~ /component/ , keys %MODULES);
 322     print  "--------------\n";
 323     printf "Total    : %3d\n", scalar (keys %MODULES);
 324
 325 }
 326
 327 =item B<-l | --list>
 328
 329 Prints all the module names in alphabetical order. The output is a tab
 330 separated list of category (see above) and module name per line. The
 331 output can be processed with standard UNIX command line tools.
 332
 333 =cut
 334
 335 sub list_all {
 336     foreach ( sort keys %MODULES) {
 337         print $MODULES{$_}->type. "\t$_\n";
 338     }
 339 }
 340
 341 =item B<-u | --untested>
 342
 343 Prints a list of instance modules which are I<not> explicitly used by
 344 test files in the directory. Superclasess or any classes used by others
 345 are not reported, either, since their methods are assumed to be tested
 346 by subclass tests.
 347
 348
 349 =cut
 350
 351 sub _used_and_super {
 352     my $name = shift;
 353 #    print "-:$name\n" if /Locati/;
 354     foreach ($MODULES{$name}->each_superclass) {
 355         next unless defined $MODULES{$_};
 356 #        print "-^$_\n" if /Locati/;
 357 #        unless (defined $MODULES{$_} or $MODULES{$_}->tested) {
 358         if (not  $MODULES{$_}->tested) {
 359             $MODULES{$_}->tested(1);
 360             _used_and_super($_);
 361         }
 362     }
 363     foreach ($MODULES{$name}->each_used_class) {
 364         next unless defined $MODULES{$_};
 365 #        print "--$_\n" if /Locati/;
 366 #        unless (defined $MODULES{$_} or $MODULES{$_}->tested) {
 367         if (not  $MODULES{$_}->tested) {
 368             $MODULES{$_}->tested(1);
 369             _used_and_super($_);
 370         }
 371 #        $MODULES{$_}->tested(1) && _used_and_super($_)
 372 #            unless defined $MODULES{$_} or $MODULES{$_}->tested;
 373     }
 374     return 1;
 375 }
 376
 377 sub untested {
 378     foreach (`find ../t -name "*.t" -print | xargs grep -hs "[ur][se][eq]"`) {
 379         s/.*use +//;
 380         s/.*require +//;
 381         next unless /^Bio/;
 382
 383         s/[\W;]+$//;
 384         s/([\w:]+).*/$1/;
 385         my $name = $_;
 386
 387         next unless $MODULES{$_};
 388         $MODULES{$_}->tested(1)
 389             unless defined $MODULES{$_} and $MODULES{$_}->tested;
 390
 391         next if $MODULES{$name}->name eq "Bio::SeqIO::abi"; # exception: requires bioperl ext package
 392         next if $MODULES{$name}->name eq "Bio::SeqIO::ctf"; # exception: requires bioperl ext package
 393         next if $MODULES{$name}->name eq "Bio::SeqIO::exp"; # exception: requires bioperl ext package
 394         next if $MODULES{$name}->name eq "Bio::SeqIO::pln"; # exception: requires bioperl ext package
 395         next if $MODULES{$name}->name eq "Bio::SeqIO::ztr"; # exception: requires bioperl ext package
 396 #        print $MODULES{$name}->name, "\n";
 397 #        print Dumper $MODULES{$name};
 398
 399         _used_and_super($name);
 400
 401     }
 402
 403     foreach ( sort keys %MODULES) {
 404
 405         # skip some name spaces
 406         next  if /^Bio::Search/; # Bio::Search and Bio::SearchIO are extensively tested
 407                                  # but classes are used by attribute naming
 408
 409         print "$_\n" if
 410             $MODULES{$_}->type eq 'instance' and ($MODULES{$_}->tested == 0) ;
 411     }
 412
 413 }
 414
 415 =item B<-i | --info> class
 416
 417 Dumps information about a class given as an argument.
 418
 419 =cut
 420
 421 sub info {
 422     my $class = shift;
 423     die "" unless $class;
 424     #print Dumper $MODULES{$class};
 425     my $c = $MODULES{$class};
 426     print $c->name, "\n";
 427     printf "  Type:\n\t%s\n", $c->type;
 428     print "  Superclasses:\n";
 429     foreach (sort $c->each_superclass) {
 430         print "\t$_\n";
 431     }
 432     print "  Used classes:\n";
 433     foreach (sort $c->each_used_class) {
 434         print "\t$_\n";
 435     }
 436 }
 437
 438
 439 =item B<-i | --inherit>
 440
 441 Finds interface modules which inherit from an instantiable class.
 442
 443 Could be extended to check other bad inheritance patterns.
 444
 445 =cut
 446
 447 sub inherit {
 448     foreach ( sort keys %MODULES) {
 449         my $c=$MODULES{$_};
 450         next unless $c->type =~ /interface/;
 451         foreach my $super ($c->each_superclass) {
 452             next if $super =~ /I$/;
 453             print "Check this inheritance: ", $c->name, " <-- $super\n";
 454         }
 455     }
 456 }
 457
 458 =item B<-s | --synopsis>
 459
 460 Test SYNOPSIS section of bioperl modules for runnability
 461
 462 =cut
 463
 464 sub synopsis {
 465     foreach ( sort keys %MODULES) {
 466         my $c=$MODULES{$_};
 467
 468         next unless $c->type eq "instance";
 469         next if $c->name eq 'Bio::Root::Version';
 470         next if $c->name eq 'Bio::Tools::HMM';
 471
 472         my $synopsis = '';
 473         open (F, $c->path) or warn "can't open file ".$c->name.": $!" && return;
 474
 475         my $flag = 0;
 476         while (<F>) {
 477             last if $flag && /^=/;
 478             $synopsis .= $_ if $flag;
 479             $flag = 1 if /^=head1 +SYNOPSIS/;
 480         }
 481
 482         # remove comments
 483         $synopsis =~ s/[^\$]#[^\n]*//g;
 484         # allow linking to an other Bio module, e.g.: See L<Bio::DB::GFF>.
 485         $synopsis =~ s/[^\n]*L<Bio[^\n]*//g;
 486         # protect single quotes
 487         $synopsis =~ s/'/"/g;
 488
 489         my $res = `perl -ce '$synopsis' 2>&1 `;
 490         next if $res =~ /syntax OK/;
 491         print $c->path, "\n";
 492         print $synopsis;
 493         print $res;
 494         print "-" x 70, "\n";
 495         # print "SYNOPSIS not runnable\n";
 496         close F;
 497     }
 498 }
 499
 500 =item B<-v | --version>
 501
 502 Test the VERSION of the module against the global one set in
 503 Bio::Root::Variation. Print out the different ones.
 504
 505 =cut
 506
 507 sub version {
 508
 509     use Bio::Root::Version;
 510     my $version =  $Bio::Root::Version::VERSION;
 511
 512     my %skip = ( # these are defined together with an other module
 513                  # and can not be use independently
 514                 'Bio::AnalysisI::JobI' => 1,
 515                 'Bio::PrimarySeq::Fasta' => 1,
 516                 'Bio::DB::Fasta::Stream' => 1,
 517                 'Bio::DB::GFF::ID_Iterator' => 1,
 518                 'Bio::DB::GFF::Adaptor::dbi::faux_dbh' =>1,
 519                 'Bio::LiveSeq::IO::SRS' =>1 # tries to call an external module
 520                );
 521
 522     foreach ( sort keys %MODULES) {
 523         my $n=$MODULES{$_}->name;
 524         next if $skip{$n};
 525         my $vv= "\$${n}::VERSION";
 526         my $v = `perl -we 'use $n; print $vv;'`;
 527         printf "%50s %-3s\n", $n, $v unless $version eq $v;
 528     }
 529 }
 530
 531 __END__
 532
 533 =item B<-? | -h  | --help>
 534
 535 This help text.
 536
 537 =back
 538
 539 =head1 FEEDBACK
 540
 541 =head2 Mailing Lists
 542
 543 User feedback is an integral part of the evolution of this and other
 544 Bioperl modules. Send your comments and suggestions preferably to
 545 the Bioperl mailing list.  Your participation is much appreciated.
 546
 547   bioperl-l@bioperl.org                  - General discussion
 548   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
 549
 550 =head2 Reporting Bugs
 551
 552 Report bugs to the Bioperl bug tracking system to help us keep track
 553 of the bugs and their resolution. Bug reports can be submitted via the
 554 web:
 555
 556   http://bugzilla.open-bio.org/
 557
 558 =head1 AUTHOR
 559
 560 Heikki Lehvaslaiho, heikki-at-bioperl-dot-org
 561
 562 =head1 Contributors
 563
 564 Albert Vilella, avilella-AT-gmail-DOT-com
 565
 566 =cut
 567
 568
 569