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 package ModuleBuildBioperl
;
14 # we really need Module::Build to be installed
15 unless (eval "use Module::Build; 1") {
16 print "This package requires Module::Build to install itself.\n";
18 require ExtUtils
::MakeMaker
;
19 my $yn = ExtUtils
::MakeMaker
::prompt
(' Install Module::Build now from CPAN?', 'y');
21 unless ($yn =~ /^y/i) {
22 die " *** Cannot install without Module::Build. Exiting ...\n";
30 # Save this because CPAN will chdir all over the place.
33 my $build_pl = File
::Spec
->catfile($cwd, "Build.PL");
35 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
36 CPAN
::Shell
->install('Module::Build');
37 File
::Copy
::move
($build_pl."hidden", $build_pl);
38 CPAN
::Shell
->expand("Module", "Module::Build")->uptodate or die "Couldn't install Module::Build, giving up.\n";
40 chdir $cwd or die "Cannot chdir() back to $cwd: $!";
43 eval "use base Module::Build; 1" or die $@
;
45 # ensure we'll be able to reload this module later by adding its path to inc
53 our $VERSION = 1.005002005;
54 our @extra_types = qw(options test excludes_os);
55 our $checking_types = "requires|conflicts|".join("|", @extra_types);
58 # our modules are in Bio, not lib
61 foreach my $pm (@
{$self->rscan_dir('Bio', qr/\.pm$/)}) {
62 $self->{properties
}{pm_files
}->{$pm} = File
::Spec
->catfile('lib', $pm);;
65 $self->_find_file_by_type('pm', 'lib');
68 # ask what scripts to install (this method is unique to bioperl)
72 # we can offer interactive installation by groups only if we have subdirs
73 # in scripts and no .PLS files there
74 opendir(my $scripts_dir, 'scripts') or die "Can't open directory 'scripts': $!\n";
77 while (my $thing = readdir($scripts_dir)) {
78 next if $thing =~ /^\./;
79 next if $thing eq 'CVS';
80 if ($thing =~ /PLS$|pl$/) {
84 $thing = File
::Spec
->catfile('scripts', $thing);
87 push(@group_dirs, $thing);
90 closedir($scripts_dir);
91 my $question = $int_ok ?
"Install [a]ll Bioperl scripts, [n]one, or choose groups [i]nteractively?" : "Install [a]ll Bioperl scripts or [n]one?";
93 my $prompt = $self->prompt($question, 'a');
95 if ($prompt =~ /^[aA]/) {
96 $self->log_info(" - will install all scripts\n");
97 $self->notes(chosen_scripts
=> 'all');
99 elsif ($prompt =~ /^[iI]/) {
100 $self->log_info(" - will install interactively:\n");
103 foreach my $group_dir (@group_dirs) {
104 my $group = File
::Basename
::basename
($group_dir);
105 print " * group '$group' has:\n";
107 my @script_files = @
{$self->rscan_dir($group_dir, qr/\.PLS$|\.pl$/)};
108 foreach my $script_file (@script_files) {
109 my $script = File
::Basename
::basename
($script_file);
113 my $result = $self->prompt(" Install scripts for group '$group'? [y]es [n]o [q]uit", 'n');
114 die if $result =~ /^[qQ]/;
115 if ($result =~ /^[yY]/) {
116 $self->log_info(" + will install group '$group'\n");
117 push(@chosen_scripts, @script_files);
120 $self->log_info(" - will not install group '$group'\n");
124 my $chosen_scripts = @chosen_scripts ?
join("|", @chosen_scripts) : 'none';
126 $self->notes(chosen_scripts
=> $chosen_scripts);
129 $self->log_info(" - won't install any scripts\n");
130 $self->notes(chosen_scripts
=> 'none');
136 # our version of script_files doesn't take args but just installs those scripts
137 # requested by the user after choose_scripts() is called. If it wasn't called,
138 # installs all scripts in scripts directory
142 my $chosen_scripts = $self->notes('chosen_scripts');
143 if ($chosen_scripts) {
144 return if $chosen_scripts eq 'none';
145 return { map {$_, 1} split(/\|/, $chosen_scripts) } unless $chosen_scripts eq 'all';
148 return $_ = { map {$_,1} @
{$self->rscan_dir('scripts', qr/\.PLS$|\.pl$/)} };
151 # process scripts normally, except that we change name from *.PLS to bp_*.pl
152 sub process_script_files
{
154 my $files = $self->find_script_files;
155 return unless keys %$files;
157 my $script_dir = File
::Spec
->catdir($self->blib, 'script');
158 File
::Path
::mkpath
( $script_dir );
160 foreach my $file (keys %$files) {
161 my $result = $self->copy_if_modified($file, $script_dir, 'flatten') or next;
162 $self->fix_shebang_line($result) unless $self->os_type eq 'VMS';
163 $self->make_executable($result);
165 my $final = File
::Basename
::basename
($result);
166 $final =~ s/\.PLS$/\.pl/; # change from .PLS to .pl
167 $final =~ s/^/bp_/ unless $final =~ /^bp/; # add the "bp" prefix
168 $final = File
::Spec
->catfile($script_dir, $final);
169 $self->log_info("$result -> $final\n");
170 File
::Copy
::move
($result, $final) or die "Can't rename '$result' to '$final': $!";
174 # extended to handle extra checking types
177 my $ph = $self->{phash
};
181 if ($ph->{features
}->exists($key)) {
182 return $ph->{features
}->access($key, @_);
185 if (my $info = $ph->{auto_features
}->access($key)) {
186 my $failures = $self->prereq_failures($info);
187 my $disabled = grep( /^(?:\w+_)?(?:$checking_types)$/, keys %$failures ) ?
1 : 0;
191 return $ph->{features
}->access($key, @_);
194 # No args - get the auto_features & overlay the regular features
196 my %auto_features = $ph->{auto_features
}->access();
197 while (my ($name, $info) = each %auto_features) {
198 my $failures = $self->prereq_failures($info);
199 my $disabled = grep( /^(?:\w+_)?(?:$checking_types)$/, keys %$failures ) ?
1 : 0;
200 $features{$name} = $disabled ?
0 : 1;
202 %features = (%features, $ph->{features
}->access());
204 return wantarray ?
%features : \
%features;
206 *feature
= \
&features
;
208 # overridden to fix a stupid bug in Module::Build and extended to handle extra
210 sub check_autofeatures
{
212 my $features = $self->auto_features;
214 return unless %$features;
216 $self->log_info("Checking features:\n");
218 my $max_name_len = 0; # this wasn't set to 0 in Module::Build, causing warning in next line
219 $max_name_len = ( length($_) > $max_name_len ) ?
length($_) : $max_name_len for keys %$features;
221 while (my ($name, $info) = each %$features) {
222 $self->log_info(" $name" . '.' x
($max_name_len - length($name) + 4));
223 if ($name eq 'PL_files') {
224 print "got $name => $info\n";
226 while (my ($key, $val) = each %$info) {
227 print " $key => $val\n";
231 if ( my $failures = $self->prereq_failures($info) ) {
232 my $disabled = grep( /^(?:\w+_)?(?:$checking_types)$/, keys %$failures ) ?
1 : 0;
233 $self->log_info( $disabled ?
"disabled\n" : "enabled\n" );
236 while (my ($type, $prereqs) = each %$failures) {
237 while (my ($module, $status) = each %$prereqs) {
238 my $required = ($type =~ /^(?:\w+_)?(?:requires|conflicts)$/) ?
1 : 0;
239 my $prefix = ($required) ?
'-' : '*';
240 $log_text .= " $prefix $status->{message}\n";
243 $self->log_warn($log_text) if $log_text && ! $self->quiet;
246 $self->log_info("enabled\n");
250 $self->log_info("\n");
253 # extend to handle option checking (which takes an array ref) and code test
254 # checking (which takes a code ref and must return a message only on failure)
255 # and excludes_os (which takes an array ref of regexps).
256 # also handles more informative output of recommends section
257 sub prereq_failures
{
258 my ($self, $info) = @_;
260 my @types = (@
{ $self->prereq_action_types }, @extra_types);
261 $info ||= {map {$_, $self->$_()} @types};
264 foreach my $type (@types) {
265 my $prereqs = $info->{$type} || next;
268 if ($type eq 'test') {
269 unless (keys %$out) {
270 $status->{message
} = &{$prereqs};
271 $out->{$type}{'test'} = $status if $status->{message
};
274 elsif ($type eq 'options') {
276 foreach my $wanted_option (@
{$prereqs}) {
277 unless ($self->args($wanted_option)) {
278 push(@not_ok, $wanted_option);
283 $status->{message
} = "Command line option(s) '@not_ok' not supplied";
284 $out->{$type}{'options'} = $status;
287 elsif ($type eq 'excludes_os') {
288 foreach my $os (@
{$prereqs}) {
290 $status->{message
} = "This feature isn't supported under your OS ($os)";
291 $out->{$type}{'excludes_os'} = $status;
297 while ( my ($modname, $spec) = each %$prereqs ) {
298 $status = $self->check_installed_status($modname, $spec);
300 if ($type =~ /^(?:\w+_)?conflicts$/) {
301 next if !$status->{ok
};
302 $status->{conflicts
} = delete $status->{need
};
303 $status->{message
} = "$modname ($status->{have}) conflicts with this distribution";
305 elsif ($type =~ /^(?:\w+_)?recommends$/) {
306 next if $status->{ok
};
308 my ($preferred_version, $why, $by_what) = split("/", $spec);
309 $by_what = join(", ", split(",", $by_what));
310 $by_what =~ s/, (\S+)$/ and $1/;
312 $status->{message
} = (!ref($status->{have
}) && $status->{have
} eq '<none>'
313 ?
"Optional prerequisite $modname is not installed"
314 : "$modname ($status->{have}) is installed, but we prefer to have $preferred_version");
316 $status->{message
} .= "\n (wanted for $why, used by $by_what)";
318 my $installed = $self->install_optional($modname, $preferred_version, $status->{message
});
319 next if $installed eq 'ok';
320 $status->{message
} = $installed unless $installed eq 'skip';
323 next if $status->{ok
};
326 $out->{$type}{$modname} = $status;
331 return keys %{$out} ?
$out : return;
334 # install optional modules listed in 'recommends' arg to new that weren't
335 # already installed. Should only be called by prereq_failures
336 sub install_optional
{
337 my ($self, $desired, $version, $msg) = @_;
339 unless (defined $self->{ask_optional
}) {
340 $self->{ask_optional
} = $self->prompt("Install [a]ll optional external modules, [n]one, or choose [i]nteractively?", 'n');
342 return 'skip' if $self->{ask_optional
} =~ /^n/i;
345 if ($self->{ask_optional
} =~ /^a/i) {
346 $self->log_info(" * $msg\n");
350 $install = $self->y_n(" * $msg\n Do you want to install it? y/n", 'n');
354 # Here we use CPAN to actually install the desired module, the benefit
355 # being we continue even if installation fails, and that this works
356 # even when not using CPAN to install.
358 # The alternative would be to simply append the module to 'requires'
359 # and let CPAN deal with required modules in the normal way, but
360 # older CPANs don't do that (look only at META.yml), and we get
361 # total failure for something that was only optional
365 # Save this because CPAN will chdir all over the place.
366 my $cwd = Cwd
::cwd
();
368 CPAN
::Shell
->install($desired);
370 if (CPAN
::Shell
->expand("Module", $desired)->uptodate) {
371 $self->log_info("\n\n*** (back in Bioperl Build.PL) ***\n * You chose to install $desired and it installed fine\n");
375 $self->log_info("\n\n*** (back in Bioperl Build.PL) ***\n");
376 $msg = "You chose to install $desired but it failed to install";
379 chdir $cwd or die "Cannot chdir() back to $cwd: $!";
383 $self->log_info(" * You chose not to install $desired\n");
388 # overridden simply to not print the default answer if chosen by hitting return
391 my $mess = shift or die "prompt() called without a prompt message";
394 if ( $self->_is_unattended && !@_ ) {
396 ERROR: This build seems to be unattended, but there is no default value
397 for this question. Aborting.
401 ($def, my $dispdef) = defined $def ?
($def, "[$def] ") : ('', ' ');
404 print "$mess $dispdef";
406 my $ans = $self->_readline();
408 if ( !defined($ans) # Ctrl-D or unattended
409 or !length($ans) ) { # User hit return
410 #print "$def\n"; didn't like this!
417 # like the Module::Build version, except that we always get version from
419 sub find_dist_packages
{
422 # Only packages in .pm files are candidates for inclusion here.
423 # Only include things in the MANIFEST, not things in developer's
426 my $manifest = $self->_read_manifest('MANIFEST') or die "Can't find dist packages without a MANIFEST file - run 'manifest' action first";
429 my %dist_files = map { $self->localize_file_path($_) => $_ } keys %$manifest;
431 my @pm_files = grep {exists $dist_files{$_}} keys %{ $self->find_pm_files };
433 my $actual_version = $self->dist_version;
435 # First, we enumerate all packages & versions,
436 # seperating into primary & alternative candidates
438 foreach my $file (@pm_files) {
439 next if $dist_files{$file} =~ m{^t/}; # Skip things in t/
441 my @path = split( /\//, $dist_files{$file} );
442 (my $prime_package = join( '::', @path[1..$#path] )) =~ s/\.pm$//;
444 my $pm_info = Module
::Build
::ModuleInfo
->new_from_file( $file );
446 foreach my $package ( $pm_info->packages_inside ) {
447 next if $package eq 'main'; # main can appear numerous times, ignore
448 next if grep /^_/, split( /::/, $package ); # private package, ignore
450 my $version = $pm_info->version( $package );
451 if ($version && $version != $actual_version) {
452 $self->log_warn("Package $package had version $version!\n");
454 $version = $actual_version;
456 if ( $package eq $prime_package ) {
457 if ( exists( $prime{$package} ) ) {
458 # M::B::ModuleInfo will handle this conflict
459 die "Unexpected conflict in '$package'; multiple versions found.\n";
462 $prime{$package}{file
} = $dist_files{$file};
463 $prime{$package}{version
} = $version if defined( $version );
467 push( @
{$alt{$package}}, { file
=> $dist_files{$file}, version
=> $version } );
472 # Then we iterate over all the packages found above, identifying conflicts
473 # and selecting the "best" candidate for recording the file & version
475 foreach my $package ( keys( %alt ) ) {
476 my $result = $self->_resolve_module_versions( $alt{$package} );
478 if ( exists( $prime{$package} ) ) { # primary package selected
479 if ( $result->{err
} ) {
480 # Use the selected primary package, but there are conflicting
481 # errors amoung multiple alternative packages that need to be
483 $self->log_warn("Found conflicting versions for package '$package'\n" .
484 " $prime{$package}{file} ($prime{$package}{version})\n" . $result->{err
});
486 elsif ( defined( $result->{version
} ) ) {
487 # There is a primary package selected, and exactly one
488 # alternative package
490 if ( exists( $prime{$package}{version
} ) && defined( $prime{$package}{version
} ) ) {
491 # Unless the version of the primary package agrees with the
492 # version of the alternative package, report a conflict
493 if ( $self->compare_versions( $prime{$package}{version
}, '!=', $result->{version
} ) ) {
494 $self->log_warn("Found conflicting versions for package '$package'\n" .
495 " $prime{$package}{file} ($prime{$package}{version})\n" .
496 " $result->{file} ($result->{version})\n");
500 # The prime package selected has no version so, we choose to
501 # use any alternative package that does have a version
502 $prime{$package}{file
} = $result->{file
};
503 $prime{$package}{version
} = $result->{version
};
507 # no alt package found with a version, but we have a prime
508 # package so we use it whether it has a version or not
511 else { # No primary package was selected, use the best alternative
512 if ( $result->{err
} ) {
513 $self->log_warn("Found conflicting versions for package '$package'\n" . $result->{err
});
516 # Despite possible conflicting versions, we choose to record
517 # something rather than nothing
518 $prime{$package}{file
} = $result->{file
};
519 $prime{$package}{version
} = $result->{version
} if defined( $result->{version
} );
524 for (grep exists $_->{version
}, values %prime) {
525 $_->{version
} = $_->{version
}->stringify if ref($_->{version
});
531 # our recommends syntax contains extra info that needs to be ignored at this
533 sub _parse_conditions
{
534 my ($self, $spec) = @_;
536 ($spec) = split("/", $spec);
538 if ($spec =~ /^\s*([\w.]+)\s*$/) { # A plain number, maybe with dots, letters, and underscores
542 return split /\s*,\s*/, $spec;
546 # when generating META.yml, we output optional_features syntax (instead of
547 # recommends syntax). Note that as of CPAN v1.8802 nothing useful is done
548 # with this information, which is why we implement our own request to install
549 # the optional modules in install_optional()
550 sub prepare_metadata
{
551 my ($self, $node, $keys) = @_;
552 my $p = $self->{properties
};
554 # A little helper sub
556 my ($name, $val) = @_;
557 $node->{$name} = $val;
558 push @
$keys, $name if $keys;
561 foreach (qw(dist_name dist_version dist_author dist_abstract license)) {
562 (my $name = $_) =~ s/^dist_//;
563 $add_node->($name, $self->$_());
564 die "ERROR: Missing required field '$_' for META.yml\n" unless defined($node->{$name}) && length($node->{$name});
566 $node->{version
} = '' . $node->{version
}; # Stringify version objects
568 if (defined( $self->license ) && defined( my $url = $self->valid_licenses->{ $self->license } )) {
569 $node->{resources
}{license
} = $url;
572 foreach ( @
{$self->prereq_action_types} ) {
573 if (exists $p->{$_} and keys %{ $p->{$_} }) {
574 if ($_ eq 'recommends') {
576 while (my ($req, $val) = each %{ $p->{$_} }) {
577 my ($ver, $why, $used_by) = split("/", $val);
579 $info->{description
} = $why;
580 $info->{requires
} = { $req => $ver };
581 $hash->{$used_by} = $info;
583 $add_node->('optional_features', $hash);
586 $add_node->($_, $p->{$_});
591 if (exists $p->{dynamic_config
}) {
592 $add_node->('dynamic_config', $p->{dynamic_config
});
594 my $pkgs = eval { $self->find_dist_packages };
596 $self->log_warn("$@\nWARNING: Possible missing or corrupt 'MANIFEST' file.\n" . "Nothing to enter for 'provides' field in META.yml\n");
599 $node->{provides
} = $pkgs if %$pkgs;
602 if (exists $p->{no_index
}) {
603 $add_node->('no_index', $p->{no_index
});
606 $add_node->('generated_by', "Module::Build version $Module::Build::VERSION");
608 $add_node->('meta-spec',
610 url
=> 'http://module-build.sourceforge.net/META-spec-v1.2.html',
613 while (my($k, $v) = each %{$self->meta_add}) {
617 while (my($k, $v) = each %{$self->meta_merge}) {
618 $self->_hash_merge($node, $k, $v);
624 # let us store extra things persistently in _build
627 $self = $self->SUPER::_construct
(@_);
629 my ($p, $ph) = ($self->{properties
}, $self->{phash
});
631 foreach (qw(manifest_skip post_install_scripts)) {
632 my $file = File
::Spec
->catfile($self->config_dir, $_);
633 $ph->{$_} = Module
::Build
::Notes
->new(file
=> $file);
634 $ph->{$_}->restore if -e
$file;
641 $self->SUPER::write_config
;
642 $self->{phash
}{$_}->write() foreach qw(manifest_skip post_install_scripts);
645 # add a file to the default MANIFEST.SKIP
646 sub add_to_manifest_skip
{
648 my %files = map {$self->localize_file_path($_), 1} @_;
649 $self->{phash
}{manifest_skip
}->write(\
%files);
652 # we always generate a new MANIFEST and MANIFEST.SKIP here, instead of allowing
653 # existing files to remain
654 sub ACTION_manifest
{
657 my $maniskip = 'MANIFEST.SKIP';
658 if ( -e
'MANIFEST' || -e
$maniskip ) {
659 $self->log_warn("MANIFEST files already exist, will overwrite them\n");
663 $self->_write_default_maniskip($maniskip);
665 require ExtUtils
::Manifest
; # ExtUtils::Manifest is not warnings clean.
666 local ($^W
, $ExtUtils::Manifest
::Quiet
) = (0,1);
667 ExtUtils
::Manifest
::mkmanifest
();
670 # extended to add extra things to the default MANIFEST.SKIP
671 sub _write_default_maniskip
{
673 $self->SUPER::_write_default_maniskip
;
675 my @extra = keys %{$self->{phash
}{manifest_skip
}->read};
677 open(my $fh, '>>', 'MANIFEST.SKIP') or die "Could not open MANIFEST.SKIP file\n";
678 print $fh "\n# Avoid additional run-time generated things\n";
679 foreach my $line (@extra) {
680 print $fh $line, "\n";
686 # extended to run scripts post-installation
689 require ExtUtils
::Install
;
690 $self->depends_on('build');
691 ExtUtils
::Install
::install
($self->install_map, !$self->quiet, 0, $self->{args
}{uninst
}||0);
692 $self->run_post_install_scripts;
694 sub add_post_install_script
{
696 my %files = map {$self->localize_file_path($_), 1} @_;
697 $self->{phash
}{post_install_scripts
}->write(\
%files);
699 sub run_post_install_scripts
{
701 my @scripts = keys %{$self->{phash
}{post_install_scripts
}->read};
702 foreach my $script (@scripts) {
703 $self->run_perl_script($script);
707 # for use with auto_features, which needs to require LWP::UserAgent as one of
710 eval {require LWP
::UserAgent
;}; # if not installed, this sub won't actually be called
711 my $ua = LWP
::UserAgent
->new;
714 my $response = $ua->get('http://search.cpan.org/');
715 unless ($response->is_success) {
716 return "Could not connect to the internet (http://search.cpan.org/)";
721 # nice directory names for dist-related actions
724 my $version = $self->dist_version;
725 if ($version =~ /^\d\.\d{6}\d$/) {
726 # 1.x.x.100 returned as 1.x.x.1
729 $version =~ s/00(\d)/$1./g;
732 if (my ($minor, $rev) = $version =~ /^\d\.(\d)\.\d\.(\d+)$/) {
733 my $dev = ! ($minor % 2 == 0);
735 my $replace = $dev ?
"_$rev" : '';
736 $version =~ s/\.\d+$/$replace/;
739 $rev = sprintf("%03d", $rev);
740 $version =~ s/\.\d+$/_$rev-RC/;
743 $rev -= 100 unless $dev;
744 my $replace = $dev ?
"_$rev" : ".$rev";
745 $version =~ s/\.\d+$/$replace/;
749 return "$self->{properties}{dist_name}-$version";
753 return $self->dist_dir.'-ppm';
756 # we make all archive formats we want, not just .tar.gz
757 # we also auto-run manifest action, since we always want to re-create
758 # MANIFEST and MANIFEST.SKIP just-in-time
762 $self->depends_on('manifest');
763 $self->depends_on('distdir');
765 my $dist_dir = $self->dist_dir;
767 $self->make_zip($dist_dir);
768 $self->make_tarball($dist_dir);
769 $self->delete_filetree($dist_dir);
772 # makes zip file for windows users and bzip2 files as well
774 my ($self, $dir, $file) = @_;
777 $self->log_info("Creating $file.zip\n");
778 my $zip_flags = $self->verbose ?
'-r' : '-rq';
779 $self->do_system($self->split_like_shell("zip"), $zip_flags, "$file.zip", $dir);
781 $self->log_info("Creating $file.bz2\n");
782 require Archive
::Tar
;
783 # Archive::Tar versions >= 1.09 use the following to enable a compatibility
784 # hack so that the resulting archive is compatible with older clients.
785 $Archive::Tar
::DO_NOT_USE_PREFIX
= 0;
786 my $files = $self->rscan_dir($dir);
787 Archive
::Tar
->create_archive("$file.tar", 0, @
$files);
788 $self->do_system($self->split_like_shell("bzip2"), "-k", "$file.tar");