Bio/Root/Build.pm

   1 package Bio::Root::Build;
   2 use strict;
   3 use warnings;
   4
   5 =head1 SYNOPSIS
   6
   7   ...TO BE ADDED
   8
   9 =head1 DESCRIPTION
  10
  11 This is a subclass of Module::Build so we can override certain methods and do
  12 fancy stuff
  13
  14 It was first written against Module::Build::Base v0.2805. Many of the methods
  15 here are copy/pasted from there in their entirety just to change one or two
  16 minor things, since for the most part Module::Build::Base code is hard to
  17 cleanly override.
  18
  19 B<Note>: per bug 3196, the majority of the code in this module has been revised
  20 or commented out to bring it in line with the Module::Build API. In particular,
  21 'requires/recommends' tags in the Build.PL file were not of the same format as
  22 those for Module::Build, and so caused serious issues with newer versions
  23 (including giving incorrect meta data). Other problematic methods involving
  24 automatic installation of prereq modules via CPAN were also removed as they do
  25 not work with more modern perl tools such as perlbrew and cpanm.
  26
  27 =head1 AUTHOR Sendu Bala
  28
  29 =cut
  30
  31 BEGIN {
  32     # we really need Module::Build to be installed
  33     eval "use base 'Module::Build'; 1" or die "This package requires Module::Build v0.2805 or greater to install itself.\n$@";
  34
  35     # ensure we'll be able to reload this module later by adding its path to inc
  36     use Cwd;
  37     use lib Cwd::cwd();
  38 }
  39
  40 our $VERSION = '1.006925'; # pre-1.7
  41 our @extra_types = qw(options excludes_os feature_requires test); # test must always be last in the list!
  42 our $checking_types = "requires|conflicts|".join("|", @extra_types);
  43
  44 =head2 find_pm_files
  45
  46 Our modules are in Bio, not lib
  47 =cut
  48
  49 sub find_pm_files {
  50     my $self = shift;
  51     foreach my $pm (@{$self->rscan_dir('Bio', qr/\.pm$/)}) {
  52         $self->{properties}{pm_files}->{$pm} = File::Spec->catfile('lib', $pm);
  53     }
  54
  55     $self->_find_file_by_type('pm', 'lib');
  56 }
  57
  58 =head2 choose_scripts
  59
  60 Ask what scripts to install (this method is unique to bioperl)
  61 =cut
  62
  63 sub choose_scripts {
  64     my $self = shift;
  65     my $accept = shift;
  66
  67     # we can offer interactive installation by groups only if we have subdirs
  68     # in scripts and no .PLS files there
  69     opendir(my $scripts_dir, 'scripts') or die "Can't open directory 'scripts': $!\n";
  70     my $int_ok = 0;
  71     my @group_dirs;
  72
  73     # only retain top-level script directories (the 'categories')
  74     while (my $thing = readdir($scripts_dir)) {
  75         next if $thing =~ /^\./;
  76         $thing = File::Spec->catfile('scripts', $thing);
  77         if (-d $thing) {
  78             $int_ok = 1;
  79             push(@group_dirs, $thing);
  80         }
  81     }
  82     closedir($scripts_dir);
  83     my $question = $int_ok ? "Install [a]ll BioPerl scripts, [n]one, ".
  84         "or choose groups [i]nteractively?" : "Install [a]ll BioPerl scripts ".
  85         "or [n]one?";
  86
  87     my $prompt = $accept ? 'a' : $self->prompt($question, 'a');
  88
  89     if ($prompt =~ /^[aA]/) {
  90         $self->log_info("  - will install all scripts\n");
  91         $self->notes(chosen_scripts => 'all');
  92     }
  93     elsif ($prompt =~ /^[iI]/) {
  94         $self->log_info("  - will install interactively:\n");
  95
  96         my @chosen_scripts;
  97         foreach my $group_dir (@group_dirs) {
  98             my $group = File::Basename::basename($group_dir);
  99             print "    * group '$group' has:\n";
 100
 101             my @script_files = @{$self->rscan_dir($group_dir, qr/\.PLS$|\.pl$/)};
 102             foreach my $script_file (@script_files) {
 103                 my $script = File::Basename::basename($script_file);
 104                 print "      $script\n";
 105             }
 106
 107             my $result = $self->prompt("    Install scripts for group '$group'? [y]es [n]o [q]uit", 'n');
 108             die if $result =~ /^[qQ]/;
 109             if ($result =~ /^[yY]/) {
 110                 $self->log_info("      + will install group '$group'\n");
 111                 push(@chosen_scripts, @script_files);
 112             }
 113             else {
 114                 $self->log_info("      - will not install group '$group'\n");
 115             }
 116         }
 117
 118         my $chosen_scripts = @chosen_scripts ? join("|", @chosen_scripts) : 'none';
 119
 120         $self->notes(chosen_scripts => $chosen_scripts);
 121     }
 122     else {
 123         $self->log_info("  - won't install any scripts\n");
 124         $self->notes(chosen_scripts => 'none');
 125     }
 126
 127     print "\n";
 128 }
 129
 130 =head2 script_files
 131
 132 Our version of script_files doesn't take args but just installs those scripts
 133 requested by the user after choose_scripts() is called. If it wasn't called,
 134 installs all scripts in scripts directory
 135 =cut
 136
 137 sub script_files {
 138     my $self = shift;
 139
 140     unless (-d 'scripts') {
 141         return {};
 142     }
 143
 144     my $chosen_scripts = $self->notes('chosen_scripts');
 145     if ($chosen_scripts) {
 146         return if $chosen_scripts eq 'none';
 147         return { map {$_, 1} split(/\|/, $chosen_scripts) } unless $chosen_scripts eq 'all';
 148     }
 149
 150     return $_ = { map {$_,1} @{$self->rscan_dir('scripts', qr/\.PLS$|\.pl$/)} };
 151 }
 152
 153 # extended to handle extra checking types
 154 #sub features {
 155 #    my $self = shift;
 156 #    my $ph = $self->{phash};
 157 #
 158 #    if (@_) {
 159 #        my $key = shift;
 160 #        if ($ph->{features}->exists($key)) {
 161 #            return $ph->{features}->access($key, @_);
 162 #        }
 163 #
 164 #        if (my $info = $ph->{auto_features}->access($key)) {
 165 #            my $failures = $self->prereq_failures($info);
 166 #            my $disabled = grep( /^(?:\w+_)?(?:$checking_types)$/, keys %$failures ) ? 1 : 0;
 167 #            return !$disabled;
 168 #        }
 169 #
 170 #        return $ph->{features}->access($key, @_);
 171 #    }
 172 #
 173 #    # No args - get the auto_features & overlay the regular features
 174 #    my %features;
 175 #    my %auto_features = $ph->{auto_features}->access();
 176 #    while (my ($name, $info) = each %auto_features) {
 177 #        my $failures = $self->prereq_failures($info);
 178 #        my $disabled = grep( /^(?:\w+_)?(?:$checking_types)$/, keys %$failures ) ? 1 : 0;
 179 #        $features{$name} = $disabled ? 0 : 1;
 180 #    }
 181 #    %features = (%features, $ph->{features}->access());
 182 #
 183 #    return wantarray ? %features : \%features;
 184 #}
 185 #*feature = \&features;
 186
 187 # overridden to fix a stupid bug in Module::Build and extended to handle extra
 188 # checking types
 189 #sub check_autofeatures {
 190 #    my ($self) = @_;
 191 #    my $features = $self->auto_features;
 192 #
 193 #    return unless %$features;
 194 #
 195 #    $self->log_info("Checking features:\n");
 196 #
 197 #    my $max_name_len = 0; # this wasn't set to 0 in Module::Build, causing warning in next line
 198 #    $max_name_len = ( length($_) > $max_name_len ) ? length($_) : $max_name_len for keys %$features;
 199 #
 200 #    while (my ($name, $info) = each %$features) {
 201 #        $self->log_info("  $name" . '.' x ($max_name_len - length($name) + 4));
 202 #        if ($name eq 'PL_files') {
 203 #            print "got $name => $info\n";
 204 #            print "info has:\n";
 205 #            while (my ($key, $val) = each %$info) {
 206 #                print "  $key => $val\n";
 207 #            }
 208 #        }
 209 #
 210 #        if ( my $failures = $self->prereq_failures($info) ) {
 211 #            my $disabled = grep( /^(?:\w+_)?(?:$checking_types)$/, keys %$failures ) ? 1 : 0;
 212 #            $self->log_info( $disabled ? "disabled\n" : "enabled\n" );
 213 #
 214 #            my $log_text;
 215 #            while (my ($type, $prereqs) = each %$failures) {
 216 #                while (my ($module, $status) = each %$prereqs) {
 217 #                    my $required = ($type =~ /^(?:\w+_)?(?:requires|conflicts)$/) ? 1 : 0;
 218 #                    my $prefix = ($required) ? '-' : '*';
 219 #                    $log_text .= "    $prefix $status->{message}\n";
 220 #                }
 221 #            }
 222 #            $self->log_warn($log_text) if $log_text && ! $self->quiet;
 223 #        }
 224 #        else {
 225 #            $self->log_info("enabled\n");
 226 #        }
 227 #    }
 228 #
 229 #    $self->log_info("\n");
 230 #}
 231
 232 # TODO: STDERR output redirect is causing some installations to fail, commenting
 233 # out until a fix is in place
 234
 235 # overriden just to hide pointless ugly warnings
 236 #sub check_installed_status {
 237 #    my $self = shift;
 238 #
 239 #    open (my $olderr, ">&". fileno(STDERR));
 240 #    my $null = ($^O =~ m/mswin/i) ? 'NUL' : '/dev/null';
 241 #    open(STDERR, $null);
 242 #    my $return = $self->SUPER::check_installed_status(@_);
 243 #    open(STDERR, ">&". fileno($olderr));
 244 #    return $return;
 245 #}
 246
 247 # extend to handle option checking (which takes an array ref) and code test
 248 # checking (which takes a code ref and must return a message only on failure)
 249 # and excludes_os (which takes an array ref of regexps).
 250 # also handles more informative output of recommends section
 251
 252 #sub prereq_failures {
 253 #    my ($self, $info) = @_;
 254 #
 255 #    my @types = (@{ $self->prereq_action_types }, @extra_types);
 256 #    $info ||= {map {$_, $self->$_()} @types};
 257 #
 258 #    my $out = {};
 259 #    foreach my $type (@types) {
 260 #        my $prereqs = $info->{$type} || next;
 261 #
 262 #        my $status = {};
 263 #        if ($type eq 'test') {
 264 #            unless (keys %$out) {
 265 #                if (ref($prereqs) eq 'CODE') {
 266 #                    $status->{message} = &{$prereqs};
 267 #
 268 #                    # drop the code-ref to avoid Module::Build trying to store
 269 #                    # it with Data::Dumper, generating warnings. (And also, may
 270 #                    # be expensive to run the sub multiple times.)
 271 #                    $info->{$type} = $status->{message};
 272 #                }
 273 #                else {
 274 #                    $status->{message} = $prereqs;
 275 #                }
 276 #                $out->{$type}{'test'} = $status if $status->{message};
 277 #            }
 278 #        }
 279 #        elsif ($type eq 'options') {
 280 #            my @not_ok;
 281 #            foreach my $wanted_option (@{$prereqs}) {
 282 #                unless ($self->args($wanted_option)) {
 283 #                    push(@not_ok, $wanted_option);
 284 #                }
 285 #            }
 286 #
 287 #            if (@not_ok > 0) {
 288 #                $status->{message} = "Command line option(s) '@not_ok' not supplied";
 289 #                $out->{$type}{'options'} = $status;
 290 #            }
 291 #        }
 292 #        elsif ($type eq 'excludes_os') {
 293 #            foreach my $os (@{$prereqs}) {
 294 #                if ($^O =~ /$os/i) {
 295 #                    $status->{message} = "This feature isn't supported under your OS ($os)";
 296 #                    $out->{$type}{'excludes_os'} = $status;
 297 #                    last;
 298 #                }
 299 #            }
 300 #        }
 301 #        else {
 302 #            while ( my ($modname, $spec) = each %$prereqs ) {
 303 #                $status = $self->check_installed_status($modname, $spec);
 304 #                next if $status->{ok};
 305 #
 306 #                if ($type =~ /^(?:\w+_)?conflicts$/) {
 307 #                    $status->{conflicts} = delete $status->{need};
 308 #                    $status->{message} = "$modname ($status->{have}) conflicts with this distribution";
 309 #                }
 310 #                elsif ($type =~ /^(?:\w+_)?recommends$/) {
 311 #                    my ($preferred_version, $why, $by_what) = split("/", $spec);
 312 #                    $by_what = join(", ", split(",", $by_what));
 313 #                    $by_what =~ s/, (\S+)$/ and $1/;
 314 #
 315 #                    $status->{message} = (!ref($status->{have}) && $status->{have} eq '<none>'
 316 #                                  ? "Optional prerequisite $modname is not installed"
 317 #                                  : "$modname ($status->{have}) is installed, but we prefer to have $preferred_version");
 318 #
 319 #                    $status->{message} .= "\n   (wanted for $why, used by $by_what)";
 320 #
 321 #                    if ($by_what =~ /\[circular dependency!\]/) {
 322 #                        $preferred_version = -1;
 323 #                    }
 324 #
 325 #                    #my $installed = $self->install_optional($modname, $preferred_version, $status->{message});
 326 #                    #next if $installed eq 'ok';
 327 #                    #$status->{message} = $installed unless $installed eq 'skip';
 328 #                }
 329 #                elsif ($type =~ /^feature_requires/) {
 330 #                    # if there is a test code-ref, drop it to avoid
 331 #                    # Module::Build trying to store it with Data::Dumper,
 332 #                    # generating warnings.
 333 #                    delete $info->{test};
 334 #                }
 335 #                else {
 336 #                    my $installed = $self->install_required($modname, $spec, $status->{message});
 337 #                    next if $installed eq 'ok';
 338 #                    $status->{message} = $installed;
 339 #                }
 340 #
 341 #                $out->{$type}{$modname} = $status;
 342 #            }
 343 #        }
 344 #    }
 345 #
 346 #    return keys %{$out} ? $out : return;
 347 #}
 348
 349 # install an external module using CPAN prior to testing and installation
 350 # should only be called by install_required or install_optional
 351 #sub install_prereq {
 352 #    my ($self, $desired, $version, $required) = @_;
 353 #
 354 #    if ($self->under_cpan) {
 355 #        # Just add to the required hash, which CPAN >= 1.81 will check prior
 356 #        # to install
 357 #        $self->{properties}{requires}->{$desired} = $version;
 358 #        $self->log_info("   I'll get CPAN to prepend the installation of this\n");
 359 #        return 'ok';
 360 #    }
 361 #    else {
 362 #        my $question = $required ?  "$desired is absolutely required prior to installation: shall I install it now using a CPAN shell?" :
 363 #                                    "To install $desired I'll need to open a CPAN shell right now; is that OK?";
 364 #        my $do_install = $self->y_n($question.' y/n', 'y');
 365 #
 366 #        if ($do_install) {
 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.
 370 #            require Cwd;
 371 #            require CPAN;
 372 #
 373 #            # Save this because CPAN will chdir all over the place.
 374 #            my $cwd = Cwd::cwd();
 375 #
 376 #            CPAN::Shell->install($desired);
 377 #            my $msg;
 378 #            my $expanded = CPAN::Shell->expand("Module", $desired);
 379 #            if ($expanded && $expanded->uptodate) {
 380 #                $self->log_info("\n\n*** (back in BioPerl Build.PL) ***\n * You chose to install $desired and it installed fine\n");
 381 #                $msg = 'ok';
 382 #            }
 383 #            else {
 384 #                $self->log_info("\n\n*** (back in BioPerl Build.PL) ***\n");
 385 #                $msg = "You chose to install $desired but it failed to install";
 386 #            }
 387 #
 388 #            chdir $cwd or die "Cannot chdir() back to $cwd: $!";
 389 #            return $msg;
 390 #        }
 391 #        else {
 392 #            return $required ? "You chose not to install the REQUIRED module $desired: you'd better install it yourself manually!" :
 393 #                               "Even though you wanted the optional module $desired, you chose not to actually install it: do it yourself manually.";
 394 #        }
 395 #    }
 396 #}
 397
 398 # install required modules listed in 'requires' or 'build_requires' arg to
 399 # new that weren't already installed. Should only be called by prereq_failures
 400 #sub install_required {
 401 #    my ($self, $desired, $version, $msg) = @_;
 402 #
 403 #    $self->log_info(" - ERROR: $msg\n");
 404 #
 405 #    return $self->install_prereq($desired, $version, 1);
 406 #}
 407
 408 # install optional modules listed in 'recommends' arg to new that weren't
 409 # already installed. Should only be called by prereq_failures
 410 #sub install_optional {
 411 #    my ($self, $desired, $version, $msg) = @_;
 412 #
 413 #    unless (defined $self->{ask_optional}) {
 414 #        $self->{ask_optional} = $self->args->{accept}
 415 #                              ? 'n' : $self->prompt("Install [a]ll optional external modules, [n]one, or choose [i]nteractively?", 'n');
 416 #    }
 417 #    return 'skip' if $self->{ask_optional} =~ /^n/i;
 418 #
 419 #    my $install;
 420 #    if ($self->{ask_optional} =~ /^a/i) {
 421 #        $self->log_info(" * $msg\n");
 422 #        $install = 1;
 423 #    }
 424 #    else {
 425 #        $install = $self->y_n(" * $msg\n   Do you want to install it? y/n", 'n');
 426 #    }
 427 #
 428 #    my $orig_version = $version;
 429 #    $version = 0 if $version == -1;
 430 #    if ($install && ! ($self->{ask_optional} =~ /^a/i && $orig_version == -1)) {
 431 #        return $self->install_prereq($desired, $version);
 432 #    }
 433 #    else {
 434 #        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." : '';
 435 #        $self->log_info(" * You chose not to install $desired$circular\n");
 436 #        return 'ok';
 437 #    }
 438 #}
 439
 440 # there's no official way to discover if being run by CPAN, we take an approach
 441 # similar to that of Module::AutoInstall
 442 #sub under_cpan {
 443 #    my $self = shift;
 444 #
 445 #    unless (defined $self->{under_cpan}) {
 446 #        ## modified from Module::AutoInstall
 447 #
 448 #        my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING};
 449 #        if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) {
 450 #            $self->{under_cpan} = $cpan_env ? 'CPAN' : 'CPANPLUS';
 451 #        }
 452 #
 453 #        require CPAN;
 454 #
 455 #        unless (defined $self->{under_cpan}) {
 456 #            if ($CPAN::VERSION > '1.89') {
 457 #                if ($cpan_env) {
 458 #                    $self->{under_cpan} = 'CPAN';
 459 #                }
 460 #                else {
 461 #                    $self->{under_cpan} = 0;
 462 #                }
 463 #            }
 464 #        }
 465 #
 466 #        unless (defined $self->{under_cpan}) {
 467 #            # load cpan config
 468 #            if ($CPAN::HandleConfig::VERSION) {
 469 #                # Newer versions of CPAN have a HandleConfig module
 470 #                CPAN::HandleConfig->load;
 471 #            }
 472 #            else {
 473 #                # Older versions had the load method in Config directly
 474 #                CPAN::Config->load;
 475 #            }
 476 #
 477 #            # Find the CPAN lock-file
 478 #            my $lock = File::Spec->catfile($CPAN::Config->{cpan_home}, '.lock');
 479 #            if (-f $lock) {
 480 #                # Module::AutoInstall now goes on to open the lock file and compare
 481 #                # its pid to ours, but we're not in a situation where we expect
 482 #                # the pids to match, so we take the windows approach for all OSes:
 483 #                # find out if we're in cpan_home
 484 #                my $cwd  = File::Spec->canonpath(Cwd::cwd());
 485 #                my $cpan = File::Spec->canonpath($CPAN::Config->{cpan_home});
 486 #
 487 #                $self->{under_cpan} = index($cwd, $cpan) > -1;
 488 #            }
 489 #        }
 490 #
 491 #        if ($self->{under_cpan}) {
 492 #            $self->log_info("(I think I'm being run by CPAN/CPANPLUS, so will rely on it to handle prerequisite installation)\n");
 493 #        }
 494 #        else {
 495 #            $self->log_info("(I think you ran Build.PL directly, so will use CPAN to install prerequisites on demand)\n");
 496 #            $self->{under_cpan} = 0;
 497 #        }
 498 #    }
 499 #
 500 #    return $self->{under_cpan};
 501 #}
 502
 503 =head2 prompt
 504
 505 Overridden simply to not print the default answer if chosen by hitting return
 506 =cut
 507
 508 sub prompt {
 509     my $self = shift;
 510     my $mess = shift or die "prompt() called without a prompt message";
 511
 512     my $def;
 513     if ( $self->_is_unattended && !@_ ) {
 514         die <<EOF;
 515 ERROR: This build seems to be unattended, but there is no default value
 516 for this question.  Aborting.
 517 EOF
 518     }
 519     $def = shift if @_;
 520     ($def, my $dispdef) = defined $def ? ($def, "[$def] ") : ('', ' ');
 521
 522     local $|=1;
 523     print "$mess $dispdef";
 524
 525     my $ans = $self->_readline();
 526
 527     if ( !defined($ans)        # Ctrl-D or unattended
 528          or !length($ans) ) {  # User hit return
 529         #print "$def\n"; didn't like this!
 530         $ans = $def;
 531     }
 532
 533     return $ans;
 534 }
 535
 536 =head2 find_dist_packages
 537
 538 Like the Module::Build version, except that we always get version from
 539 dist_version
 540
 541 =cut
 542
 543 #sub find_dist_packages {
 544 #    my $self = shift;
 545 #
 546 #    # Only packages in .pm files are candidates for inclusion here.
 547 #    # Only include things in the MANIFEST, not things in developer's
 548 #    # private stock.
 549 #
 550 #    my $manifest = $self->_read_manifest('MANIFEST') or die "Can't find dist packages without a MANIFEST file - run 'manifest' action first";
 551 #
 552 #    # Localize
 553 #    my %dist_files = map { $self->localize_file_path($_) => $_ } keys %$manifest;
 554 #
 555 #    my @pm_files = grep {exists $dist_files{$_}} keys %{ $self->find_pm_files };
 556 #
 557 #    my $actual_version = $self->dist_version;
 558 #
 559 #    # First, we enumerate all packages & versions,
 560 #    # seperating into primary & alternative candidates
 561 #    my( %prime, %alt );
 562 #    foreach my $file (@pm_files) {
 563 #        next if $dist_files{$file} =~ m{^t/};  # Skip things in t/
 564 #
 565 #        my @path = split( /\//, $dist_files{$file} );
 566 #        (my $prime_package = join( '::', @path[1..$#path] )) =~ s/\.pm$//;
 567 #
 568 #        my $pm_info = Module::Build::ModuleInfo->new_from_file( $file );
 569 #
 570 #        foreach my $package ( $pm_info->packages_inside ) {
 571 #            next if $package eq 'main';  # main can appear numerous times, ignore
 572 #            next if grep /^_/, split( /::/, $package ); # private package, ignore
 573 #
 574 #            my $version = $pm_info->version( $package );
 575 #            if ($version && $version != $actual_version) {
 576 #                $self->log_warn("Package $package had version $version!\n");
 577 #            }
 578 #            $version = $actual_version;
 579 #
 580 #            if ( $package eq $prime_package ) {
 581 #                if ( exists( $prime{$package} ) ) {
 582 #                    # M::B::ModuleInfo will handle this conflict
 583 #                    die "Unexpected conflict in '$package'; multiple versions found.\n";
 584 #                }
 585 #                else {
 586 #                    $prime{$package}{file} = $dist_files{$file};
 587 #                    $prime{$package}{version} = $version if defined( $version );
 588 #                }
 589 #            }
 590 #            else {
 591 #                push( @{$alt{$package}}, { file => $dist_files{$file}, version => $version } );
 592 #            }
 593 #        }
 594 #    }
 595 #
 596 #    # Then we iterate over all the packages found above, identifying conflicts
 597 #    # and selecting the "best" candidate for recording the file & version
 598 #    # for each package.
 599 #    foreach my $package ( keys( %alt ) ) {
 600 #        my $result = $self->_resolve_module_versions( $alt{$package} );
 601 #
 602 #        if ( exists( $prime{$package} ) ) { # primary package selected
 603 #            if ( $result->{err} ) {
 604 #                # Use the selected primary package, but there are conflicting
 605 #                 # errors amoung multiple alternative packages that need to be
 606 #                 # reported
 607 #                 $self->log_warn("Found conflicting versions for package '$package'\n" .
 608 #                                 "  $prime{$package}{file} ($prime{$package}{version})\n" . $result->{err});
 609 #            }
 610 #            elsif ( defined( $result->{version} ) ) {
 611 #                # There is a primary package selected, and exactly one
 612 #                # alternative package
 613 #
 614 #                if ( exists( $prime{$package}{version} ) && defined( $prime{$package}{version} ) ) {
 615 #                    # Unless the version of the primary package agrees with the
 616 #                    # version of the alternative package, report a conflict
 617 #                    if ( $self->compare_versions( $prime{$package}{version}, '!=', $result->{version} ) ) {
 618 #                        $self->log_warn("Found conflicting versions for package '$package'\n" .
 619 #                                        "  $prime{$package}{file} ($prime{$package}{version})\n" .
 620 #                                        "  $result->{file} ($result->{version})\n");
 621 #                    }
 622 #                }
 623 #                else {
 624 #                  # The prime package selected has no version so, we choose to
 625 #                  # use any alternative package that does have a version
 626 #                  $prime{$package}{file}    = $result->{file};
 627 #                  $prime{$package}{version} = $result->{version};
 628 #                }
 629 #            }
 630 #            else {
 631 #                # no alt package found with a version, but we have a prime
 632 #                # package so we use it whether it has a version or not
 633 #            }
 634 #        }
 635 #        else { # No primary package was selected, use the best alternative
 636 #            if ( $result->{err} ) {
 637 #                $self->log_warn("Found conflicting versions for package '$package'\n" . $result->{err});
 638 #            }
 639 #
 640 #            # Despite possible conflicting versions, we choose to record
 641 #            # something rather than nothing
 642 #            $prime{$package}{file}    = $result->{file};
 643 #            $prime{$package}{version} = $result->{version} if defined( $result->{version} );
 644 #        }
 645 #    }
 646 #
 647 #    # Stringify versions
 648 #    for my $key ( grep { exists $prime{$_}->{version} }
 649 #                  keys %prime ) {
 650 #        $prime{$key}->{version}
 651 #            = $prime{$key}->{version}->stringify if ref($prime{$key}->{version});
 652 #    }
 653 #
 654 #    return \%prime;
 655 #}
 656
 657 # our recommends syntax contains extra info that needs to be ignored at this
 658 # stage
 659 #sub _parse_conditions {
 660 #    my ($self, $spec) = @_;
 661 #
 662 #    ($spec) = split("/", $spec);
 663 #
 664 #    if ($spec =~ /^\s*([\w.]+)\s*$/) { # A plain number, maybe with dots, letters, and underscores
 665 #        return (">= $spec");
 666 #    }
 667 #    else {
 668 #        return split /\s*,\s*/, $spec;
 669 #    }
 670 #}
 671
 672 # when generating META.yml, we output optional_features syntax (instead of
 673 # recommends syntax). Note that as of CPAN v1.9402 nothing useful is done
 674 # with this information, which is why we implement our own request to install
 675 # the optional modules in install_optional().
 676 # Also note that CPAN PLUS complains with an [ERROR] when it sees this META.yml,
 677 # but it isn't fatal and installation continues fine.
 678
 679 # 'recommends' groups broken up now into separate modules and grouping the
 680 # 'requires' instead of lumping modules together (quotes were choking YAML
 681 # parsing). Now passes Parse::CPAN::Meta w/o errors.
 682 # -cjfields 9-17-09
 683
 684 # let us store extra things persistently in _build
 685 #sub _construct {
 686 #    my $self = shift;
 687 #
 688 #    # calling SUPER::_construct will dump some of the input to this sub out
 689 #    # with Data::Dumper, which will complain about code refs. So we replace
 690 #    # any code refs with dummies first, then put them back afterwards
 691 #    my %in_hash = @_;
 692 #    my $auto_features = $in_hash{auto_features} if defined $in_hash{auto_features};
 693 #    my %code_refs;
 694 #    if ($auto_features) {
 695 #        while (my ($key, $hash) = each %{$auto_features}) {
 696 #            while (my ($sub_key, $val) = each %{$hash}) {
 697 #                if (ref($val) && ref($val) eq 'CODE') {
 698 #                    $hash->{$sub_key} = 'CODE_ref';
 699 #                    $code_refs{$key}->{$sub_key} = $val;
 700 #                }
 701 #            }
 702 #        }
 703 #    }
 704 #
 705 #    $self = $self->SUPER::_construct(@_);
 706 #
 707 #    my ($p, $ph) = ($self->{properties}, $self->{phash});
 708 #
 709 #    if (keys %code_refs) {
 710 #        while (my ($key, $hash) = each %{$auto_features}) {
 711 #            if (defined $code_refs{$key}) {
 712 #                while (my ($sub_key, $code_ref) = each %{$code_refs{$key}}) {
 713 #                    $hash->{$sub_key} = $code_ref;
 714 #                }
 715 #                $ph->{auto_features}->{$key} = $hash;
 716 #            }
 717 #        }
 718 #    }
 719 #
 720 #    foreach my $piece (qw(manifest_skip post_install_scripts)) {
 721 #        my $file = File::Spec->catfile($self->config_dir, $piece);
 722 #        $ph->{$piece} = Module::Build::Notes->new(file => $file);
 723 #        $ph->{$piece}->restore if -e $file;
 724 #    }
 725 #
 726 #    return $self;
 727 #}
 728
 729 #sub write_config {
 730 #    my $self = shift;
 731 #    $self->SUPER::write_config;
 732 #
 733 #    # write extra things
 734 #    $self->{phash}{$_}->write() foreach qw(manifest_skip post_install_scripts);
 735 #
 736 #    # be even more certain we can reload ourselves during a resume by copying
 737 #    # ourselves to _build\lib
 738 #    # this is only possible for the core distribution where we are actually
 739 #    # present in the distribution
 740 #    my $self_filename = File::Spec->catfile('Bio', 'Root', 'Build.pm');
 741 #    -e $self_filename || return;
 742 #
 743 #    my $filename = File::Spec->catfile($self->{properties}{config_dir}, 'lib', 'Bio', 'Root', 'Build.pm');
 744 #    my $filedir  = File::Basename::dirname($filename);
 745 #
 746 #    File::Path::mkpath($filedir);
 747 #    warn "Could not create directory '$filedir': $!\n" unless -d $filedir;
 748 #
 749 #    File::Copy::copy($self_filename, $filename);
 750 #    warn "Unable to copy 'Bio/Root/Build.pm' to '$filename'\n" unless -e $filename;
 751 #}
 752
 753 # add a file to the default MANIFEST.SKIP
 754 #sub add_to_manifest_skip {
 755 #    my $self = shift;
 756 #    my %files = map {$self->localize_file_path($_), 1} @_;
 757 #    $self->{phash}{manifest_skip}->write(\%files);
 758 #}
 759
 760 =head2 ACTION_manifest
 761
 762 We always generate a new MANIFEST instead of allowing existing files to remain
 763 MANIFEST.SKIP is left alone
 764 =cut
 765
 766 sub ACTION_manifest {
 767     my ($self) = @_;
 768     if ( -e 'MANIFEST' || -e 'MANIFEST.SKIP' ) {
 769         $self->log_warn("MANIFEST files already exist, will overwrite them\n");
 770         unlink('MANIFEST');
 771     }
 772     require ExtUtils::Manifest;  # ExtUtils::Manifest is not warnings clean.
 773     local ($^W, $ExtUtils::Manifest::Quiet) = (0,1);
 774     ExtUtils::Manifest::mkmanifest();
 775 }
 776
 777 # extended to add extra things to the default MANIFEST.SKIP
 778 #sub _write_default_maniskip {
 779 #    my $self = shift;
 780 #    $self->SUPER::_write_default_maniskip;
 781 #
 782 #    my @extra = keys %{$self->{phash}{manifest_skip}->read};
 783 #    if (@extra) {
 784 #        open(my $fh, '>>', 'MANIFEST.SKIP') or die "Could not append MANIFEST.SKIP file\n";
 785 #        print $fh "\n# Avoid additional run-time generated things\n";
 786 #        foreach my $line (@extra) {
 787 #            print $fh $line, "\n";
 788 #        }
 789 #        close($fh);
 790 #    }
 791 #}
 792
 793
 794 =head2 ACTION_install
 795
 796 Extended to run scripts post-installation
 797 =cut
 798
 799 sub ACTION_install {
 800     my ($self) = @_;
 801     require ExtUtils::Install;
 802     $self->depends_on('build');
 803     ExtUtils::Install::install($self->install_map,
 804                                !$self->quiet,
 805                                0,
 806                                $self->{args}{uninst} || 0);
 807     #$self->run_post_install_scripts;
 808 }
 809
 810 #sub add_post_install_script {
 811 #    my $self = shift;
 812 #    my %files = map {$self->localize_file_path($_), 1} @_;
 813 #    $self->{phash}{post_install_scripts}->write(\%files);
 814 #}
 815 #
 816 #sub run_post_install_scripts {
 817 #    my $self = shift;
 818 #    my @scripts = keys %{$self->{phash}{post_install_scripts}->read};
 819 #    foreach my $script (@scripts) {
 820 #        $self->run_perl_script($script);
 821 #    }
 822 #}
 823
 824 =head2 test_internet
 825
 826 For use with auto_features, which should require LWP::UserAgent as one of
 827 its reqs
 828
 829 Note: as of 4-11-11, this is no longer called - if someone wants to run
 830 network tests (off by default) w/o a network, then they are hanging themselves
 831 by their own shoelaces.
 832 =cut
 833
 834 sub test_internet {
 835     eval {require LWP::UserAgent;};
 836     if ($@) {
 837         # ideally this won't happen because auto_feature already specified
 838         # LWP::UserAgent, so this sub wouldn't get called if LWP not installed
 839         return "LWP::UserAgent not installed";
 840     }
 841     my $ua = LWP::UserAgent->new;
 842     $ua->timeout(10);
 843     $ua->env_proxy;
 844     my $response = $ua->get('http://search.cpan.org/');
 845     unless ($response->is_success) {
 846         return "Could not connect to the internet (http://search.cpan.org/)";
 847     }
 848     return;
 849 }
 850
 851 =head2 dist_dir
 852
 853 Nice directory names for dist-related actions
 854 =cut
 855
 856 sub dist_dir {
 857     my ($self) = @_;
 858     my $version = $self->dist_version;
 859     if ($version =~ /^\d\.\d{6}\d$/) {
 860         # 1.x.x.100 returned as 1.x.x.1
 861         $version .= '00';
 862     }
 863     $version =~ s/00(\d)/$1./g;
 864     $version =~ s/\.$//;
 865
 866     if (my ($minor, $rev) = $version =~ /^\d\.(\d)\.\d\.(\d+)$/) {
 867         my $dev = ! ($minor % 2 == 0);
 868         if ($rev == 100) {
 869             my $replace = $dev ? "_$rev" : '';
 870             $version =~ s/\.\d+$/$replace/;
 871         }
 872         elsif ($rev < 100) {
 873             $rev = sprintf("%03d", $rev);
 874             $version =~ s/\.\d+$/_$rev-RC/;
 875         }
 876         else {
 877             $rev -= 100 unless $dev;
 878             my $replace = $dev ? "_$rev" : ".$rev";
 879             $version =~ s/\.\d+$/$replace/;
 880         }
 881     }
 882
 883     return "$self->{properties}{dist_name}-$version";
 884 }
 885
 886 # try to be as consistent as possible with Module::Build API
 887 #sub ppm_name {
 888 #    my $self = shift;
 889 #    return $self->dist_dir.'-ppm';
 890 #}
 891
 892 # generate complete ppd4 version file
 893 #sub ACTION_ppd {
 894 #    my $self = shift;
 895 #
 896 #    my $file = $self->make_ppd(%{$self->{args}});
 897 #    $self->add_to_cleanup($file);
 898 #    #$self->add_to_manifest_skip($file);
 899 #}
 900
 901 # add pod2htm temp files to MANIFEST.SKIP, generated during ppmdist most likely
 902 #sub htmlify_pods {
 903 #    my $self = shift;
 904 #    $self->SUPER::htmlify_pods(@_);
 905 #    #$self->add_to_manifest_skip('pod2htm*');
 906 #}
 907
 908 =head2 ACTION_ppmdist
 909
 910 Don't copy across man3 docs since they're of little use under Windows and
 911 have bad filenames
 912 =cut
 913
 914 sub ACTION_ppmdist {
 915     my $self = shift;
 916     my @types = $self->install_types(1);
 917     $self->SUPER::ACTION_ppmdist(@_);
 918     $self->install_types(0);
 919 }
 920
 921 =head2 install_types
 922
 923 When supplied a true value, pretends libdoc doesn't exist (preventing man3
 924 installation for ppmdist). when supplied false, they exist again
 925 =cut
 926
 927 sub install_types {
 928     my ($self, $no_libdoc) = @_;
 929     $self->{no_libdoc} = $no_libdoc if defined $no_libdoc;
 930     my @types = $self->SUPER::install_types;
 931     if ($self->{no_libdoc}) {
 932         my @altered_types;
 933         foreach my $type (@types) {
 934             push(@altered_types, $type) unless $type eq 'libdoc';
 935         }
 936         return @altered_types;
 937     }
 938     return @types;
 939 }
 940
 941 # overridden from Module::Build::PPMMaker for ppd4 compatability
 942
 943 # note: no longer needed with more recent versions of Module::Build
 944
 945 #sub make_ppd {
 946 #    my ($self, %args) = @_;
 947 #
 948 #    require Module::Build::PPMMaker;
 949 #    my $mbp = Module::Build::PPMMaker->new();
 950 #
 951 #    my %dist;
 952 #    foreach my $info (qw(name author abstract version)) {
 953 #        my $method = "dist_$info";
 954 #        $dist{$info} = $self->$method() or die "Can't determine distribution's $info\n";
 955 #    }
 956 #    $dist{codebase} = $self->ppm_name.'.tar.gz';
 957 #    $mbp->_simple_xml_escape($_) foreach $dist{abstract}, $dist{codebase}, @{$dist{author}};
 958 #
 959 #    my (undef, undef, undef, $mday, $mon, $year) = localtime();
 960 #    $year += 1900;
 961 #    $mon++;
 962 #    my $date = "$year-$mon-$mday";
 963 #
 964 #    my $softpkg_version = $self->dist_dir;
 965 #    $softpkg_version =~ s/^$dist{name}-//;
 966 #
 967 #    # to avoid a ppm bug, instead of including the requires in the softpackage
 968 #    # for the distribution we're making, we'll make a seperate Bundle::
 969 #    # softpackage that contains all the requires, and require only the Bundle in
 970 #    # the real softpackage
 971 #    my ($bundle_name) = $dist{name} =~ /^.+-(.+)/;
 972 #    $bundle_name ||= 'core';
 973 #    $bundle_name =~ s/^(\w)/\U$1/;
 974 #    my $bundle_dir = "Bundle-BioPerl-$bundle_name-$softpkg_version-ppm";
 975 #    my $bundle_file = "$bundle_dir.tar.gz";
 976 #    my $bundle_softpkg_name = "Bundle-BioPerl-$bundle_name";
 977 #    $bundle_name = "Bundle::BioPerl::$bundle_name";
 978 #
 979 #    # header
 980 #    my $ppd = <<"PPD";
 981 #    <SOFTPKG NAME=\"$dist{name}\" VERSION=\"$softpkg_version\" DATE=\"$date\">
 982 #        <TITLE>$dist{name}</TITLE>
 983 #        <ABSTRACT>$dist{abstract}</ABSTRACT>
 984 #@{[ join "\n", map "        <AUTHOR>$_</AUTHOR>", @{$dist{author}} ]}
 985 #        <PROVIDE NAME=\"$dist{name}::\" VERSION=\"$dist{version}\"/>
 986 #PPD
 987 #
 988 #    # provide section
 989 #    foreach my $pm (@{$self->rscan_dir('Bio', qr/\.pm$/)}) {
 990 #        # convert these filepaths to Module names
 991 #        $pm =~ s/\//::/g;
 992 #        $pm =~ s/\.pm//;
 993 #
 994 #        $ppd .= sprintf(<<'EOF', $pm, $dist{version});
 995 #        <PROVIDE NAME="%s" VERSION="%s"/>
 996 #EOF
 997 #    }
 998 #
 999 #    # rest of softpkg
