5 # BioPerl module for Bio::Root::Build
7 # Cared for by Sendu Bala <bix@sendu.me.uk>
11 # You may distribute this module under the same terms as perl itself
13 # POD documentation - main docs before the code
17 Bio::Root::Build - A common Module::Build subclass base for Bioperl distributions
25 This is a subclass of Module::Build so we can override certain methods and do
28 It was first written against Module::Build::Base v0.2805. Many of the methods
29 here are copy/pasted from there in their entirety just to change one or two
30 minor things, since for the most part Module::Build::Base code is hard to
37 User feedback is an integral part of the evolution of this and other
38 Bioperl modules. Send your comments and suggestions preferably to
39 the Bioperl mailing list. Your participation is much appreciated.
41 bioperl-l@bioperl.org - General discussion
42 http://bioperl.org/wiki/Mailing_lists - About the mailing lists
46 Report bugs to the Bioperl bug tracking system to help us keep track
47 of the bugs and their resolution. Bug reports can be submitted via
50 http://bugzilla.open-bio.org/
52 =head1 AUTHOR - Sendu Bala
58 The rest of the documentation details each of the object methods.
59 Internal methods are usually preceded with a _
63 package Bio
::Root
::Build
;
66 # we really need Module::Build to be installed
67 unless (eval "use Module::Build 0.2805; 1") {
68 print "This package requires Module::Build v0.2805 or greater to install itself.\n";
70 require ExtUtils
::MakeMaker
;
71 my $yn = ExtUtils
::MakeMaker
::prompt
(' Install Module::Build now from CPAN?', 'y');
73 unless ($yn =~ /^y/i) {
74 die " *** Cannot install without Module::Build. Exiting ...\n";
82 # Save this because CPAN will chdir all over the place.
85 my $build_pl = File
::Spec
->catfile($cwd, "Build.PL");
87 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
88 CPAN
::Shell
->install('Module::Build');
89 File
::Copy
::move
($build_pl."hidden", $build_pl);
90 CPAN
::Shell
->expand("Module", "Module::Build")->uptodate or die "Couldn't install Module::Build, giving up.\n";
92 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";
95 eval "use base Module::Build; 1" or die $@
;
97 # ensure we'll be able to reload this module later by adding its path to inc
105 our $VERSION = '1.005009_003';
106 our @extra_types = qw(options excludes_os feature_requires test); # test must always be last in the list!
107 our $checking_types = "requires|conflicts|".join("|", @extra_types);
110 # our modules are in Bio, not lib
113 foreach my $pm (@
{$self->rscan_dir('Bio', qr/\.pm$/)}) {
114 $self->{properties
}{pm_files
}->{$pm} = File
::Spec
->catfile('lib', $pm);
117 $self->_find_file_by_type('pm', 'lib');
120 # ask what scripts to install (this method is unique to bioperl)
125 # we can offer interactive installation by groups only if we have subdirs
126 # in scripts and no .PLS files there
127 opendir(my $scripts_dir, 'scripts') or die "Can't open directory 'scripts': $!\n";
130 while (my $thing = readdir($scripts_dir)) {
131 next if $thing =~ /^\./;
132 next if $thing eq 'CVS';
133 if ($thing =~ /PLS$|pl$/) {
137 $thing = File
::Spec
->catfile('scripts', $thing);
140 push(@group_dirs, $thing);
143 closedir($scripts_dir);
144 my $question = $int_ok ?
"Install [a]ll Bioperl scripts, [n]one, or choose groups [i]nteractively?" : "Install [a]ll Bioperl scripts or [n]one?";
146 my $prompt = $accept ?
'a' : $self->prompt($question, 'a');
148 if ($prompt =~ /^[aA]/) {
149 $self->log_info(" - will install all scripts\n");
150 $self->notes(chosen_scripts
=> 'all');
152 elsif ($prompt =~ /^[iI]/) {
153 $self->log_info(" - will install interactively:\n");
156 foreach my $group_dir (@group_dirs) {
157 my $group = File
::Basename
::basename
($group_dir);
158 print " * group '$group' has:\n";
160 my @script_files = @
{$self->rscan_dir($group_dir, qr/\.PLS$|\.pl$/)};
161 foreach my $script_file (@script_files) {
162 my $script = File
::Basename
::basename
($script_file);
166 my $result = $self->prompt(" Install scripts for group '$group'? [y]es [n]o [q]uit", 'n');
167 die if $result =~ /^[qQ]/;
168 if ($result =~ /^[yY]/) {
169 $self->log_info(" + will install group '$group'\n");
170 push(@chosen_scripts, @script_files);
173 $self->log_info(" - will not install group '$group'\n");
177 my $chosen_scripts = @chosen_scripts ?
join("|", @chosen_scripts) : 'none';
179 $self->notes(chosen_scripts
=> $chosen_scripts);
182 $self->log_info(" - won't install any scripts\n");
183 $self->notes(chosen_scripts
=> 'none');
189 # our version of script_files doesn't take args but just installs those scripts
190 # requested by the user after choose_scripts() is called. If it wasn't called,
191 # installs all scripts in scripts directory
195 unless (-d
'scripts') {
199 my $chosen_scripts = $self->notes('chosen_scripts');
200 if ($chosen_scripts) {
201 return if $chosen_scripts eq 'none';
202 return { map {$_, 1} split(/\|/, $chosen_scripts) } unless $chosen_scripts eq 'all';
205 return $_ = { map {$_,1} @
{$self->rscan_dir('scripts', qr/\.PLS$|\.pl$/)} };
208 # process scripts normally, except that we change name from *.PLS to bp_*.pl
209 sub process_script_files
{
211 my $files = $self->find_script_files;
212 return unless keys %$files;
214 my $script_dir = File
::Spec
->catdir($self->blib, 'script');
215 File
::Path
::mkpath
( $script_dir );
217 foreach my $file (keys %$files) {
218 my $result = $self->copy_if_modified($file, $script_dir, 'flatten') or next;
219 $self->fix_shebang_line($result) unless $self->os_type eq 'VMS';
220 $self->make_executable($result);
222 my $final = File
::Basename
::basename
($result);
223 $final =~ s/\.PLS$/\.pl/; # change from .PLS to .pl
224 $final =~ s/^/bp_/ unless $final =~ /^bp/; # add the "bp" prefix
225 $final = File
::Spec
->catfile($script_dir, $final);
226 $self->log_info("$result -> $final\n");
227 File
::Copy
::move
($result, $final) or die "Can't rename '$result' to '$final': $!";
231 # extended to handle extra checking types
234 my $ph = $self->{phash
};
238 if ($ph->{features
}->exists($key)) {
239 return $ph->{features
}->access($key, @_);
242 if (my $info = $ph->{auto_features
}->access($key)) {
243 my $failures = $self->prereq_failures($info);
244 my $disabled = grep( /^(?:\w+_)?(?:$checking_types)$/, keys %$failures ) ?
1 : 0;
248 return $ph->{features
}->access($key, @_);
251 # No args - get the auto_features & overlay the regular features
253 my %auto_features = $ph->{auto_features
}->access();
254 while (my ($name, $info) = each %auto_features) {
255 my $failures = $self->prereq_failures($info);
256 my $disabled = grep( /^(?:\w+_)?(?:$checking_types)$/, keys %$failures ) ?
1 : 0;
257 $features{$name} = $disabled ?
0 : 1;
259 %features = (%features, $ph->{features
}->access());
261 return wantarray ?
%features : \
%features;
263 *feature
= \
&features
;
265 # overridden to fix a stupid bug in Module::Build and extended to handle extra
267 sub check_autofeatures
{
269 my $features = $self->auto_features;
271 return unless %$features;
273 $self->log_info("Checking features:\n");
275 my $max_name_len = 0; # this wasn't set to 0 in Module::Build, causing warning in next line
276 $max_name_len = ( length($_) > $max_name_len ) ?
length($_) : $max_name_len for keys %$features;
278 while (my ($name, $info) = each %$features) {
279 $self->log_info(" $name" . '.' x
($max_name_len - length($name) + 4));
280 if ($name eq 'PL_files') {
281 print "got $name => $info\n";
283 while (my ($key, $val) = each %$info) {
284 print " $key => $val\n";
288 if ( my $failures = $self->prereq_failures($info) ) {
289 my $disabled = grep( /^(?:\w+_)?(?:$checking_types)$/, keys %$failures ) ?
1 : 0;
290 $self->log_info( $disabled ?
"disabled\n" : "enabled\n" );
293 while (my ($type, $prereqs) = each %$failures) {
294 while (my ($module, $status) = each %$prereqs) {
295 my $required = ($type =~ /^(?:\w+_)?(?:requires|conflicts)$/) ?
1 : 0;
296 my $prefix = ($required) ?
'-' : '*';
297 $log_text .= " $prefix $status->{message}\n";
300 $self->log_warn($log_text) if $log_text && ! $self->quiet;
303 $self->log_info("enabled\n");
307 $self->log_info("\n");
310 # overriden just to hide pointless ugly warnings
311 sub check_installed_status
{
313 open (my $olderr, ">&", \
*STDERR
);
314 open(STDERR
, "/dev/null");
315 my $return = $self->SUPER::check_installed_status
(@_);
316 open(STDERR
, ">&", $olderr);
320 # extend to handle option checking (which takes an array ref) and code test
321 # checking (which takes a code ref and must return a message only on failure)
322 # and excludes_os (which takes an array ref of regexps).
323 # also handles more informative output of recommends section
324 sub prereq_failures
{
325 my ($self, $info) = @_;
327 my @types = (@
{ $self->prereq_action_types }, @extra_types);
328 $info ||= {map {$_, $self->$_()} @types};
331 foreach my $type (@types) {
332 my $prereqs = $info->{$type} || next;
335 if ($type eq 'test') {
336 unless (keys %$out) {
337 if (ref($prereqs) eq 'CODE') {
338 $status->{message
} = &{$prereqs};
340 # drop the code-ref to avoid Module::Build trying to store
341 # it with Data::Dumper, generating warnings. (And also, may
342 # be expensive to run the sub multiple times.)
343 $info->{$type} = $status->{message
};
346 $status->{message
} = $prereqs;
348 $out->{$type}{'test'} = $status if $status->{message
};
351 elsif ($type eq 'options') {
353 foreach my $wanted_option (@
{$prereqs}) {
354 unless ($self->args($wanted_option)) {
355 push(@not_ok, $wanted_option);
360 $status->{message
} = "Command line option(s) '@not_ok' not supplied";
361 $out->{$type}{'options'} = $status;
364 elsif ($type eq 'excludes_os') {
365 foreach my $os (@
{$prereqs}) {
367 $status->{message
} = "This feature isn't supported under your OS ($os)";
368 $out->{$type}{'excludes_os'} = $status;
374 while ( my ($modname, $spec) = each %$prereqs ) {
375 $status = $self->check_installed_status($modname, $spec);
377 if ($type =~ /^(?:\w+_)?conflicts$/) {
378 next if !$status->{ok
};
379 $status->{conflicts
} = delete $status->{need
};
380 $status->{message
} = "$modname ($status->{have}) conflicts with this distribution";
382 elsif ($type =~ /^(?:\w+_)?recommends$/) {
383 next if $status->{ok
};
385 my ($preferred_version, $why, $by_what) = split("/", $spec);
386 $by_what = join(", ", split(",", $by_what));
387 $by_what =~ s/, (\S+)$/ and $1/;
389 $status->{message
} = (!ref($status->{have
}) && $status->{have
} eq '<none>'
390 ?
"Optional prerequisite $modname is not installed"
391 : "$modname ($status->{have}) is installed, but we prefer to have $preferred_version");
393 $status->{message
} .= "\n (wanted for $why, used by $by_what)";
395 if ($by_what =~ /\[circular dependency!\]/) {
396 $preferred_version = -1;
399 my $installed = $self->install_optional($modname, $preferred_version, $status->{message
});
400 next if $installed eq 'ok';
401 $status->{message
} = $installed unless $installed eq 'skip';
403 elsif ($type =~ /^feature_requires/) {
404 next if $status->{ok
};
406 # if there is a test code-ref, drop it to avoid
407 # Module::Build trying to store it with Data::Dumper,
408 # generating warnings.
409 delete $info->{test
};
412 next if $status->{ok
};
414 my $installed = $self->install_required($modname, $spec, $status->{message
});
415 next if $installed eq 'ok';
416 $status->{message
} = $installed;
419 $out->{$type}{$modname} = $status;
424 return keys %{$out} ?
$out : return;
427 # install an external module using CPAN prior to testing and installation
428 # should only be called by install_required or install_optional
430 my ($self, $desired, $version) = @_;
432 if ($self->under_cpan) {
433 # Just add to the required hash, which CPAN >= 1.81 will check prior
435 $self->{properties
}{requires
}->{$desired} = $version;
436 $self->log_info(" I'll get CPAN to prepend the installation of this\n");
440 # Here we use CPAN to actually install the desired module, the benefit
441 # being we continue even if installation fails, and that this works
442 # even when not using CPAN to install.
446 # Save this because CPAN will chdir all over the place.
447 my $cwd = Cwd
::cwd
();
449 CPAN
::Shell
->install($desired);
451 my $expanded = CPAN
::Shell
->expand("Module", $desired);
452 if ($expanded && $expanded->uptodate) {
453 $self->log_info("\n\n*** (back in Bioperl Build.PL) ***\n * You chose to install $desired and it installed fine\n");
457 $self->log_info("\n\n*** (back in Bioperl Build.PL) ***\n");
458 $msg = "You chose to install $desired but it failed to install";
461 chdir $cwd or die "Cannot chdir() back to $cwd: $!";
466 # install required modules listed in 'requires' or 'build_requires' arg to
467 # new that weren't already installed. Should only be called by prereq_failures
468 sub install_required
{
469 my ($self, $desired, $version, $msg) = @_;
471 $self->log_info(" - ERROR: $msg\n");
473 return $self->install_prereq($desired, $version);
476 # install optional modules listed in 'recommends' arg to new that weren't
477 # already installed. Should only be called by prereq_failures
478 sub install_optional
{
479 my ($self, $desired, $version, $msg) = @_;
481 unless (defined $self->{ask_optional
}) {
482 $self->{ask_optional
} = $self->args->{accept}
483 ?
'n' : $self->prompt("Install [a]ll optional external modules, [n]one, or choose [i]nteractively?", 'n');
485 return 'skip' if $self->{ask_optional
} =~ /^n/i;
488 if ($self->{ask_optional
} =~ /^a/i) {
489 $self->log_info(" * $msg\n");
493 $install = $self->y_n(" * $msg\n Do you want to install it? y/n", 'n');
496 my $orig_version = $version;
497 $version = 0 if $version == -1;
498 if ($install && ! ($self->{ask_optional
} =~ /^a/i && $orig_version == -1)) {
499 return $self->install_prereq($desired, $version);
502 my $circular = ($self->{ask_optional
} =~ /^a/i && $orig_version == -1) ?
" - this is a circular dependency so doesn't get installed when installing 'all' modules. If you really want it, choose modules interactively." : '';
503 $self->log_info(" * You chose not to install $desired$circular\n");
508 # there's no official way to discover if being run by CPAN, we take an approach
509 # similar to that of Module::AutoInstall
513 unless (defined $self->{under_cpan
}) {
514 ## modified from Module::AutoInstall
518 if ($CPAN::HandleConfig
::VERSION
) {
519 # Newer versions of CPAN have a HandleConfig module
520 CPAN
::HandleConfig
->load;
523 # Older versions had the load method in Config directly
527 # Find the CPAN lock-file
528 my $lock = File
::Spec
->catfile($CPAN::Config
->{cpan_home
}, '.lock');
530 # Module::AutoInstall now goes on to open the lock file and compare
531 # its pid to ours, but we're not in a situation where we expect
532 # the pids to match, so we take the windows approach for all OSes:
533 # find out if we're in cpan_home
534 my $cwd = File
::Spec
->canonpath(Cwd
::cwd
());
535 my $cpan = File
::Spec
->canonpath($CPAN::Config
->{cpan_home
});
537 $self->{under_cpan
} = index($cwd, $cpan) > -1;
540 if ($self->{under_cpan
}) {
541 $self->log_info("(I think I'm being run by CPAN, so will rely on CPAN to handle prerequisite installation)\n");
544 $self->log_info("(I think you ran Build.PL directly, so will use CPAN to install prerequisites on demand)\n");
545 $self->{under_cpan
} = 0;
549 return $self->{under_cpan
};
552 # overridden simply to not print the default answer if chosen by hitting return
555 my $mess = shift or die "prompt() called without a prompt message";
558 if ( $self->_is_unattended && !@_ ) {
560 ERROR: This build seems to be unattended, but there is no default value
561 for this question. Aborting.
565 ($def, my $dispdef) = defined $def ?
($def, "[$def] ") : ('', ' ');
568 print "$mess $dispdef";
570 my $ans = $self->_readline();
572 if ( !defined($ans) # Ctrl-D or unattended
573 or !length($ans) ) { # User hit return
574 #print "$def\n"; didn't like this!
581 # like the Module::Build version, except that we always get version from
583 sub find_dist_packages
{
586 # Only packages in .pm files are candidates for inclusion here.
587 # Only include things in the MANIFEST, not things in developer's
590 my $manifest = $self->_read_manifest('MANIFEST') or die "Can't find dist packages without a MANIFEST file - run 'manifest' action first";
593 my %dist_files = map { $self->localize_file_path($_) => $_ } keys %$manifest;
595 my @pm_files = grep {exists $dist_files{$_}} keys %{ $self->find_pm_files };
597 my $actual_version = $self->dist_version;
599 # First, we enumerate all packages & versions,
600 # seperating into primary & alternative candidates
602 foreach my $file (@pm_files) {
603 next if $dist_files{$file} =~ m{^t/}; # Skip things in t/
605 my @path = split( /\//, $dist_files{$file} );
606 (my $prime_package = join( '::', @path[1..$#path] )) =~ s/\.pm$//;
608 my $pm_info = Module
::Build
::ModuleInfo
->new_from_file( $file );
610 foreach my $package ( $pm_info->packages_inside ) {
611 next if $package eq 'main'; # main can appear numerous times, ignore
612 next if grep /^_/, split( /::/, $package ); # private package, ignore
614 my $version = $pm_info->version( $package );
615 if ($version && $version != $actual_version) {
616 $self->log_warn("Package $package had version $version!\n");
618 $version = $actual_version;
620 if ( $package eq $prime_package ) {
621 if ( exists( $prime{$package} ) ) {
622 # M::B::ModuleInfo will handle this conflict
623 die "Unexpected conflict in '$package'; multiple versions found.\n";
626 $prime{$package}{file
} = $dist_files{$file};
627 $prime{$package}{version
} = $version if defined( $version );
631 push( @
{$alt{$package}}, { file
=> $dist_files{$file}, version
=> $version } );
636 # Then we iterate over all the packages found above, identifying conflicts
637 # and selecting the "best" candidate for recording the file & version
639 foreach my $package ( keys( %alt ) ) {
640 my $result = $self->_resolve_module_versions( $alt{$package} );
642 if ( exists( $prime{$package} ) ) { # primary package selected
643 if ( $result->{err
} ) {
644 # Use the selected primary package, but there are conflicting
645 # errors amoung multiple alternative packages that need to be
647 $self->log_warn("Found conflicting versions for package '$package'\n" .
648 " $prime{$package}{file} ($prime{$package}{version})\n" . $result->{err
});
650 elsif ( defined( $result->{version
} ) ) {
651 # There is a primary package selected, and exactly one
652 # alternative package
654 if ( exists( $prime{$package}{version
} ) && defined( $prime{$package}{version
} ) ) {
655 # Unless the version of the primary package agrees with the
656 # version of the alternative package, report a conflict
657 if ( $self->compare_versions( $prime{$package}{version
}, '!=', $result->{version
} ) ) {
658 $self->log_warn("Found conflicting versions for package '$package'\n" .
659 " $prime{$package}{file} ($prime{$package}{version})\n" .
660 " $result->{file} ($result->{version})\n");
664 # The prime package selected has no version so, we choose to
665 # use any alternative package that does have a version
666 $prime{$package}{file
} = $result->{file
};
667 $prime{$package}{version
} = $result->{version
};
671 # no alt package found with a version, but we have a prime
672 # package so we use it whether it has a version or not
675 else { # No primary package was selected, use the best alternative
676 if ( $result->{err
} ) {
677 $self->log_warn("Found conflicting versions for package '$package'\n" . $result->{err
});
680 # Despite possible conflicting versions, we choose to record
681 # something rather than nothing
682 $prime{$package}{file
} = $result->{file
};
683 $prime{$package}{version
} = $result->{version
} if defined( $result->{version
} );
688 for (grep exists $_->{version
}, values %prime) {
689 $_->{version
} = $_->{version
}->stringify if ref($_->{version
});
695 # our recommends syntax contains extra info that needs to be ignored at this
697 sub _parse_conditions
{
698 my ($self, $spec) = @_;
700 ($spec) = split("/", $spec);
702 if ($spec =~ /^\s*([\w.]+)\s*$/) { # A plain number, maybe with dots, letters, and underscores
706 return split /\s*,\s*/, $spec;
710 # when generating META.yml, we output optional_features syntax (instead of
711 # recommends syntax). Note that as of CPAN v1.8802 nothing useful is done
712 # with this information, which is why we implement our own request to install
713 # the optional modules in install_optional()
714 sub prepare_metadata
{
715 my ($self, $node, $keys) = @_;
716 my $p = $self->{properties
};
718 # A little helper sub
720 my ($name, $val) = @_;
721 $node->{$name} = $val;
722 push @
$keys, $name if $keys;
725 foreach (qw(dist_name dist_version dist_author dist_abstract license)) {
726 (my $name = $_) =~ s/^dist_//;
727 $add_node->($name, $self->$_());
728 die "ERROR: Missing required field '$_' for META.yml\n" unless defined($node->{$name}) && length($node->{$name});
730 $node->{version
} = '' . $node->{version
}; # Stringify version objects
732 if (defined( $self->license ) && defined( my $url = $self->valid_licenses->{ $self->license } )) {
733 $node->{resources
}{license
} = $url;
736 foreach ( @
{$self->prereq_action_types} ) {
737 if (exists $p->{$_} and keys %{ $p->{$_} }) {
738 if ($_ eq 'recommends') {
740 while (my ($req, $val) = each %{ $p->{$_} }) {
741 my ($ver, $why, $used_by) = split("/", $val);
743 $info->{description
} = $why;
744 $info->{requires
} = { $req => $ver };
745 $hash->{$used_by} = $info;
747 $add_node->('optional_features', $hash);
750 $add_node->($_, $p->{$_});
755 if (exists $p->{dynamic_config
}) {
756 $add_node->('dynamic_config', $p->{dynamic_config
});
758 my $pkgs = eval { $self->find_dist_packages };
760 $self->log_warn("$@\nWARNING: Possible missing or corrupt 'MANIFEST' file.\n" . "Nothing to enter for 'provides' field in META.yml\n");
763 $node->{provides
} = $pkgs if %$pkgs;
766 if (exists $p->{no_index
}) {
767 $add_node->('no_index', $p->{no_index
});
770 $add_node->('generated_by', "Module::Build version $Module::Build::VERSION");
772 $add_node->('meta-spec',
774 url
=> 'http://module-build.sourceforge.net/META-spec-v1.2.html',
777 while (my($k, $v) = each %{$self->meta_add}) {
781 while (my($k, $v) = each %{$self->meta_merge}) {
782 $self->_hash_merge($node, $k, $v);
788 # let us store extra things persistently in _build
792 # calling SUPER::_construct will dump some of the input to this sub out
793 # with Data::Dumper, which will complain about code refs. So we replace
794 # any code refs with dummies first, then put them back afterwards
796 my $auto_features = $in_hash{auto_features
} if defined $in_hash{auto_features
};
798 if ($auto_features) {
799 while (my ($key, $hash) = each %{$auto_features}) {
800 while (my ($sub_key, $val) = each %{$hash}) {
801 if (ref($val) && ref($val) eq 'CODE') {
802 $hash->{$sub_key} = 'CODE_ref';
803 $code_refs{$key}->{$sub_key} = $val;
809 $self = $self->SUPER::_construct
(@_);
811 my ($p, $ph) = ($self->{properties
}, $self->{phash
});
813 if (keys %code_refs) {
814 while (my ($key, $hash) = each %{$auto_features}) {
815 if (defined $code_refs{$key}) {
816 while (my ($sub_key, $code_ref) = each %{$code_refs{$key}}) {
817 $hash->{$sub_key} = $code_ref;
819 $ph->{auto_features
}->{$key} = $hash;
824 foreach (qw(manifest_skip post_install_scripts)) {
825 my $file = File
::Spec
->catfile($self->config_dir, $_);
826 $ph->{$_} = Module
::Build
::Notes
->new(file
=> $file);
827 $ph->{$_}->restore if -e
$file;
834 $self->SUPER::write_config
;
837 $self->{phash
}{$_}->write() foreach qw(manifest_skip post_install_scripts);
839 # be even more certain we can reload ourselves during a resume by copying
840 # ourselves to _build\lib
841 # this is only possible for the core distribution where we are actually
842 # present in the distribution
843 my $self_filename = File
::Spec
->catfile('Bio', 'Root', 'Build.pm');
844 -e
$self_filename || return;
846 my $filename = File
::Spec
->catfile($self->{properties
}{config_dir
}, 'lib', 'Bio', 'Root', 'Build.pm');
847 my $filedir = File
::Basename
::dirname
($filename);
849 File
::Path
::mkpath
($filedir);
850 warn "Can't create directory $filedir: $!" unless -d
$filedir;
852 File
::Copy
::copy
($self_filename, $filename);
853 warn "Unable to copy 'Bio/Root/Build.pm' to '$filename'\n" unless -e
$filename;
856 # add a file to the default MANIFEST.SKIP
857 sub add_to_manifest_skip
{
859 my %files = map {$self->localize_file_path($_), 1} @_;
860 $self->{phash
}{manifest_skip
}->write(\
%files);
863 # we always generate a new MANIFEST and MANIFEST.SKIP here, instead of allowing
864 # existing files to remain
865 sub ACTION_manifest
{
868 my $maniskip = 'MANIFEST.SKIP';
869 if ( -e
'MANIFEST' || -e
$maniskip ) {
870 $self->log_warn("MANIFEST files already exist, will overwrite them\n");
874 $self->_write_default_maniskip($maniskip);
876 require ExtUtils
::Manifest
; # ExtUtils::Manifest is not warnings clean.
877 local ($^W
, $ExtUtils::Manifest
::Quiet
) = (0,1);
878 ExtUtils
::Manifest
::mkmanifest
();
881 # extended to add extra things to the default MANIFEST.SKIP
882 sub _write_default_maniskip
{
884 $self->SUPER::_write_default_maniskip
;
886 my @extra = keys %{$self->{phash
}{manifest_skip
}->read};
888 open(my $fh, '>>', 'MANIFEST.SKIP') or die "Could not open MANIFEST.SKIP file\n";
889 print $fh "\n# Avoid additional run-time generated things\n";
890 foreach my $line (@extra) {
891 print $fh $line, "\n";
897 # extended to run scripts post-installation
900 require ExtUtils
::Install
;
901 $self->depends_on('build');
902 ExtUtils
::Install
::install
($self->install_map, !$self->quiet, 0, $self->{args
}{uninst
}||0);
903 $self->run_post_install_scripts;
905 sub add_post_install_script
{
907 my %files = map {$self->localize_file_path($_), 1} @_;
908 $self->{phash
}{post_install_scripts
}->write(\
%files);
910 sub run_post_install_scripts
{
912 my @scripts = keys %{$self->{phash
}{post_install_scripts
}->read};
913 foreach my $script (@scripts) {
914 $self->run_perl_script($script);
918 # for use with auto_features, which should require LWP::UserAgent as one of
921 eval {require LWP
::UserAgent
;};
923 # ideally this won't happen because auto_feature already specified
924 # LWP::UserAgent, so this sub wouldn't get called if LWP not installed
925 return "LWP::UserAgent not installed";
927 my $ua = LWP
::UserAgent
->new;
930 my $response = $ua->get('http://search.cpan.org/');
931 unless ($response->is_success) {
932 return "Could not connect to the internet (http://search.cpan.org/)";
937 # nice directory names for dist-related actions
940 my $version = $self->dist_version;
941 if ($version =~ /^\d\.\d{6}\d$/) {
942 # 1.x.x.100 returned as 1.x.x.1
945 $version =~ s/00(\d)/$1./g;
948 if (my ($minor, $rev) = $version =~ /^\d\.(\d)\.\d\.(\d+)$/) {
949 my $dev = ! ($minor % 2 == 0);
951 my $replace = $dev ?
"_$rev" : '';
952 $version =~ s/\.\d+$/$replace/;
955 $rev = sprintf("%03d", $rev);
956 $version =~ s/\.\d+$/_$rev-RC/;
959 $rev -= 100 unless $dev;
960 my $replace = $dev ?
"_$rev" : ".$rev";
961 $version =~ s/\.\d+$/$replace/;
965 return "$self->{properties}{dist_name}-$version";
969 return $self->dist_dir.'-ppm';
972 # generate complete ppd4 version file
976 my $file = $self->make_ppd(%{$self->{args
}});
977 $self->add_to_cleanup($file);
978 $self->add_to_manifest_skip($file);
981 # add pod2htm temp files to MANIFEST.SKIP, generated during ppmdist most likely
984 $self->SUPER::htmlify_pods
(@_);
985 $self->add_to_manifest_skip('pod2htm*');
988 # don't copy across man3 docs since they're of little use under Windows and
992 my @types = $self->install_types(1);
993 $self->SUPER::ACTION_ppmdist
(@_);
994 $self->install_types(0);
997 # when supplied a true value, pretends libdoc doesn't exist (preventing man3
998 # installation for ppmdist). when supplied false, they exist again
1000 my ($self, $no_libdoc) = @_;
1001 $self->{no_libdoc
} = $no_libdoc if defined $no_libdoc;
1002 my @types = $self->SUPER::install_types
;
1003 if ($self->{no_libdoc
}) {
1005 foreach my $type (@types) {
1006 push(@altered_types, $type) unless $type eq 'libdoc';
1008 return @altered_types;
1013 # overridden from Module::Build::PPMMaker for ppd4 compatability
1015 my ($self, %args) = @_;
1017 require Module
::Build
::PPMMaker
;
1018 my $mbp = Module
::Build
::PPMMaker
->new();
1021 foreach my $info (qw(name author abstract version)) {
1022 my $method = "dist_$info";
1023 $dist{$info} = $self->$method() or die "Can't determine distribution's $info\n";
1025 $dist{codebase
} = $self->ppm_name.'.tar.gz';
1026 $mbp->_simple_xml_escape($_) foreach $dist{abstract
}, $dist{codebase
}, @
{$dist{author
}};
1028 my (undef, undef, undef, $mday, $mon, $year) = localtime();
1031 my $date = "$year-$mon-$mday";
1033 my $softpkg_version = $self->dist_dir;
1034 $softpkg_version =~ s/^$dist{name}-//;
1036 # to avoid a ppm bug, instead of including the requires in the softpackage
1037 # for the distribution we're making, we'll make a seperate Bundle::
1038 # softpackage that contains all the requires, and require only the Bundle in
1039 # the real softpackage
1040 my ($bundle_name) = $dist{name
} =~ /^.+-(.+)/;
1041 $bundle_name ||= 'core';
1042 $bundle_name =~ s/^(\w)/\U$1/;
1043 my $bundle_dir = "Bundle-BioPerl-$bundle_name-$softpkg_version-ppm";
1044 my $bundle_file = "$bundle_dir.tar.gz";
1045 my $bundle_softpkg_name = "Bundle-BioPerl-$bundle_name";
1046 $bundle_name = "Bundle::BioPerl::$bundle_name";
1050 <SOFTPKG NAME=\"$dist{name}\" VERSION=\"$softpkg_version\" DATE=\"$date\">
1051 <TITLE>$dist{name}</TITLE>
1052 <ABSTRACT>$dist{abstract}</ABSTRACT>
1053 @{[ join "\n", map " <AUTHOR>$_</AUTHOR>", @{$dist{author}} ]}
1054 <PROVIDE NAME=\"$dist{name}::\" VERSION=\"$dist{version}\"/>
1058 foreach my $pm (@
{$self->rscan_dir('Bio', qr/\.pm$/)}) {
1059 # convert these filepaths to Module names
1063 $ppd .= sprintf(<<'EOF', $pm, $dist{version});
1064 <PROVIDE NAME="%s" VERSION="%s"/>
1071 <ARCHITECTURE NAME=\"MSWin32-x86-multi-thread-5.8\"/>
1072 <CODEBASE HREF=\"$dist{codebase}\"/>
1073 <REQUIRE NAME=\"$bundle_name\" VERSION=\"$dist{version}\"/>
1078 # now a new softpkg for the bundle
1081 <SOFTPKG NAME=\"$bundle_softpkg_name\" VERSION=\"$softpkg_version\" DATE=\"$date\">
1082 <TITLE>$bundle_name</TITLE>
1083 <ABSTRACT>Bundle of pre-requisites for $dist{name}</ABSTRACT>
1084 @{[ join "\n", map " <AUTHOR>$_</AUTHOR>", @{$dist{author}} ]}
1085 <PROVIDE NAME=\"$bundle_name\" VERSION=\"$dist{version}\"/>
1087 <ARCHITECTURE NAME=\"MSWin32-x86-multi-thread-5.8\"/>
1088 <CODEBASE HREF=\"$bundle_file\"/>
1092 # we do both requires and recommends to make installation on Windows as
1093 # easy (mindless) as possible
1094 for my $type ('requires', 'recommends') {
1095 my $prereq = $self->$type;
1096 while (my ($modname, $version) = each %$prereq) {
1097 next if $modname eq 'perl';
1098 ($version) = split("/", $version) if $version =~ /\
//;
1100 # Module names must have at least one ::
1101 unless ($modname =~ /::/) {
1105 # Bio::Root::Version number comes out as triplet number like 1.5.2;
1106 # convert to our own version
1107 if ($modname eq 'Bio::Root::Version') {
1108 $version = $dist{version
};
1111 $ppd .= sprintf(<<'EOF', $modname, $version || '');
1112 <REQUIRE NAME="%s" VERSION="%s"/>
1123 my $ppd_file = "$dist{name}.ppd";
1124 my $fh = IO
::File
->new(">$ppd_file") or die "Cannot write to $ppd_file: $!";
1128 $self->delete_filetree($bundle_dir);
1129 mkdir($bundle_dir) or die "Cannot create '$bundle_dir': $!";
1130 $self->make_tarball($bundle_dir);
1131 $self->delete_filetree($bundle_dir);
1132 $self->add_to_cleanup($bundle_file);
1133 $self->add_to_manifest_skip($bundle_file);
1138 # we make all archive formats we want, not just .tar.gz
1139 # we also auto-run manifest action, since we always want to re-create
1140 # MANIFEST and MANIFEST.SKIP just-in-time
1144 $self->depends_on('manifest');
1145 $self->depends_on('distdir');
1147 my $dist_dir = $self->dist_dir;
1149 $self->make_zip($dist_dir);
1150 $self->make_tarball($dist_dir);
1151 $self->delete_filetree($dist_dir);
1154 # makes zip file for windows users and bzip2 files as well
1156 my ($self, $dir, $file) = @_;
1159 $self->log_info("Creating $file.zip\n");
1160 my $zip_flags = $self->verbose ?
'-r' : '-rq';
1161 $self->do_system($self->split_like_shell("zip"), $zip_flags, "$file.zip", $dir);
1163 $self->log_info("Creating $file.bz2\n");
1164 require Archive
::Tar
;
1165 # Archive::Tar versions >= 1.09 use the following to enable a compatibility
1166 # hack so that the resulting archive is compatible with older clients.
1167 $Archive::Tar
::DO_NOT_USE_PREFIX
= 0;
1168 my $files = $self->rscan_dir($dir);
1169 Archive
::Tar
->create_archive("$file.tar", 0, @
$files);
1170 $self->do_system($self->split_like_shell("bzip2"), "-k", "$file.tar");
1173 # a method that can be called in a Build.PL script to ask the user if they want
1175 # Should only be called if you have tested for yourself that
1176 # $build->feature('Network') is true
1177 sub prompt_for_network
{
1178 my ($self, $accept) = @_;
1180 my $proceed = $accept ?
0 : $self->y_n("Do you want to run tests that require connection to servers across the internet\n(likely to cause some failures)? y/n", 'n');
1183 $self->notes(network
=> 1);
1184 $self->log_info(" - will run internet-requiring tests\n");
1187 $self->notes(network
=> 0);
1188 $self->log_info(" - will not run internet-requiring tests\n");