5 # BioPerl module for Bio::Root::Build
7 # Please direct questions and support issues to <bioperl-l@bioperl.org>
9 # Cared for by Sendu Bala <bix@sendu.me.uk>
11 # Copyright Sendu Bala
13 # You may distribute this module under the same terms as perl itself
15 # POD documentation - main docs before the code
19 Bio::Root::Build - A common Module::Build subclass base for BioPerl distributions
27 This is a subclass of Module::Build so we can override certain methods and do
30 It was first written against Module::Build::Base v0.2805. Many of the methods
31 here are copy/pasted from there in their entirety just to change one or two
32 minor things, since for the most part Module::Build::Base code is hard to
39 User feedback is an integral part of the evolution of this and other
40 Bioperl modules. Send your comments and suggestions preferably to
41 the Bioperl mailing list. Your participation is much appreciated.
43 bioperl-l@bioperl.org - General discussion
44 http://bioperl.org/wiki/Mailing_lists - About the mailing lists
48 Please direct usage questions or support issues to the mailing list:
50 L<bioperl-l@bioperl.org>
52 rather than to the module maintainer directly. Many experienced and
53 reponsive experts will be able look at the problem and quickly
54 address it. Please include a thorough description of the problem
55 with code and data examples if at all possible.
59 Report bugs to the Bioperl bug tracking system to help us keep track
60 of the bugs and their resolution. Bug reports can be submitted via
63 http://bugzilla.open-bio.org/
65 =head1 AUTHOR - Sendu Bala
71 The rest of the documentation details each of the object methods.
72 Internal methods are usually preceded with a _
76 package Bio
::Root
::Build
;
79 # we really need Module::Build to be installed
80 eval "use base Module::Build; 1" or die "This package requires Module::Build v0.2805 or greater to install itself.\n$@";
82 # ensure we'll be able to reload this module later by adding its path to inc
90 our $VERSION = '1.006000_001';
91 our @extra_types = qw(options excludes_os feature_requires test); # test must always be last in the list!
92 our $checking_types = "requires|conflicts|".join("|", @extra_types);
95 # our modules are in Bio, not lib
98 foreach my $pm (@
{$self->rscan_dir('Bio', qr/\.pm$/)}) {
99 $self->{properties
}{pm_files
}->{$pm} = File
::Spec
->catfile('lib', $pm);
102 $self->_find_file_by_type('pm', 'lib');
105 # ask what scripts to install (this method is unique to bioperl)
110 # we can offer interactive installation by groups only if we have subdirs
111 # in scripts and no .PLS files there
112 opendir(my $scripts_dir, 'scripts') or die "Can't open directory 'scripts': $!\n";
115 while (my $thing = readdir($scripts_dir)) {
116 next if $thing =~ /^\./;
117 next if $thing eq 'CVS';
118 if ($thing =~ /PLS$|pl$/) {
122 $thing = File
::Spec
->catfile('scripts', $thing);
125 push(@group_dirs, $thing);
128 closedir($scripts_dir);
129 my $question = $int_ok ?
"Install [a]ll BioPerl scripts, [n]one, or choose groups [i]nteractively?" : "Install [a]ll BioPerl scripts or [n]one?";
131 my $prompt = $accept ?
'a' : $self->prompt($question, 'a');
133 if ($prompt =~ /^[aA]/) {
134 $self->log_info(" - will install all scripts\n");
135 $self->notes(chosen_scripts
=> 'all');
137 elsif ($prompt =~ /^[iI]/) {
138 $self->log_info(" - will install interactively:\n");
141 foreach my $group_dir (@group_dirs) {
142 my $group = File
::Basename
::basename
($group_dir);
143 print " * group '$group' has:\n";
145 my @script_files = @
{$self->rscan_dir($group_dir, qr/\.PLS$|\.pl$/)};
146 foreach my $script_file (@script_files) {
147 my $script = File
::Basename
::basename
($script_file);
151 my $result = $self->prompt(" Install scripts for group '$group'? [y]es [n]o [q]uit", 'n');
152 die if $result =~ /^[qQ]/;
153 if ($result =~ /^[yY]/) {
154 $self->log_info(" + will install group '$group'\n");
155 push(@chosen_scripts, @script_files);
158 $self->log_info(" - will not install group '$group'\n");
162 my $chosen_scripts = @chosen_scripts ?
join("|", @chosen_scripts) : 'none';
164 $self->notes(chosen_scripts
=> $chosen_scripts);
167 $self->log_info(" - won't install any scripts\n");
168 $self->notes(chosen_scripts
=> 'none');
174 # our version of script_files doesn't take args but just installs those scripts
175 # requested by the user after choose_scripts() is called. If it wasn't called,
176 # installs all scripts in scripts directory
180 unless (-d
'scripts') {
184 my $chosen_scripts = $self->notes('chosen_scripts');
185 if ($chosen_scripts) {
186 return if $chosen_scripts eq 'none';
187 return { map {$_, 1} split(/\|/, $chosen_scripts) } unless $chosen_scripts eq 'all';
190 return $_ = { map {$_,1} @
{$self->rscan_dir('scripts', qr/\.PLS$|\.pl$/)} };
193 # process scripts normally, except that we change name from *.PLS to bp_*.pl
194 sub process_script_files
{
196 my $files = $self->find_script_files;
197 return unless keys %$files;
199 my $script_dir = File
::Spec
->catdir($self->blib, 'script');
200 File
::Path
::mkpath
( $script_dir );
202 foreach my $file (keys %$files) {
203 my $result = $self->copy_if_modified($file, $script_dir, 'flatten') or next;
204 $self->fix_shebang_line($result) unless $self->os_type eq 'VMS';
205 $self->make_executable($result);
207 my $final = File
::Basename
::basename
($result);
208 $final =~ s/\.PLS$/\.pl/; # change from .PLS to .pl
209 $final =~ s/^/bp_/ unless $final =~ /^bp/; # add the "bp" prefix
210 $final = File
::Spec
->catfile($script_dir, $final);
211 $self->log_info("$result -> $final\n");
212 File
::Copy
::move
($result, $final) or die "Can't rename '$result' to '$final': $!";
216 # extended to handle extra checking types
219 my $ph = $self->{phash
};
223 if ($ph->{features
}->exists($key)) {
224 return $ph->{features
}->access($key, @_);
227 if (my $info = $ph->{auto_features
}->access($key)) {
228 my $failures = $self->prereq_failures($info);
229 my $disabled = grep( /^(?:\w+_)?(?:$checking_types)$/, keys %$failures ) ?
1 : 0;
233 return $ph->{features
}->access($key, @_);
236 # No args - get the auto_features & overlay the regular features
238 my %auto_features = $ph->{auto_features
}->access();
239 while (my ($name, $info) = each %auto_features) {
240 my $failures = $self->prereq_failures($info);
241 my $disabled = grep( /^(?:\w+_)?(?:$checking_types)$/, keys %$failures ) ?
1 : 0;
242 $features{$name} = $disabled ?
0 : 1;
244 %features = (%features, $ph->{features
}->access());
246 return wantarray ?
%features : \
%features;
248 *feature
= \
&features
;
250 # overridden to fix a stupid bug in Module::Build and extended to handle extra
252 sub check_autofeatures
{
254 my $features = $self->auto_features;
256 return unless %$features;
258 $self->log_info("Checking features:\n");
260 my $max_name_len = 0; # this wasn't set to 0 in Module::Build, causing warning in next line
261 $max_name_len = ( length($_) > $max_name_len ) ?
length($_) : $max_name_len for keys %$features;
263 while (my ($name, $info) = each %$features) {
264 $self->log_info(" $name" . '.' x
($max_name_len - length($name) + 4));
265 if ($name eq 'PL_files') {
266 print "got $name => $info\n";
268 while (my ($key, $val) = each %$info) {
269 print " $key => $val\n";
273 if ( my $failures = $self->prereq_failures($info) ) {
274 my $disabled = grep( /^(?:\w+_)?(?:$checking_types)$/, keys %$failures ) ?
1 : 0;
275 $self->log_info( $disabled ?
"disabled\n" : "enabled\n" );
278 while (my ($type, $prereqs) = each %$failures) {
279 while (my ($module, $status) = each %$prereqs) {
280 my $required = ($type =~ /^(?:\w+_)?(?:requires|conflicts)$/) ?
1 : 0;
281 my $prefix = ($required) ?
'-' : '*';
282 $log_text .= " $prefix $status->{message}\n";
285 $self->log_warn($log_text) if $log_text && ! $self->quiet;
288 $self->log_info("enabled\n");
292 $self->log_info("\n");
295 # overriden just to hide pointless ugly warnings
296 sub check_installed_status
{
298 open (my $olderr, ">&", \
*STDERR
);
299 open(STDERR
, "/dev/null");
300 my $return = $self->SUPER::check_installed_status
(@_);
301 open(STDERR
, ">&", $olderr);
305 # extend to handle option checking (which takes an array ref) and code test
306 # checking (which takes a code ref and must return a message only on failure)
307 # and excludes_os (which takes an array ref of regexps).
308 # also handles more informative output of recommends section
309 sub prereq_failures
{
310 my ($self, $info) = @_;
312 my @types = (@
{ $self->prereq_action_types }, @extra_types);
313 $info ||= {map {$_, $self->$_()} @types};
316 foreach my $type (@types) {
317 my $prereqs = $info->{$type} || next;
320 if ($type eq 'test') {
321 unless (keys %$out) {
322 if (ref($prereqs) eq 'CODE') {
323 $status->{message
} = &{$prereqs};
325 # drop the code-ref to avoid Module::Build trying to store
326 # it with Data::Dumper, generating warnings. (And also, may
327 # be expensive to run the sub multiple times.)
328 $info->{$type} = $status->{message
};
331 $status->{message
} = $prereqs;
333 $out->{$type}{'test'} = $status if $status->{message
};
336 elsif ($type eq 'options') {
338 foreach my $wanted_option (@
{$prereqs}) {
339 unless ($self->args($wanted_option)) {
340 push(@not_ok, $wanted_option);
345 $status->{message
} = "Command line option(s) '@not_ok' not supplied";
346 $out->{$type}{'options'} = $status;
349 elsif ($type eq 'excludes_os') {
350 foreach my $os (@
{$prereqs}) {
352 $status->{message
} = "This feature isn't supported under your OS ($os)";
353 $out->{$type}{'excludes_os'} = $status;
359 while ( my ($modname, $spec) = each %$prereqs ) {
360 $status = $self->check_installed_status($modname, $spec);
362 if ($type =~ /^(?:\w+_)?conflicts$/) {
363 next if !$status->{ok
};
364 $status->{conflicts
} = delete $status->{need
};
365 $status->{message
} = "$modname ($status->{have}) conflicts with this distribution";
367 elsif ($type =~ /^(?:\w+_)?recommends$/) {
368 next if $status->{ok
};
370 my ($preferred_version, $why, $by_what) = split("/", $spec);
371 $by_what = join(", ", split(",", $by_what));
372 $by_what =~ s/, (\S+)$/ and $1/;
374 $status->{message
} = (!ref($status->{have
}) && $status->{have
} eq '<none>'
375 ?
"Optional prerequisite $modname is not installed"
376 : "$modname ($status->{have}) is installed, but we prefer to have $preferred_version");
378 $status->{message
} .= "\n (wanted for $why, used by $by_what)";
380 if ($by_what =~ /\[circular dependency!\]/) {
381 $preferred_version = -1;
384 my $installed = $self->install_optional($modname, $preferred_version, $status->{message
});
385 next if $installed eq 'ok';
386 $status->{message
} = $installed unless $installed eq 'skip';
388 elsif ($type =~ /^feature_requires/) {
389 next if $status->{ok
};
391 # if there is a test code-ref, drop it to avoid
392 # Module::Build trying to store it with Data::Dumper,
393 # generating warnings.
394 delete $info->{test
};
397 next if $status->{ok
};
399 my $installed = $self->install_required($modname, $spec, $status->{message
});
400 next if $installed eq 'ok';
401 $status->{message
} = $installed;
404 $out->{$type}{$modname} = $status;
409 return keys %{$out} ?
$out : return;
412 # install an external module using CPAN prior to testing and installation
413 # should only be called by install_required or install_optional
415 my ($self, $desired, $version, $required) = @_;
417 if ($self->under_cpan) {
418 # Just add to the required hash, which CPAN >= 1.81 will check prior
420 $self->{properties
}{requires
}->{$desired} = $version;
421 $self->log_info(" I'll get CPAN to prepend the installation of this\n");
425 my $question = $required ?
"$desired is absolutely required prior to installation: shall I install it now using a CPAN shell?" :
426 "To install $desired I'll need to open a CPAN shell right now; is that OK?";
427 my $do_install = $self->y_n($question.' y/n', 'y');
430 # Here we use CPAN to actually install the desired module, the benefit
431 # being we continue even if installation fails, and that this works
432 # even when not using CPAN to install.
436 # Save this because CPAN will chdir all over the place.
437 my $cwd = Cwd
::cwd
();
439 CPAN
::Shell
->install($desired);
441 my $expanded = CPAN
::Shell
->expand("Module", $desired);
442 if ($expanded && $expanded->uptodate) {
443 $self->log_info("\n\n*** (back in BioPerl Build.PL) ***\n * You chose to install $desired and it installed fine\n");
447 $self->log_info("\n\n*** (back in BioPerl Build.PL) ***\n");
448 $msg = "You chose to install $desired but it failed to install";
451 chdir $cwd or die "Cannot chdir() back to $cwd: $!";
455 return $required ?
"You chose not to install the REQUIRED module $desired: you'd better install it yourself manually!" :
456 "Even though you wanted the optional module $desired, you chose not to actually install it: do it yourself manually.";
461 # install required modules listed in 'requires' or 'build_requires' arg to
462 # new that weren't already installed. Should only be called by prereq_failures
463 sub install_required
{
464 my ($self, $desired, $version, $msg) = @_;
466 $self->log_info(" - ERROR: $msg\n");
468 return $self->install_prereq($desired, $version, 1);
471 # install optional modules listed in 'recommends' arg to new that weren't
472 # already installed. Should only be called by prereq_failures
473 sub install_optional
{
474 my ($self, $desired, $version, $msg) = @_;
476 unless (defined $self->{ask_optional
}) {
477 $self->{ask_optional
} = $self->args->{accept}
478 ?
'n' : $self->prompt("Install [a]ll optional external modules, [n]one, or choose [i]nteractively?", 'n');
480 return 'skip' if $self->{ask_optional
} =~ /^n/i;
483 if ($self->{ask_optional
} =~ /^a/i) {
484 $self->log_info(" * $msg\n");
488 $install = $self->y_n(" * $msg\n Do you want to install it? y/n", 'n');
491 my $orig_version = $version;
492 $version = 0 if $version == -1;
493 if ($install && ! ($self->{ask_optional
} =~ /^a/i && $orig_version == -1)) {
494 return $self->install_prereq($desired, $version);
497 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." : '';
498 $self->log_info(" * You chose not to install $desired$circular\n");
503 # there's no official way to discover if being run by CPAN, we take an approach
504 # similar to that of Module::AutoInstall
508 unless (defined $self->{under_cpan
}) {
509 ## modified from Module::AutoInstall
511 my $cpan_env = $ENV{PERl5_CPAN_IS_RUNNING
};
512 if ($ENV{PERL5_CPANPLUS_IS_RUNNING
}) {
513 $self->{under_cpan
} = $cpan_env ?
'CPAN' : 'CPANPLUS';
518 unless (defined $self->{under_cpan
}) {
519 if ($CPAN::VERSION
> '1.89') {
521 $self->{under_cpan
} = 'CPAN';
524 $self->{under_cpan
} = 0;
529 unless (defined $self->{under_cpan
}) {
531 if ($CPAN::HandleConfig
::VERSION
) {
532 # Newer versions of CPAN have a HandleConfig module
533 CPAN
::HandleConfig
->load;
536 # Older versions had the load method in Config directly
540 # Find the CPAN lock-file
541 my $lock = File
::Spec
->catfile($CPAN::Config
->{cpan_home
}, '.lock');
543 # Module::AutoInstall now goes on to open the lock file and compare
544 # its pid to ours, but we're not in a situation where we expect
545 # the pids to match, so we take the windows approach for all OSes:
546 # find out if we're in cpan_home
547 my $cwd = File
::Spec
->canonpath(Cwd
::cwd
());
548 my $cpan = File
::Spec
->canonpath($CPAN::Config
->{cpan_home
});
550 $self->{under_cpan
} = index($cwd, $cpan) > -1;
554 if ($self->{under_cpan
}) {
555 $self->log_info("(I think I'm being run by CPAN/CPANPLUS, so will rely on it to handle prerequisite installation)\n");
558 $self->log_info("(I think you ran Build.PL directly, so will use CPAN to install prerequisites on demand)\n");
559 $self->{under_cpan
} = 0;
563 return $self->{under_cpan
};
566 # overridden simply to not print the default answer if chosen by hitting return
569 my $mess = shift or die "prompt() called without a prompt message";
572 if ( $self->_is_unattended && !@_ ) {
574 ERROR: This build seems to be unattended, but there is no default value
575 for this question. Aborting.
579 ($def, my $dispdef) = defined $def ?
($def, "[$def] ") : ('', ' ');
582 print "$mess $dispdef";
584 my $ans = $self->_readline();
586 if ( !defined($ans) # Ctrl-D or unattended
587 or !length($ans) ) { # User hit return
588 #print "$def\n"; didn't like this!
595 # like the Module::Build version, except that we always get version from
597 sub find_dist_packages
{
600 # Only packages in .pm files are candidates for inclusion here.
601 # Only include things in the MANIFEST, not things in developer's
604 my $manifest = $self->_read_manifest('MANIFEST') or die "Can't find dist packages without a MANIFEST file - run 'manifest' action first";
607 my %dist_files = map { $self->localize_file_path($_) => $_ } keys %$manifest;
609 my @pm_files = grep {exists $dist_files{$_}} keys %{ $self->find_pm_files };
611 my $actual_version = $self->dist_version;
613 # First, we enumerate all packages & versions,
614 # seperating into primary & alternative candidates
616 foreach my $file (@pm_files) {
617 next if $dist_files{$file} =~ m{^t/}; # Skip things in t/
619 my @path = split( /\//, $dist_files{$file} );
620 (my $prime_package = join( '::', @path[1..$#path] )) =~ s/\.pm$//;
622 my $pm_info = Module
::Build
::ModuleInfo
->new_from_file( $file );
624 foreach my $package ( $pm_info->packages_inside ) {
625 next if $package eq 'main'; # main can appear numerous times, ignore
626 next if grep /^_/, split( /::/, $package ); # private package, ignore
628 my $version = $pm_info->version( $package );
629 if ($version && $version != $actual_version) {
630 $self->log_warn("Package $package had version $version!\n");
632 $version = $actual_version;
634 if ( $package eq $prime_package ) {
635 if ( exists( $prime{$package} ) ) {
636 # M::B::ModuleInfo will handle this conflict
637 die "Unexpected conflict in '$package'; multiple versions found.\n";
640 $prime{$package}{file
} = $dist_files{$file};
641 $prime{$package}{version
} = $version if defined( $version );
645 push( @
{$alt{$package}}, { file
=> $dist_files{$file}, version
=> $version } );
650 # Then we iterate over all the packages found above, identifying conflicts
651 # and selecting the "best" candidate for recording the file & version
653 foreach my $package ( keys( %alt ) ) {
654 my $result = $self->_resolve_module_versions( $alt{$package} );
656 if ( exists( $prime{$package} ) ) { # primary package selected
657 if ( $result->{err
} ) {
658 # Use the selected primary package, but there are conflicting
659 # errors amoung multiple alternative packages that need to be
661 $self->log_warn("Found conflicting versions for package '$package'\n" .
662 " $prime{$package}{file} ($prime{$package}{version})\n" . $result->{err
});
664 elsif ( defined( $result->{version
} ) ) {
665 # There is a primary package selected, and exactly one
666 # alternative package
668 if ( exists( $prime{$package}{version
} ) && defined( $prime{$package}{version
} ) ) {
669 # Unless the version of the primary package agrees with the
670 # version of the alternative package, report a conflict
671 if ( $self->compare_versions( $prime{$package}{version
}, '!=', $result->{version
} ) ) {
672 $self->log_warn("Found conflicting versions for package '$package'\n" .
673 " $prime{$package}{file} ($prime{$package}{version})\n" .
674 " $result->{file} ($result->{version})\n");
678 # The prime package selected has no version so, we choose to
679 # use any alternative package that does have a version
680 $prime{$package}{file
} = $result->{file
};
681 $prime{$package}{version
} = $result->{version
};
685 # no alt package found with a version, but we have a prime
686 # package so we use it whether it has a version or not
689 else { # No primary package was selected, use the best alternative
690 if ( $result->{err
} ) {
691 $self->log_warn("Found conflicting versions for package '$package'\n" . $result->{err
});
694 # Despite possible conflicting versions, we choose to record
695 # something rather than nothing
696 $prime{$package}{file
} = $result->{file
};
697 $prime{$package}{version
} = $result->{version
} if defined( $result->{version
} );
702 for (grep exists $_->{version
}, values %prime) {
703 $_->{version
} = $_->{version
}->stringify if ref($_->{version
});
709 # our recommends syntax contains extra info that needs to be ignored at this
711 sub _parse_conditions
{
712 my ($self, $spec) = @_;
714 ($spec) = split("/", $spec);
716 if ($spec =~ /^\s*([\w.]+)\s*$/) { # A plain number, maybe with dots, letters, and underscores
720 return split /\s*,\s*/, $spec;
724 # when generating META.yml, we output optional_features syntax (instead of
725 # recommends syntax). Note that as of CPAN v1.9402 nothing useful is done
726 # with this information, which is why we implement our own request to install
727 # the optional modules in install_optional().
728 # Also note that CPAN PLUS complains with an [ERROR] when it sees this META.yml,
729 # but it isn't fatal and installation continues fine.
730 sub prepare_metadata
{
731 my ($self, $node, $keys) = @_;
732 my $p = $self->{properties
};
734 # A little helper sub
736 my ($name, $val) = @_;
737 $node->{$name} = $val;
738 push @
$keys, $name if $keys;
741 foreach (qw(dist_name dist_version dist_author dist_abstract license)) {
742 (my $name = $_) =~ s/^dist_//;
743 $add_node->($name, $self->$_());
744 die "ERROR: Missing required field '$_' for META.yml\n" unless defined($node->{$name}) && length($node->{$name});
746 $node->{version
} = '' . $node->{version
}; # Stringify version objects
748 if (defined( $self->license ) && defined( my $url = $self->valid_licenses->{ $self->license } )) {
749 $node->{resources
}{license
} = $url;
752 foreach ( @
{$self->prereq_action_types} ) {
753 if (exists $p->{$_} and keys %{ $p->{$_} }) {
754 if ($_ eq 'recommends') {
756 while (my ($req, $val) = each %{ $p->{$_} }) {
757 my ($ver, $why, $used_by) = split("/", $val);
759 $info->{description
} = $why;
760 $info->{requires
} = { $req => $ver };
761 $hash->{$used_by} = $info;
763 $add_node->('optional_features', $hash);
766 $add_node->($_, $p->{$_});
771 if (exists $p->{dynamic_config
}) {
772 $add_node->('dynamic_config', $p->{dynamic_config
});
774 my $pkgs = eval { $self->find_dist_packages };
776 $self->log_warn("$@\nWARNING: Possible missing or corrupt 'MANIFEST' file.\n" . "Nothing to enter for 'provides' field in META.yml\n");
779 $node->{provides
} = $pkgs if %$pkgs;
782 if (exists $p->{no_index
}) {
783 $add_node->('no_index', $p->{no_index
});
786 $add_node->('generated_by', "Module::Build version $Module::Build::VERSION");
788 $add_node->('meta-spec',
790 url
=> 'http://module-build.sourceforge.net/META-spec-v1.2.html',
793 while (my($k, $v) = each %{$self->meta_add}) {
797 while (my($k, $v) = each %{$self->meta_merge}) {
798 $self->_hash_merge($node, $k, $v);
804 # let us store extra things persistently in _build
808 # calling SUPER::_construct will dump some of the input to this sub out
809 # with Data::Dumper, which will complain about code refs. So we replace
810 # any code refs with dummies first, then put them back afterwards
812 my $auto_features = $in_hash{auto_features
} if defined $in_hash{auto_features
};
814 if ($auto_features) {
815 while (my ($key, $hash) = each %{$auto_features}) {
816 while (my ($sub_key, $val) = each %{$hash}) {
817 if (ref($val) && ref($val) eq 'CODE') {
818 $hash->{$sub_key} = 'CODE_ref';
819 $code_refs{$key}->{$sub_key} = $val;
825 $self = $self->SUPER::_construct
(@_);
827 my ($p, $ph) = ($self->{properties
}, $self->{phash
});
829 if (keys %code_refs) {
830 while (my ($key, $hash) = each %{$auto_features}) {
831 if (defined $code_refs{$key}) {
832 while (my ($sub_key, $code_ref) = each %{$code_refs{$key}}) {
833 $hash->{$sub_key} = $code_ref;
835 $ph->{auto_features
}->{$key} = $hash;
840 foreach (qw(manifest_skip post_install_scripts)) {
841 my $file = File
::Spec
->catfile($self->config_dir, $_);
842 $ph->{$_} = Module
::Build
::Notes
->new(file
=> $file);
843 $ph->{$_}->restore if -e
$file;
850 $self->SUPER::write_config
;
853 $self->{phash
}{$_}->write() foreach qw(manifest_skip post_install_scripts);
855 # be even more certain we can reload ourselves during a resume by copying
856 # ourselves to _build\lib
857 # this is only possible for the core distribution where we are actually
858 # present in the distribution
859 my $self_filename = File
::Spec
->catfile('Bio', 'Root', 'Build.pm');
860 -e
$self_filename || return;
862 my $filename = File
::Spec
->catfile($self->{properties
}{config_dir
}, 'lib', 'Bio', 'Root', 'Build.pm');
863 my $filedir = File
::Basename
::dirname
($filename);
865 File
::Path
::mkpath
($filedir);
866 warn "Can't create directory $filedir: $!" unless -d
$filedir;
868 File
::Copy
::copy
($self_filename, $filename);
869 warn "Unable to copy 'Bio/Root/Build.pm' to '$filename'\n" unless -e
$filename;
872 # add a file to the default MANIFEST.SKIP
873 sub add_to_manifest_skip
{
875 my %files = map {$self->localize_file_path($_), 1} @_;
876 $self->{phash
}{manifest_skip
}->write(\
%files);
879 # we always generate a new MANIFEST and MANIFEST.SKIP here, instead of allowing
880 # existing files to remain
881 sub ACTION_manifest
{
884 my $maniskip = 'MANIFEST.SKIP';
885 if ( -e
'MANIFEST' || -e
$maniskip ) {
886 $self->log_warn("MANIFEST files already exist, will overwrite them\n");
890 $self->_write_default_maniskip($maniskip);
892 require ExtUtils
::Manifest
; # ExtUtils::Manifest is not warnings clean.
893 local ($^W
, $ExtUtils::Manifest
::Quiet
) = (0,1);
894 ExtUtils
::Manifest
::mkmanifest
();
897 # extended to add extra things to the default MANIFEST.SKIP
898 sub _write_default_maniskip
{
900 $self->SUPER::_write_default_maniskip
;
902 my @extra = keys %{$self->{phash
}{manifest_skip
}->read};
904 open(my $fh, '>>', 'MANIFEST.SKIP') or die "Could not open MANIFEST.SKIP file\n";
905 print $fh "\n# Avoid additional run-time generated things\n";
906 foreach my $line (@extra) {
907 print $fh $line, "\n";
913 # extended to run scripts post-installation
916 require ExtUtils
::Install
;
917 $self->depends_on('build');
918 ExtUtils
::Install
::install
($self->install_map, !$self->quiet, 0, $self->{args
}{uninst
}||0);
919 $self->run_post_install_scripts;
921 sub add_post_install_script
{
923 my %files = map {$self->localize_file_path($_), 1} @_;
924 $self->{phash
}{post_install_scripts
}->write(\
%files);
926 sub run_post_install_scripts
{
928 my @scripts = keys %{$self->{phash
}{post_install_scripts
}->read};
929 foreach my $script (@scripts) {
930 $self->run_perl_script($script);
934 # for use with auto_features, which should require LWP::UserAgent as one of
937 eval {require LWP
::UserAgent
;};
939 # ideally this won't happen because auto_feature already specified
940 # LWP::UserAgent, so this sub wouldn't get called if LWP not installed
941 return "LWP::UserAgent not installed";
943 my $ua = LWP
::UserAgent
->new;
946 my $response = $ua->get('http://search.cpan.org/');
947 unless ($response->is_success) {
948 return "Could not connect to the internet (http://search.cpan.org/)";
953 # nice directory names for dist-related actions
956 my $version = $self->dist_version;
957 if ($version =~ /^\d\.\d{6}\d$/) {
958 # 1.x.x.100 returned as 1.x.x.1
961 $version =~ s/00(\d)/$1./g;
964 if (my ($minor, $rev) = $version =~ /^\d\.(\d)\.\d\.(\d+)$/) {
965 my $dev = ! ($minor % 2 == 0);
967 my $replace = $dev ?
"_$rev" : '';
968 $version =~ s/\.\d+$/$replace/;
971 $rev = sprintf("%03d", $rev);
972 $version =~ s/\.\d+$/_$rev-RC/;
975 $rev -= 100 unless $dev;
976 my $replace = $dev ?
"_$rev" : ".$rev";
977 $version =~ s/\.\d+$/$replace/;
981 return "$self->{properties}{dist_name}-$version";
985 return $self->dist_dir.'-ppm';
988 # generate complete ppd4 version file
992 my $file = $self->make_ppd(%{$self->{args
}});
993 $self->add_to_cleanup($file);
994 $self->add_to_manifest_skip($file);
997 # add pod2htm temp files to MANIFEST.SKIP, generated during ppmdist most likely
1000 $self->SUPER::htmlify_pods
(@_);
1001 $self->add_to_manifest_skip('pod2htm*');
1004 # don't copy across man3 docs since they're of little use under Windows and
1005 # have bad filenames
1006 sub ACTION_ppmdist
{
1008 my @types = $self->install_types(1);
1009 $self->SUPER::ACTION_ppmdist
(@_);
1010 $self->install_types(0);
1013 # when supplied a true value, pretends libdoc doesn't exist (preventing man3
1014 # installation for ppmdist). when supplied false, they exist again
1016 my ($self, $no_libdoc) = @_;
1017 $self->{no_libdoc
} = $no_libdoc if defined $no_libdoc;
1018 my @types = $self->SUPER::install_types
;
1019 if ($self->{no_libdoc
}) {
1021 foreach my $type (@types) {
1022 push(@altered_types, $type) unless $type eq 'libdoc';
1024 return @altered_types;
1029 # overridden from Module::Build::PPMMaker for ppd4 compatability
1031 my ($self, %args) = @_;
1033 require Module
::Build
::PPMMaker
;
1034 my $mbp = Module
::Build
::PPMMaker
->new();
1037 foreach my $info (qw(name author abstract version)) {
1038 my $method = "dist_$info";
1039 $dist{$info} = $self->$method() or die "Can't determine distribution's $info\n";
1041 $dist{codebase
} = $self->ppm_name.'.tar.gz';
1042 $mbp->_simple_xml_escape($_) foreach $dist{abstract
}, $dist{codebase
}, @
{$dist{author
}};
1044 my (undef, undef, undef, $mday, $mon, $year) = localtime();
1047 my $date = "$year-$mon-$mday";
1049 my $softpkg_version = $self->dist_dir;
1050 $softpkg_version =~ s/^$dist{name}-//;
1052 # to avoid a ppm bug, instead of including the requires in the softpackage
1053 # for the distribution we're making, we'll make a seperate Bundle::
1054 # softpackage that contains all the requires, and require only the Bundle in
1055 # the real softpackage
1056 my ($bundle_name) = $dist{name
} =~ /^.+-(.+)/;
1057 $bundle_name ||= 'core';
1058 $bundle_name =~ s/^(\w)/\U$1/;
1059 my $bundle_dir = "Bundle-BioPerl-$bundle_name-$softpkg_version-ppm";
1060 my $bundle_file = "$bundle_dir.tar.gz";
1061 my $bundle_softpkg_name = "Bundle-BioPerl-$bundle_name";
1062 $bundle_name = "Bundle::BioPerl::$bundle_name";
1066 <SOFTPKG NAME=\"$dist{name}\" VERSION=\"$softpkg_version\" DATE=\"$date\">
1067 <TITLE>$dist{name}</TITLE>
1068 <ABSTRACT>$dist{abstract}</ABSTRACT>
1069 @{[ join "\n", map " <AUTHOR>$_</AUTHOR>", @{$dist{author}} ]}
1070 <PROVIDE NAME=\"$dist{name}::\" VERSION=\"$dist{version}\"/>
1074 foreach my $pm (@
{$self->rscan_dir('Bio', qr/\.pm$/)}) {
1075 # convert these filepaths to Module names
1079 $ppd .= sprintf(<<'EOF', $pm, $dist{version});
1080 <PROVIDE NAME="%s" VERSION="%s"/>
1087 <ARCHITECTURE NAME=\"MSWin32-x86-multi-thread-5.8\"/>
1088 <CODEBASE HREF=\"$dist{codebase}\"/>
1089 <REQUIRE NAME=\"$bundle_name\" VERSION=\"$dist{version}\"/>
1094 # now a new softpkg for the bundle
1097 <SOFTPKG NAME=\"$bundle_softpkg_name\" VERSION=\"$softpkg_version\" DATE=\"$date\">
1098 <TITLE>$bundle_name</TITLE>
1099 <ABSTRACT>Bundle of pre-requisites for $dist{name}</ABSTRACT>
1100 @{[ join "\n", map " <AUTHOR>$_</AUTHOR>", @{$dist{author}} ]}
1101 <PROVIDE NAME=\"$bundle_name\" VERSION=\"$dist{version}\"/>
1103 <ARCHITECTURE NAME=\"MSWin32-x86-multi-thread-5.8\"/>
1104 <CODEBASE HREF=\"$bundle_file\"/>
1108 # we do both requires and recommends to make installation on Windows as
1109 # easy (mindless) as possible
1110 for my $type ('requires', 'recommends') {
1111 my $prereq = $self->$type;
1112 while (my ($modname, $version) = each %$prereq) {
1113 next if $modname eq 'perl';
1114 ($version) = split("/", $version) if $version =~ /\
//;
1116 # Module names must have at least one ::
1117 unless ($modname =~ /::/) {
1121 # Bio::Root::Version number comes out as triplet number like 1.5.2;
1122 # convert to our own version
1123 if ($modname eq 'Bio::Root::Version') {
1124 $version = $dist{version
};
1127 $ppd .= sprintf(<<'EOF', $modname, $version || '');
1128 <REQUIRE NAME="%s" VERSION="%s"/>
1139 my $ppd_file = "$dist{name}.ppd";
1140 my $fh = IO
::File
->new(">$ppd_file") or die "Cannot write to $ppd_file: $!";
1144 $self->delete_filetree($bundle_dir);
1145 mkdir($bundle_dir) or die "Cannot create '$bundle_dir': $!";
1146 $self->make_tarball($bundle_dir);
1147 $self->delete_filetree($bundle_dir);
1148 $self->add_to_cleanup($bundle_file);
1149 $self->add_to_manifest_skip($bundle_file);
1154 # we make all archive formats we want, not just .tar.gz
1155 # we also auto-run manifest action, since we always want to re-create
1156 # MANIFEST and MANIFEST.SKIP just-in-time
1160 $self->depends_on('manifest');
1161 $self->depends_on('distdir');
1163 my $dist_dir = $self->dist_dir;
1165 $self->make_zip($dist_dir);
1166 $self->make_tarball($dist_dir);
1167 $self->delete_filetree($dist_dir);
1170 # makes zip file for windows users and bzip2 files as well
1172 my ($self, $dir, $file) = @_;
1175 $self->log_info("Creating $file.zip\n");
1176 my $zip_flags = $self->verbose ?
'-r' : '-rq';
1177 $self->do_system($self->split_like_shell("zip"), $zip_flags, "$file.zip", $dir);
1179 $self->log_info("Creating $file.bz2\n");
1180 require Archive
::Tar
;
1181 # Archive::Tar versions >= 1.09 use the following to enable a compatibility
1182 # hack so that the resulting archive is compatible with older clients.
1183 $Archive::Tar
::DO_NOT_USE_PREFIX
= 0;
1184 my $files = $self->rscan_dir($dir);
1185 Archive
::Tar
->create_archive("$file.tar", 0, @
$files);
1186 $self->do_system($self->split_like_shell("bzip2"), "-k", "$file.tar");
1189 # a method that can be called in a Build.PL script to ask the user if they want
1191 # Should only be called if you have tested for yourself that
1192 # $build->feature('Network') is true
1193 sub prompt_for_network
{
1194 my ($self, $accept) = @_;
1196 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');
1199 $self->notes(network
=> 1);
1200 $self->log_info(" - will run internet-requiring tests\n");
1203 $self->notes(network
=> 0);
1204 $self->log_info(" - will not run internet-requiring tests\n");