1000 #    $ppd .= <<"PPD";
1001 #        <IMPLEMENTATION>
1002 #            <ARCHITECTURE NAME=\"MSWin32-x86-multi-thread-5.8\"/>
1003 #            <CODEBASE HREF=\"$dist{codebase}\"/>
1004 #            <REQUIRE NAME=\"$bundle_name\" VERSION=\"$dist{version}\"/>
1005 #        </IMPLEMENTATION>
1006 #    </SOFTPKG>
1007 #PPD
1008 #
1009 #    # now a new softpkg for the bundle
1010 #    $ppd .= <<"PPD";
1011 #
1012 #    <SOFTPKG NAME=\"$bundle_softpkg_name\" VERSION=\"$softpkg_version\" DATE=\"$date\">
1013 #        <TITLE>$bundle_name</TITLE>
1014 #        <ABSTRACT>Bundle of pre-requisites for $dist{name}</ABSTRACT>
1015 #@{[ join "\n", map "        <AUTHOR>$_</AUTHOR>", @{$dist{author}} ]}
1016 #        <PROVIDE NAME=\"$bundle_name\" VERSION=\"$dist{version}\"/>
1017 #        <IMPLEMENTATION>
1018 #            <ARCHITECTURE NAME=\"MSWin32-x86-multi-thread-5.8\"/>
1019 #            <CODEBASE HREF=\"$bundle_file\"/>
1020 #PPD
1021 #
1022 #    # required section
1023 #    # we do both requires and recommends to make installation on Windows as
1024 #    # easy (mindless) as possible
1025 #    for my $type ('requires', 'recommends') {
1026 #        my $prereq = $self->$type;
1027 #        while (my ($modname, $version) = each %$prereq) {
1028 #            next if $modname eq 'perl';
1029 #            ($version) = split("/", $version) if $version =~ /\//;
1030 #
1031 #            # Module names must have at least one ::
1032 #            unless ($modname =~ /::/) {
1033 #                $modname .= '::';
1034 #            }
1035 #
1036 #            # Bio::Root::Version number comes out as triplet number like 1.5.2;
1037 #            # convert to our own version
1038 #            if ($modname eq 'Bio::Root::Version') {
1039 #                $version = $dist{version};
1040 #            }
1041 #
1042 #            $ppd .= sprintf(<<'EOF', $modname, $version || '');
1043 #            <REQUIRE NAME="%s" VERSION="%s"/>
1044 #EOF
1045 #        }
1046 #    }
1047 #
1048 #    # footer
1049 #    $ppd .= <<'EOF';
1050 #        </IMPLEMENTATION>
1051 #    </SOFTPKG>
1052 #EOF
1053 #
1054 #    my $ppd_file = "$dist{name}.ppd";
1055 #    my $fh = IO::File->new(">$ppd_file") or die "Cannot write to $ppd_file: $!";
1056 #    print $fh $ppd;
1057 #    close $fh;
1058 #
1059 #    $self->delete_filetree($bundle_dir);
1060 #    mkdir($bundle_dir) or die "Cannot create '$bundle_dir': $!";
1061 #    $self->make_tarball($bundle_dir);
1062 #    $self->delete_filetree($bundle_dir);
1063 #    $self->add_to_cleanup($bundle_file);
1064 #    #$self->add_to_manifest_skip($bundle_file);
1065 #
1066 #    return $ppd_file;
1067 #}
1068
1069 =head2 ACTION_dist
1070
1071 We make all archive formats we want, not just .tar.gz
1072 we also auto-run manifest action, since we always want to re-create
1073 MANIFEST and MANIFEST.SKIP just-in-time
1074 =cut
1075
1076 sub ACTION_dist {
1077     my ($self) = @_;
1078
1079     $self->depends_on('manifest');
1080     $self->depends_on('distdir');
1081
1082     my $dist_dir = $self->dist_dir;
1083
1084     $self->make_zip($dist_dir);
1085     $self->make_tarball($dist_dir);
1086     $self->delete_filetree($dist_dir);
1087 }
1088
1089 =head2 ACTION_clean
1090
1091 Define custom clean/realclean actions to rearrange config file cleanup
1092 =cut
1093
1094 sub ACTION_clean {
1095     my ($self) = @_;
1096     $self->log_info("Cleaning up build files\n");
1097     foreach my $item (map glob($_), $self->cleanup) {
1098         $self->delete_filetree($item);
1099     }
1100     $self->log_info("Cleaning up configuration files\n");
1101     $self->delete_filetree($self->config_dir);
1102 }
1103
1104 =head2 ACTION_realclean
1105
1106 Define custom clean/realclean actions to rearrange config file cleanup
1107 =cut
1108
1109 sub ACTION_realclean {
1110     my ($self) = @_;
1111     $self->depends_on('clean');
1112     for my $method (qw(mymetafile mymetafile2 build_script)) {
1113         if ($self->can($method)) {
1114             $self->delete_filetree($self->$method);
1115             $self->log_info("Cleaning up $method data\n");
1116         }
1117     }
1118 }
1119
1120 =head2 make_zip
1121
1122 Makes zip file for windows users and bzip2 files as well
1123 =cut
1124
1125 sub make_zip {
1126     my ($self, $dir, $file) = @_;
1127     $file ||= $dir;
1128
1129     $self->log_info("Creating $file.zip\n");
1130     my $zip_flags = $self->verbose ? '-r' : '-rq';
1131     $self->do_system($self->split_like_shell("zip"), $zip_flags, "$file.zip", $dir);
1132
1133     $self->log_info("Creating $file.bz2\n");
1134     require Archive::Tar;
1135     # Archive::Tar versions >= 1.09 use the following to enable a compatibility
1136     # hack so that the resulting archive is compatible with older clients.
1137     $Archive::Tar::DO_NOT_USE_PREFIX = 0;
1138     my $files = $self->rscan_dir($dir);
1139     Archive::Tar->create_archive("$file.tar", 0, @$files);
1140     $self->do_system($self->split_like_shell("bzip2"), "-k", "$file.tar");
1141 }
1142
1143 =head2 prompt_for_network
1144
1145 A method that can be called in a Build.PL script to ask the user if they want
1146 internet tests.
1147 Should only be called if you have tested for yourself that
1148 $build->feature('Network Tests') is true
1149 =cut
1150
1151 sub prompt_for_network {
1152     my ($self, $accept) = @_;
1153
1154     my $proceed = $accept ? 0 : $self->y_n(  "Do you want to run tests that require connection to servers across the internet\n"
1155                                            . "(likely to cause some failures)? y/n", 'n');
1156
1157     if ($proceed) {
1158         $self->notes('network' => 1);
1159         $self->log_info("  - will run internet-requiring tests\n");
1160         my $use_email = $self->y_n("Do you want to run tests requiring a valid email address? y/n",'n');
1161         if ($use_email) {
1162             my $address = $self->prompt("Enter email address:");
1163             $self->notes(email => $address);
1164         }
1165     }
1166     else {
1167         $self->notes(network => 0);
1168         $self->log_info("  - will not run internet-requiring tests\n");
1169     }
1170 }
1171
1172 =head2 print_build_script
1173
1174 Override the build script warnings flag
1175 =cut
1176
1177 sub print_build_script {
1178     my ($self, $fh) = @_;
1179
1180     my $build_package = $self->build_class;
1181
1182     my $closedata="";
1183
1184     my $config_requires;
1185     if ( -f $self->metafile ) {
1186         my $meta = eval { $self->read_metafile( $self->metafile ) };
1187         $config_requires = $meta && $meta->{configure_requires}{'Module::Build'};
1188     }
1189     $config_requires ||= 0;
1190
1191     my %q = map {$_, $self->$_()} qw(config_dir base_dir);
1192
1193     $q{base_dir} = Win32::GetShortPathName($q{base_dir}) if $self->is_windowsish;
1194
1195     $q{magic_numfile} = $self->config_file('magicnum');
1196
1197     my @myINC = $self->_added_to_INC;
1198     @myINC = map { $_ = File::Spec->canonpath( $_ );
1199                    $_ =~ s/([\\\'])/\\$1/g;
1200                    $_;
1201                   } @myINC;
1202     # Remove duplicates
1203     @myINC = sort {$a cmp $b}
1204              keys %{ { map { $_ => 1 } @myINC } };
1205
1206     foreach my $key (keys %q) {
1207         $q{$key} = File::Spec->canonpath( $q{$key} );
1208         $q{$key} =~ s/([\\\'])/\\$1/g;
1209     }
1210
1211     my $quoted_INC = join ",\n", map "         '$_'", @myINC;
1212     my $shebang = $self->_startperl;
1213     my $magic_number = $self->magic_number;
1214
1215     # unique to bioperl, shut off overly verbose warnings on windows, bug 3215
1216     my $w = $^O =~ /win/i ? '# no warnings (win)' : '$^W = 1;  # Use warnings';
1217
1218     print $fh <<EOF;
1219 $shebang
1220
1221 use strict;
1222 use Cwd;
1223 use File::Basename;
1224 use File::Spec;
1225
1226 sub magic_number_matches {
1227     return 0 unless -e '$q{magic_numfile}';
1228     open my \$FH, '<', '$q{magic_numfile}' or return 0;
1229     my \$filenum = <\$FH>;
1230     close \$FH;
1231     return \$filenum == $magic_number;
1232 }
1233
1234 my \$progname;
1235 my \$orig_dir;
1236 BEGIN {
1237     $w
1238     \$progname = basename(\$0);
1239     \$orig_dir = Cwd::cwd();
1240     my \$base_dir = '$q{base_dir}';
1241     if (!magic_number_matches()) {
1242         unless (chdir(\$base_dir)) {
1243             die ("Could not chdir '\$base_dir', aborting\\n");
1244         }
1245         unless (magic_number_matches()) {
1246             die ("Configuration seems to be out of date, please re-run 'perl Build.PL' again.\\n");
1247         }
1248     }
1249     unshift \@INC,
1250         (
1251 $quoted_INC
1252         );
1253 }
1254
1255 close(*DATA) unless eof(*DATA); # ensure no open handles to this script
1256
1257 use $build_package;
1258 Module::Build->VERSION(q{$config_requires});
1259
1260 # Some platforms have problems setting \$^X in shebang contexts, fix it up here
1261 \$^X = Module::Build->find_perl_interpreter;
1262
1263 if (-e 'Build.PL' and not $build_package->up_to_date('Build.PL', \$progname)) {
1264     warn "Warning: Build.PL has been altered.  You may need to run 'perl Build.PL' again.\\n";
1265 }
1266
1267 # This should have just enough arguments to be able to bootstrap the rest.
1268 my \$build =
1269     $build_package->resume( properties => { config_dir => '$q{config_dir}',
1270                                               orig_dir   => \$orig_dir, },
1271 );
1272
1273 \$build->dispatch;
1274 EOF
1275 }
1276
1277 1;