3
# This is a subclass of Module::Build so we can override certain methods and do
6
# It was first written against Module::Build::Base v0.2805. Many of the methods
7
# here are copy/pasted from there in their entirety just to change one or two
8
# minor things, since for the most part Module::Build::Base code is hard to
11
# This was written by Sendu Bala and is released under the same license as
14
package ModuleBuildBioperl;
17
# we really need Module::Build to be installed
18
unless (eval "use Module::Build 0.2805; 1") {
19
print "This package requires Module::Build v0.2805 or greater to install itself.\n";
21
require ExtUtils::MakeMaker;
22
my $yn = ExtUtils::MakeMaker::prompt(' Install Module::Build now from CPAN?', 'y');
24
unless ($yn =~ /^y/i) {
25
die " *** Cannot install without Module::Build. Exiting ...\n";
33
# Save this because CPAN will chdir all over the place.
36
my $build_pl = File::Spec->catfile($cwd, "Build.PL");
38
File::Copy::move($build_pl, $build_pl."hidden"); # avoid bizarre bug with Module::Build tests using the wrong Build.PL if it happens to be in PERL5LIB
39
CPAN::Shell->install('Module::Build');
40
File::Copy::move($build_pl."hidden", $build_pl);
41
CPAN::Shell->expand("Module", "Module::Build")->uptodate or die "Couldn't install Module::Build, giving up.\n";
43
chdir $cwd or die "Cannot chdir() back to $cwd: $!\n\n***\nInstallation will probably work fine if you now quit CPAN and try again.\n***\n\n";
46
eval "use base Module::Build; 1" or die $@;
48
# ensure we'll be able to reload this module later by adding its path to inc
56
our $VERSION = 1.005002101;
57
our @extra_types = qw(options excludes_os feature_requires test); # test must always be last in the list!
58
our $checking_types = "requires|conflicts|".join("|", @extra_types);
61
# our modules are in Bio, not lib
64
foreach my $pm (@{$self->rscan_dir('Bio', qr/\.pm$/)}) {
65
$self->{properties}{pm_files}->{$pm} = File::Spec->catfile('lib', $pm);
68
$self->_find_file_by_type('pm', 'lib');
71
# ask what scripts to install (this method is unique to bioperl)
75
# we can offer interactive installation by groups only if we have subdirs
76
# in scripts and no .PLS files there
77
opendir(my $scripts_dir, 'scripts') or die "Can't open directory 'scripts': $!\n";
80
while (my $thing = readdir($scripts_dir)) {
81
next if $thing =~ /^\./;
82
next if $thing eq 'CVS';
83
if ($thing =~ /PLS$|pl$/) {
87
$thing = File::Spec->catfile('scripts', $thing);
90
push(@group_dirs, $thing);
93
closedir($scripts_dir);
94
my $question = $int_ok ? "Install [a]ll Bioperl scripts, [n]one, or choose groups [i]nteractively?" : "Install [a]ll Bioperl scripts or [n]one?";
96
my $prompt = $self->prompt($question, 'a');
98
if ($prompt =~ /^[aA]/) {
99
$self->log_info(" - will install all scripts\n");
100
$self->notes(chosen_scripts => 'all');
102
elsif ($prompt =~ /^[iI]/) {
103
$self->log_info(" - will install interactively:\n");
106
foreach my $group_dir (@group_dirs) {
107
my $group = File::Basename::basename($group_dir);
108
print " * group '$group' has:\n";
110
my @script_files = @{$self->rscan_dir($group_dir, qr/\.PLS$|\.pl$/)};
111
foreach my $script_file (@script_files) {
112
my $script = File::Basename::basename($script_file);
116
my $result = $self->prompt(" Install scripts for group '$group'? [y]es [n]o [q]uit", 'n');
117
die if $result =~ /^[qQ]/;
118
if ($result =~ /^[yY]/) {
119
$self->log_info(" + will install group '$group'\n");
120
push(@chosen_scripts, @script_files);
123
$self->log_info(" - will not install group '$group'\n");
127
my $chosen_scripts = @chosen_scripts ? join("|", @chosen_scripts) : 'none';
129
$self->notes(chosen_scripts => $chosen_scripts);
132
$self->log_info(" - won't install any scripts\n");
133
$self->notes(chosen_scripts => 'none');
139
# our version of script_files doesn't take args but just installs those scripts
140
# requested by the user after choose_scripts() is called. If it wasn't called,
141
# installs all scripts in scripts directory
145
my $chosen_scripts = $self->notes('chosen_scripts');
146
if ($chosen_scripts) {
147
return if $chosen_scripts eq 'none';
148
return { map {$_, 1} split(/\|/, $chosen_scripts) } unless $chosen_scripts eq 'all';
151
return $_ = { map {$_,1} @{$self->rscan_dir('scripts', qr/\.PLS$|\.pl$/)} };
154
# process scripts normally, except that we change name from *.PLS to bp_*.pl
155
sub process_script_files {
157
my $files = $self->find_script_files;
158
return unless keys %$files;
160
my $script_dir = File::Spec->catdir($self->blib, 'script');
161
File::Path::mkpath( $script_dir );
163
foreach my $file (keys %$files) {
164
my $result = $self->copy_if_modified($file, $script_dir, 'flatten') or next;
165
$self->fix_shebang_line($result) unless $self->os_type eq 'VMS';
166
$self->make_executable($result);
168
my $final = File::Basename::basename($result);
169
$final =~ s/\.PLS$/\.pl/; # change from .PLS to .pl
170
$final =~ s/^/bp_/ unless $final =~ /^bp/; # add the "bp" prefix
171
$final = File::Spec->catfile($script_dir, $final);
172
$self->log_info("$result -> $final\n");
173
File::Copy::move($result, $final) or die "Can't rename '$result' to '$final': $!";
177
# extended to handle extra checking types
180
my $ph = $self->{phash};
184
if ($ph->{features}->exists($key)) {
185
return $ph->{features}->access($key, @_);
188
if (my $info = $ph->{auto_features}->access($key)) {
189
my $failures = $self->prereq_failures($info);
190
my $disabled = grep( /^(?:\w+_)?(?:$checking_types)$/, keys %$failures ) ? 1 : 0;
194
return $ph->{features}->access($key, @_);
197
# No args - get the auto_features & overlay the regular features
199
my %auto_features = $ph->{auto_features}->access();
200
while (my ($name, $info) = each %auto_features) {
201
my $failures = $self->prereq_failures($info);
202
my $disabled = grep( /^(?:\w+_)?(?:$checking_types)$/, keys %$failures ) ? 1 : 0;
203
$features{$name} = $disabled ? 0 : 1;
205
%features = (%features, $ph->{features}->access());
207
return wantarray ? %features : \%features;
209
*feature = \&features;
211
# overridden to fix a stupid bug in Module::Build and extended to handle extra
213
sub check_autofeatures {
215
my $features = $self->auto_features;
217
return unless %$features;
219
$self->log_info("Checking features:\n");
221
my $max_name_len = 0; # this wasn't set to 0 in Module::Build, causing warning in next line
222
$max_name_len = ( length($_) > $max_name_len ) ? length($_) : $max_name_len for keys %$features;
224
while (my ($name, $info) = each %$features) {
225
$self->log_info(" $name" . '.' x ($max_name_len - length($name) + 4));
226
if ($name eq 'PL_files') {
227
print "got $name => $info\n";
229
while (my ($key, $val) = each %$info) {
230
print " $key => $val\n";
234
if ( my $failures = $self->prereq_failures($info) ) {
235
my $disabled = grep( /^(?:\w+_)?(?:$checking_types)$/, keys %$failures ) ? 1 : 0;
236
$self->log_info( $disabled ? "disabled\n" : "enabled\n" );
239
while (my ($type, $prereqs) = each %$failures) {
240
while (my ($module, $status) = each %$prereqs) {
241
my $required = ($type =~ /^(?:\w+_)?(?:requires|conflicts)$/) ? 1 : 0;
242
my $prefix = ($required) ? '-' : '*';
243
$log_text .= " $prefix $status->{message}\n";
246
$self->log_warn($log_text) if $log_text && ! $self->quiet;
249
$self->log_info("enabled\n");
253
$self->log_info("\n");
256
# overriden just to hide pointless ugly warnings
257
sub check_installed_status {
259
open (my $olderr, ">&", \*STDERR);
260
open(STDERR, "/dev/null");
261
my $return = $self->SUPER::check_installed_status(@_);
262
open(STDERR, ">&", $olderr);
266
# extend to handle option checking (which takes an array ref) and code test
267
# checking (which takes a code ref and must return a message only on failure)
268
# and excludes_os (which takes an array ref of regexps).
269
# also handles more informative output of recommends section
270
sub prereq_failures {
271
my ($self, $info) = @_;
273
my @types = (@{ $self->prereq_action_types }, @extra_types);
274
$info ||= {map {$_, $self->$_()} @types};
277
foreach my $type (@types) {
278
my $prereqs = $info->{$type} || next;
281
if ($type eq 'test') {
282
unless (keys %$out) {
283
$status->{message} = &{$prereqs};
284
$out->{$type}{'test'} = $status if $status->{message};
287
elsif ($type eq 'options') {
289
foreach my $wanted_option (@{$prereqs}) {
290
unless ($self->args($wanted_option)) {
291
push(@not_ok, $wanted_option);
296
$status->{message} = "Command line option(s) '@not_ok' not supplied";
297
$out->{$type}{'options'} = $status;
300
elsif ($type eq 'excludes_os') {
301
foreach my $os (@{$prereqs}) {
303
$status->{message} = "This feature isn't supported under your OS ($os)";
304
$out->{$type}{'excludes_os'} = $status;
310
while ( my ($modname, $spec) = each %$prereqs ) {
311
$status = $self->check_installed_status($modname, $spec);
313
if ($type =~ /^(?:\w+_)?conflicts$/) {
314
next if !$status->{ok};
315
$status->{conflicts} = delete $status->{need};
316
$status->{message} = "$modname ($status->{have}) conflicts with this distribution";
318
elsif ($type =~ /^(?:\w+_)?recommends$/) {
319
next if $status->{ok};
321
my ($preferred_version, $why, $by_what) = split("/", $spec);
322
$by_what = join(", ", split(",", $by_what));
323
$by_what =~ s/, (\S+)$/ and $1/;
325
$status->{message} = (!ref($status->{have}) && $status->{have} eq '<none>'
326
? "Optional prerequisite $modname is not installed"
327
: "$modname ($status->{have}) is installed, but we prefer to have $preferred_version");
329
$status->{message} .= "\n (wanted for $why, used by $by_what)";
331
my $installed = $self->install_optional($modname, $preferred_version, $status->{message});
332
next if $installed eq 'ok';
333
$status->{message} = $installed unless $installed eq 'skip';
335
elsif ($type =~ /^feature_requires/) {
336
next if $status->{ok};
339
next if $status->{ok};
341
my $installed = $self->install_required($modname, $spec, $status->{message});
342
next if $installed eq 'ok';
343
$status->{message} = $installed;
346
$out->{$type}{$modname} = $status;
351
return keys %{$out} ? $out : return;
354
# install an external module using CPAN prior to testing and installation
355
# should only be called by install_required or install_optional
357
my ($self, $desired, $version) = @_;
359
if ($self->under_cpan) {
360
# Just add to the required hash, which CPAN >= 1.81 will check prior
362
$self->{properties}{requires}->{$desired} = $version;
363
$self->log_info(" I'll get CPAN to prepend the installation of this\n");
367
# Here we use CPAN to actually install the desired module, the benefit
368
# being we continue even if installation fails, and that this works
369
# even when not using CPAN to install.
373
# Save this because CPAN will chdir all over the place.
374
my $cwd = Cwd::cwd();
376
CPAN::Shell->install($desired);
378
if (CPAN::Shell->expand("Module", $desired)->uptodate) {
379
$self->log_info("\n\n*** (back in Bioperl Build.PL) ***\n * You chose to install $desired and it installed fine\n");
383
$self->log_info("\n\n*** (back in Bioperl Build.PL) ***\n");
384
$msg = "You chose to install $desired but it failed to install";
387
chdir $cwd or die "Cannot chdir() back to $cwd: $!";
392
# install required modules listed in 'requires' or 'build_requires' arg to
393
# new that weren't already installed. Should only be called by prereq_failures
394
sub install_required {
395
my ($self, $desired, $version, $msg) = @_;
397
$self->log_info(" - ERROR: $msg\n");
399
return $self->install_prereq($desired, $version);
402
# install optional modules listed in 'recommends' arg to new that weren't
403
# already installed. Should only be called by prereq_failures
404
sub install_optional {
405
my ($self, $desired, $version, $msg) = @_;
407
unless (defined $self->{ask_optional}) {
408
$self->{ask_optional} = $self->prompt("Install [a]ll optional external modules, [n]one, or choose [i]nteractively?", 'n');
410
return 'skip' if $self->{ask_optional} =~ /^n/i;
413
if ($self->{ask_optional} =~ /^a/i) {
414
$self->log_info(" * $msg\n");
418
$install = $self->y_n(" * $msg\n Do you want to install it? y/n", 'n');
422
return $self->install_prereq($desired, $version);
425
$self->log_info(" * You chose not to install $desired\n");
430
# there's no official way to discover if being run by CPAN, we take an approach
431
# similar to that of Module::AutoInstall
435
unless (defined $self->{under_cpan}) {
436
## modified from Module::AutoInstall
440
if ($CPAN::HandleConfig::VERSION) {
441
# Newer versions of CPAN have a HandleConfig module
442
CPAN::HandleConfig->load;
445
# Older versions had the load method in Config directly
449
# Find the CPAN lock-file
450
my $lock = File::Spec->catfile($CPAN::Config->{cpan_home}, '.lock');
452
# Module::AutoInstall now goes on to open the lock file and compare
453
# its pid to ours, but we're not in a situation where we expect
454
# the pids to match, so we take the windows approach for all OSes:
455
# find out if we're in cpan_home
456
my $cwd = File::Spec->canonpath(Cwd::cwd());
457
my $cpan = File::Spec->canonpath($CPAN::Config->{cpan_home});
459
$self->{under_cpan} = index($cwd, $cpan) > -1;
462
if ($self->{under_cpan}) {
463
$self->log_info("(I think I'm being run by CPAN, so will rely on CPAN to handle prerequisite installation)\n");
466
$self->log_info("(I think you ran Build.PL directly, so will use CPAN to install prerequisites on demand)\n");
467
$self->{under_cpan} = 0;
471
return $self->{under_cpan};
474
# overridden simply to not print the default answer if chosen by hitting return
477
my $mess = shift or die "prompt() called without a prompt message";
480
if ( $self->_is_unattended && !@_ ) {
482
ERROR: This build seems to be unattended, but there is no default value
483
for this question. Aborting.
487
($def, my $dispdef) = defined $def ? ($def, "[$def] ") : ('', ' ');
490
print "$mess $dispdef";
492
my $ans = $self->_readline();
494
if ( !defined($ans) # Ctrl-D or unattended
495
or !length($ans) ) { # User hit return
496
#print "$def\n"; didn't like this!
503
# like the Module::Build version, except that we always get version from
505
sub find_dist_packages {
508
# Only packages in .pm files are candidates for inclusion here.
509
# Only include things in the MANIFEST, not things in developer's
512
my $manifest = $self->_read_manifest('MANIFEST') or die "Can't find dist packages without a MANIFEST file - run 'manifest' action first";
515
my %dist_files = map { $self->localize_file_path($_) => $_ } keys %$manifest;
517
my @pm_files = grep {exists $dist_files{$_}} keys %{ $self->find_pm_files };
519
my $actual_version = $self->dist_version;
521
# First, we enumerate all packages & versions,
522
# seperating into primary & alternative candidates
524
foreach my $file (@pm_files) {
525
next if $dist_files{$file} =~ m{^t/}; # Skip things in t/
527
my @path = split( /\//, $dist_files{$file} );
528
(my $prime_package = join( '::', @path[1..$#path] )) =~ s/\.pm$//;
530
my $pm_info = Module::Build::ModuleInfo->new_from_file( $file );
532
foreach my $package ( $pm_info->packages_inside ) {
533
next if $package eq 'main'; # main can appear numerous times, ignore
534
next if grep /^_/, split( /::/, $package ); # private package, ignore
536
my $version = $pm_info->version( $package );
537
if ($version && $version != $actual_version) {
538
$self->log_warn("Package $package had version $version!\n");
540
$version = $actual_version;
542
if ( $package eq $prime_package ) {
543
if ( exists( $prime{$package} ) ) {
544
# M::B::ModuleInfo will handle this conflict
545
die "Unexpected conflict in '$package'; multiple versions found.\n";
548
$prime{$package}{file} = $dist_files{$file};
549
$prime{$package}{version} = $version if defined( $version );
553
push( @{$alt{$package}}, { file => $dist_files{$file}, version => $version } );
558
# Then we iterate over all the packages found above, identifying conflicts
559
# and selecting the "best" candidate for recording the file & version
561
foreach my $package ( keys( %alt ) ) {
562
my $result = $self->_resolve_module_versions( $alt{$package} );
564
if ( exists( $prime{$package} ) ) { # primary package selected
565
if ( $result->{err} ) {
566
# Use the selected primary package, but there are conflicting
567
# errors amoung multiple alternative packages that need to be
569
$self->log_warn("Found conflicting versions for package '$package'\n" .
570
" $prime{$package}{file} ($prime{$package}{version})\n" . $result->{err});
572
elsif ( defined( $result->{version} ) ) {
573
# There is a primary package selected, and exactly one
574
# alternative package
576
if ( exists( $prime{$package}{version} ) && defined( $prime{$package}{version} ) ) {
577
# Unless the version of the primary package agrees with the
578
# version of the alternative package, report a conflict
579
if ( $self->compare_versions( $prime{$package}{version}, '!=', $result->{version} ) ) {
580
$self->log_warn("Found conflicting versions for package '$package'\n" .
581
" $prime{$package}{file} ($prime{$package}{version})\n" .
582
" $result->{file} ($result->{version})\n");
586
# The prime package selected has no version so, we choose to
587
# use any alternative package that does have a version
588
$prime{$package}{file} = $result->{file};
589
$prime{$package}{version} = $result->{version};
593
# no alt package found with a version, but we have a prime
594
# package so we use it whether it has a version or not
597
else { # No primary package was selected, use the best alternative
598
if ( $result->{err} ) {
599
$self->log_warn("Found conflicting versions for package '$package'\n" . $result->{err});
602
# Despite possible conflicting versions, we choose to record
603
# something rather than nothing
604
$prime{$package}{file} = $result->{file};
605
$prime{$package}{version} = $result->{version} if defined( $result->{version} );
610
for (grep exists $_->{version}, values %prime) {
611
$_->{version} = $_->{version}->stringify if ref($_->{version});
617
# our recommends syntax contains extra info that needs to be ignored at this
619
sub _parse_conditions {
620
my ($self, $spec) = @_;
622
($spec) = split("/", $spec);
624
if ($spec =~ /^\s*([\w.]+)\s*$/) { # A plain number, maybe with dots, letters, and underscores
628
return split /\s*,\s*/, $spec;
632
# when generating META.yml, we output optional_features syntax (instead of
633
# recommends syntax). Note that as of CPAN v1.8802 nothing useful is done
634
# with this information, which is why we implement our own request to install
635
# the optional modules in install_optional()
636
sub prepare_metadata {
637
my ($self, $node, $keys) = @_;
638
my $p = $self->{properties};
640
# A little helper sub
642
my ($name, $val) = @_;
643
$node->{$name} = $val;
644
push @$keys, $name if $keys;
647
foreach (qw(dist_name dist_version dist_author dist_abstract license)) {
648
(my $name = $_) =~ s/^dist_//;
649
$add_node->($name, $self->$_());
650
die "ERROR: Missing required field '$_' for META.yml\n" unless defined($node->{$name}) && length($node->{$name});
652
$node->{version} = '' . $node->{version}; # Stringify version objects
654
if (defined( $self->license ) && defined( my $url = $self->valid_licenses->{ $self->license } )) {
655
$node->{resources}{license} = $url;
658
foreach ( @{$self->prereq_action_types} ) {
659
if (exists $p->{$_} and keys %{ $p->{$_} }) {
660
if ($_ eq 'recommends') {
662
while (my ($req, $val) = each %{ $p->{$_} }) {
663
my ($ver, $why, $used_by) = split("/", $val);
665
$info->{description} = $why;
666
$info->{requires} = { $req => $ver };
667
$hash->{$used_by} = $info;
669
$add_node->('optional_features', $hash);
672
$add_node->($_, $p->{$_});
677
if (exists $p->{dynamic_config}) {
678
$add_node->('dynamic_config', $p->{dynamic_config});
680
my $pkgs = eval { $self->find_dist_packages };
682
$self->log_warn("$@\nWARNING: Possible missing or corrupt 'MANIFEST' file.\n" . "Nothing to enter for 'provides' field in META.yml\n");
685
$node->{provides} = $pkgs if %$pkgs;
688
if (exists $p->{no_index}) {
689
$add_node->('no_index', $p->{no_index});
692
$add_node->('generated_by', "Module::Build version $Module::Build::VERSION");
694
$add_node->('meta-spec',
696
url => 'http://module-build.sourceforge.net/META-spec-v1.2.html',
699
while (my($k, $v) = each %{$self->meta_add}) {
703
while (my($k, $v) = each %{$self->meta_merge}) {
704
$self->_hash_merge($node, $k, $v);
710
# let us store extra things persistently in _build
713
$self = $self->SUPER::_construct(@_);
715
my ($p, $ph) = ($self->{properties}, $self->{phash});
717
foreach (qw(manifest_skip post_install_scripts)) {
718
my $file = File::Spec->catfile($self->config_dir, $_);
719
$ph->{$_} = Module::Build::Notes->new(file => $file);
720
$ph->{$_}->restore if -e $file;
727
$self->SUPER::write_config;
730
$self->{phash}{$_}->write() foreach qw(manifest_skip post_install_scripts);
732
# be even more certain we can reload ourselves during a resume by copying
733
# ourselves to _build\lib
734
my $filename = File::Spec->catfile($self->{properties}{config_dir}, 'lib', 'ModuleBuildBioperl.pm');
735
my $filedir = File::Basename::dirname($filename);
737
File::Path::mkpath($filedir);
738
warn "Can't create directory $filedir: $!" unless -d $filedir;
740
File::Copy::copy('ModuleBuildBioperl.pm', $filename);
741
warn "Unable to copy 'ModuleBuildBioperl.pm' to '$filename'\n" unless -e $filename;
744
# add a file to the default MANIFEST.SKIP
745
sub add_to_manifest_skip {
747
my %files = map {$self->localize_file_path($_), 1} @_;
748
$self->{phash}{manifest_skip}->write(\%files);
751
# we always generate a new MANIFEST and MANIFEST.SKIP here, instead of allowing
752
# existing files to remain
753
sub ACTION_manifest {
756
my $maniskip = 'MANIFEST.SKIP';
757
if ( -e 'MANIFEST' || -e $maniskip ) {
758
$self->log_warn("MANIFEST files already exist, will overwrite them\n");
762
$self->_write_default_maniskip($maniskip);
764
require ExtUtils::Manifest; # ExtUtils::Manifest is not warnings clean.
765
local ($^W, $ExtUtils::Manifest::Quiet) = (0,1);
766
ExtUtils::Manifest::mkmanifest();
769
# extended to add extra things to the default MANIFEST.SKIP
770
sub _write_default_maniskip {
772
$self->SUPER::_write_default_maniskip;
774
my @extra = keys %{$self->{phash}{manifest_skip}->read};
776
open(my $fh, '>>', 'MANIFEST.SKIP') or die "Could not open MANIFEST.SKIP file\n";
777
print $fh "\n# Avoid additional run-time generated things\n";
778
foreach my $line (@extra) {
779
print $fh $line, "\n";
785
# extended to run scripts post-installation
788
require ExtUtils::Install;
789
$self->depends_on('build');
790
ExtUtils::Install::install($self->install_map, !$self->quiet, 0, $self->{args}{uninst}||0);
791
$self->run_post_install_scripts;
793
sub add_post_install_script {
795
my %files = map {$self->localize_file_path($_), 1} @_;
796
$self->{phash}{post_install_scripts}->write(\%files);
798
sub run_post_install_scripts {
800
my @scripts = keys %{$self->{phash}{post_install_scripts}->read};
801
foreach my $script (@scripts) {
802
$self->run_perl_script($script);
806
# for use with auto_features, which should require LWP::UserAgent as one of
809
eval {require LWP::UserAgent;};
811
# ideally this won't happen because auto_feature already specified
812
# LWP::UserAgent, so this sub wouldn't get called if LWP not installed
813
return "LWP::UserAgent not installed";
815
my $ua = LWP::UserAgent->new;
818
my $response = $ua->get('http://search.cpan.org/');
819
unless ($response->is_success) {
820
return "Could not connect to the internet (http://search.cpan.org/)";
825
# nice directory names for dist-related actions
828
my $version = $self->dist_version;
829
if ($version =~ /^\d\.\d{6}\d$/) {
830
# 1.x.x.100 returned as 1.x.x.1
833
$version =~ s/00(\d)/$1./g;
836
if (my ($minor, $rev) = $version =~ /^\d\.(\d)\.\d\.(\d+)$/) {
837
my $dev = ! ($minor % 2 == 0);
839
my $replace = $dev ? "_$rev" : '';
840
$version =~ s/\.\d+$/$replace/;
843
$rev = sprintf("%03d", $rev);
844
$version =~ s/\.\d+$/_$rev-RC/;
847
$rev -= 100 unless $dev;
848
my $replace = $dev ? "_$rev" : ".$rev";
849
$version =~ s/\.\d+$/$replace/;
853
return "$self->{properties}{dist_name}-$version";
857
return $self->dist_dir.'-ppm';
860
# generate complete ppd4 version file
864
my $file = $self->make_ppd(%{$self->{args}});
865
$self->add_to_cleanup($file);
866
$self->add_to_manifest_skip($file);
869
# add pod2htm temp files to MANIFEST.SKIP, generated during ppmdist most likely
872
$self->SUPER::htmlify_pods(@_);
873
$self->add_to_manifest_skip('pod2htm*');
876
# don't copy across man3 docs since they're of little use under Windows and
880
my @types = $self->install_types(1);
881
$self->SUPER::ACTION_ppmdist(@_);
882
$self->install_types(0);
885
# when supplied a true value, pretends libdoc doesn't exist (preventing man3
886
# installation for ppmdist). when supplied false, they exist again
888
my ($self, $no_libdoc) = @_;
889
$self->{no_libdoc} = $no_libdoc if defined $no_libdoc;
890
my @types = $self->SUPER::install_types;
891
if ($self->{no_libdoc}) {
893
foreach my $type (@types) {
894
push(@altered_types, $type) unless $type eq 'libdoc';
896
return @altered_types;
901
# overridden from Module::Build::PPMMaker for ppd4 compatability
903
my ($self, %args) = @_;
905
require Module::Build::PPMMaker;
906
my $mbp = Module::Build::PPMMaker->new();
909
foreach my $info (qw(name author abstract version)) {
910
my $method = "dist_$info";
911
$dist{$info} = $self->$method() or die "Can't determine distribution's $info\n";
913
$dist{codebase} = $self->ppm_name.'.tar.gz';
914
$mbp->_simple_xml_escape($_) foreach $dist{abstract}, $dist{codebase}, @{$dist{author}};
916
my (undef, undef, undef, $mday, $mon, $year) = localtime();
919
my $date = "$year-$mon-$mday";
921
my $softpkg_version = $self->dist_dir;
922
$softpkg_version =~ s/^$dist{name}-//;
924
# to avoid a ppm bug, instead of including the requires in the softpackage
925
# for the distribution we're making, we'll make a seperate Bundle::
926
# softpackage that contains all the requires, and require only the Bundle in
927
# the real softpackage
928
my ($bundle_name) = $dist{name} =~ /^.+-(.+)/;
929
$bundle_name ||= 'core';
930
$bundle_name =~ s/^(\w)/\U$1/;
931
my $bundle_dir = "Bundle-BioPerl-$bundle_name-$softpkg_version-ppm";
932
my $bundle_file = "$bundle_dir.tar.gz";
933
my $bundle_softpkg_name = "Bundle-BioPerl-$bundle_name";
934
$bundle_name = "Bundle::BioPerl::$bundle_name";
938
<SOFTPKG NAME=\"$dist{name}\" VERSION=\"$softpkg_version\" DATE=\"$date\">
939
<TITLE>$dist{name}</TITLE>
940
<ABSTRACT>$dist{abstract}</ABSTRACT>
941
@{[ join "\n", map " <AUTHOR>$_</AUTHOR>", @{$dist{author}} ]}
942
<PROVIDE NAME=\"$dist{name}::\" VERSION=\"$dist{version}\"/>
946
foreach my $pm (@{$self->rscan_dir('Bio', qr/\.pm$/)}) {
947
# convert these filepaths to Module names
951
$ppd .= sprintf(<<'EOF', $pm, $dist{version});
952
<PROVIDE NAME="%s" VERSION="%s"/>
959
<ARCHITECTURE NAME=\"MSWin32-x86-multi-thread-5.8\"/>
960
<CODEBASE HREF=\"$dist{codebase}\"/>
961
<REQUIRE NAME=\"$bundle_name\" VERSION=\"$dist{version}\"/>
966
# now a new softpkg for the bundle
969
<SOFTPKG NAME=\"$bundle_softpkg_name\" VERSION=\"$softpkg_version\" DATE=\"$date\">
970
<TITLE>$bundle_name</TITLE>
971
<ABSTRACT>Bundle of pre-requisites for $dist{name}</ABSTRACT>
972
@{[ join "\n", map " <AUTHOR>$_</AUTHOR>", @{$dist{author}} ]}
973
<PROVIDE NAME=\"$bundle_name\" VERSION=\"$dist{version}\"/>
975
<ARCHITECTURE NAME=\"MSWin32-x86-multi-thread-5.8\"/>
976
<CODEBASE HREF=\"$bundle_file\"/>
980
# we do both requires and recommends to make installation on Windows as
981
# easy (mindless) as possible
982
for my $type ('requires', 'recommends') {
983
my $prereq = $self->$type;
984
while (my ($modname, $version) = each %$prereq) {
985
next if $modname eq 'perl';
986
($version) = split("/", $version) if $version =~ /\//;
988
# Module names must have at least one ::
989
unless ($modname =~ /::/) {
993
# Bio::Root::Version number comes out as triplet number like 1.5.2;
994
# convert to our own version
995
if ($modname eq 'Bio::Root::Version') {
996
$version = $dist{version};
999
$ppd .= sprintf(<<'EOF', $modname, $version || '');
1000
<REQUIRE NAME="%s" VERSION="%s"/>
1011
my $ppd_file = "$dist{name}.ppd";
1012
my $fh = IO::File->new(">$ppd_file") or die "Cannot write to $ppd_file: $!";
1016
$self->delete_filetree($bundle_dir);
1017
mkdir($bundle_dir) or die "Cannot create '$bundle_dir': $!";
1018
$self->make_tarball($bundle_dir);
1019
$self->delete_filetree($bundle_dir);
1020
$self->add_to_cleanup($bundle_file);
1021
$self->add_to_manifest_skip($bundle_file);
1026
# we make all archive formats we want, not just .tar.gz
1027
# we also auto-run manifest action, since we always want to re-create
1028
# MANIFEST and MANIFEST.SKIP just-in-time
1032
$self->depends_on('manifest');
1033
$self->depends_on('distdir');
1035
my $dist_dir = $self->dist_dir;
1037
$self->make_zip($dist_dir);
1038
$self->make_tarball($dist_dir);
1039
$self->delete_filetree($dist_dir);
1042
# makes zip file for windows users and bzip2 files as well
1044
my ($self, $dir, $file) = @_;
1047
$self->log_info("Creating $file.zip\n");
1048
my $zip_flags = $self->verbose ? '-r' : '-rq';
1049
$self->do_system($self->split_like_shell("zip"), $zip_flags, "$file.zip", $dir);
1051
$self->log_info("Creating $file.bz2\n");
1052
require Archive::Tar;
1053
# Archive::Tar versions >= 1.09 use the following to enable a compatibility
1054
# hack so that the resulting archive is compatible with older clients.
1055
$Archive::Tar::DO_NOT_USE_PREFIX = 0;
1056
my $files = $self->rscan_dir($dir);
1057
Archive::Tar->create_archive("$file.tar", 0, @$files);
1058
$self->do_system($self->split_like_shell("bzip2"), "-k", "$file.tar");