~ubuntu-branches/ubuntu/trusty/bioperl/trusty-proposed

« back to all changes in this revision

Viewing changes to ModuleBuildBioperl.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2009-03-10 07:19:11 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090310071911-fukqzw54pyb1f0bd
Tags: 1.6.0-2
* Removed patch system (not used):
  - removed instuctions in debian/rules;
  - removed quilt from Build-Depends in debian/control.
* Re-enabled tests:
  - uncommented test command in debian/rules;
  - uncommented previously missing build-dependencies in debian/control.
  - Re-enabled tests and uncommented build-dependencies accordingly.
* Removed libmodule-build-perl and libtest-harness-perl from
  Build-Depends-Indep (provided by perl-modules).
* Better cleaning of empty directories using find -type d -empty -delete
  instead of rmdir in debian/rules (LP: #324001).

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
#!/usr/bin/perl -w
2
 
 
3
 
# This is a subclass of Module::Build so we can override certain methods and do
4
 
# fancy stuff
5
 
 
6
 
# It was first written against Module::Build::Base v0.2805. Many of the methods
7
 
# here are copy/pasted from there in their entirety just to change one or two
8
 
# minor things, since for the most part Module::Build::Base code is hard to
9
 
# cleanly override.
10
 
 
11
 
# This was written by Sendu Bala and is released under the same license as
12
 
# Bioperl itself
13
 
 
14
 
package ModuleBuildBioperl;
15
 
 
16
 
BEGIN {
17
 
    # we really need Module::Build to be installed
18
 
    unless (eval "use Module::Build 0.2805; 1") {
19
 
        print "This package requires Module::Build v0.2805 or greater to install itself.\n";
20
 
        
21
 
        require ExtUtils::MakeMaker;
22
 
        my $yn = ExtUtils::MakeMaker::prompt('  Install Module::Build now from CPAN?', 'y');
23
 
        
24
 
        unless ($yn =~ /^y/i) {
25
 
            die " *** Cannot install without Module::Build.  Exiting ...\n";
26
 
        }
27
 
        
28
 
        require Cwd;
29
 
        require File::Spec;
30
 
        require File::Copy;
31
 
        require CPAN;
32
 
        
33
 
        # Save this because CPAN will chdir all over the place.
34
 
        my $cwd = Cwd::cwd();
35
 
        
36
 
        my $build_pl = File::Spec->catfile($cwd, "Build.PL");
37
 
        
38
 
        File::Copy::move($build_pl, $build_pl."hidden"); # avoid bizarre bug with Module::Build tests using the wrong Build.PL if it happens to be in PERL5LIB
39
 
        CPAN::Shell->install('Module::Build');
40
 
        File::Copy::move($build_pl."hidden", $build_pl);
41
 
        CPAN::Shell->expand("Module", "Module::Build")->uptodate or die "Couldn't install Module::Build, giving up.\n";
42
 
        
43
 
        chdir $cwd or die "Cannot chdir() back to $cwd: $!\n\n***\nInstallation will probably work fine if you now quit CPAN and try again.\n***\n\n";
44
 
    }
45
 
    
46
 
    eval "use base Module::Build; 1" or die $@;
47
 
    
48
 
    # ensure we'll be able to reload this module later by adding its path to inc
49
 
    use Cwd;
50
 
    use lib Cwd::cwd();
51
 
}
52
 
 
53
 
use strict;
54
 
use warnings;
55
 
 
56
 
our $VERSION = 1.005002101;
57
 
our @extra_types = qw(options excludes_os feature_requires test); # test must always be last in the list!
58
 
our $checking_types = "requires|conflicts|".join("|", @extra_types);
59
 
 
60
 
 
61
 
# our modules are in Bio, not lib
62
 
sub find_pm_files {
63
 
    my $self = shift;
64
 
    foreach my $pm (@{$self->rscan_dir('Bio', qr/\.pm$/)}) {
65
 
        $self->{properties}{pm_files}->{$pm} = File::Spec->catfile('lib', $pm);
66
 
    }
67
 
    
68
 
    $self->_find_file_by_type('pm', 'lib');
69
 
}
70
 
 
71
 
# ask what scripts to install (this method is unique to bioperl)
72
 
sub choose_scripts {
73
 
    my $self = shift;
74
 
    
75
 
    # we can offer interactive installation by groups only if we have subdirs
76
 
    # in scripts and no .PLS files there
77
 
    opendir(my $scripts_dir, 'scripts') or die "Can't open directory 'scripts': $!\n";
78
 
    my $int_ok = 0;
79
 
    my @group_dirs;
80
 
    while (my $thing = readdir($scripts_dir)) {
81
 
        next if $thing =~ /^\./;
82
 
        next if $thing eq 'CVS';
83
 
        if ($thing =~ /PLS$|pl$/) {
84
 
            $int_ok = 0;
85
 
            last;
86
 
        }
87
 
        $thing = File::Spec->catfile('scripts', $thing);
88
 
        if (-d $thing) {
89
 
            $int_ok = 1;
90
 
            push(@group_dirs, $thing);
91
 
        }
92
 
    }
93
 
    closedir($scripts_dir);
94
 
    my $question = $int_ok ? "Install [a]ll Bioperl scripts, [n]one, or choose groups [i]nteractively?" : "Install [a]ll Bioperl scripts or [n]one?";
95
 
    
96
 
    my $prompt = $self->prompt($question, 'a');
97
 
    
98
 
    if ($prompt =~ /^[aA]/) {
99
 
        $self->log_info("  - will install all scripts\n");
100
 
        $self->notes(chosen_scripts => 'all');
101
 
    }
102
 
    elsif ($prompt =~ /^[iI]/) {
103
 
        $self->log_info("  - will install interactively:\n");
104
 
        
105
 
        my @chosen_scripts;
106
 
        foreach my $group_dir (@group_dirs) {
107
 
            my $group = File::Basename::basename($group_dir);
108
 
            print "    * group '$group' has:\n";
109
 
            
110
 
            my @script_files = @{$self->rscan_dir($group_dir, qr/\.PLS$|\.pl$/)};
111
 
            foreach my $script_file (@script_files) {
112
 
                my $script = File::Basename::basename($script_file);
113
 
                print "      $script\n";
114
 
            }
115
 
            
116
 
            my $result = $self->prompt("    Install scripts for group '$group'? [y]es [n]o [q]uit", 'n');
117
 
            die if $result =~ /^[qQ]/;
118
 
            if ($result =~ /^[yY]/) {
119
 
                $self->log_info("      + will install group '$group'\n");
120
 
                push(@chosen_scripts, @script_files);
121
 
            }
122
 
            else {
123
 
                $self->log_info("      - will not install group '$group'\n");
124
 
            }
125
 
        }
126
 
        
127
 
        my $chosen_scripts = @chosen_scripts ? join("|", @chosen_scripts) : 'none';
128
 
        
129
 
        $self->notes(chosen_scripts => $chosen_scripts);
130
 
    }
131
 
    else {
132
 
        $self->log_info("  - won't install any scripts\n");
133
 
        $self->notes(chosen_scripts => 'none');
134
 
    }
135
 
    
136
 
    print "\n";
137
 
}
138
 
 
139
 
# our version of script_files doesn't take args but just installs those scripts
140
 
# requested by the user after choose_scripts() is called. If it wasn't called,
141
 
# installs all scripts in scripts directory
142
 
sub script_files {
143
 
    my $self = shift;
144
 
    
145
 
    my $chosen_scripts = $self->notes('chosen_scripts');
146
 
    if ($chosen_scripts) {
147
 
        return if $chosen_scripts eq 'none';
148
 
        return { map {$_, 1} split(/\|/, $chosen_scripts) } unless $chosen_scripts eq 'all';
149
 
    }
150
 
    
151
 
    return $_ = { map {$_,1} @{$self->rscan_dir('scripts', qr/\.PLS$|\.pl$/)} };
152
 
}
153
 
 
154
 
# process scripts normally, except that we change name from *.PLS to bp_*.pl
155
 
sub process_script_files {
156
 
    my $self = shift;
157
 
    my $files = $self->find_script_files;
158
 
    return unless keys %$files;
159
 
  
160
 
    my $script_dir = File::Spec->catdir($self->blib, 'script');
161
 
    File::Path::mkpath( $script_dir );
162
 
    
163
 
    foreach my $file (keys %$files) {
164
 
        my $result = $self->copy_if_modified($file, $script_dir, 'flatten') or next;
165
 
        $self->fix_shebang_line($result) unless $self->os_type eq 'VMS';
166
 
        $self->make_executable($result);
167
 
        
168
 
        my $final = File::Basename::basename($result);
169
 
        $final =~ s/\.PLS$/\.pl/;                  # change from .PLS to .pl
170
 
        $final =~ s/^/bp_/ unless $final =~ /^bp/; # add the "bp" prefix
171
 
        $final = File::Spec->catfile($script_dir, $final);
172
 
        $self->log_info("$result -> $final\n");
173
 
        File::Copy::move($result, $final) or die "Can't rename '$result' to '$final': $!";
174
 
    }
175
 
}
176
 
 
177
 
# extended to handle extra checking types
178
 
sub features {
179
 
    my $self = shift;
180
 
    my $ph = $self->{phash};
181
 
    
182
 
    if (@_) {
183
 
        my $key = shift;
184
 
        if ($ph->{features}->exists($key)) {
185
 
            return $ph->{features}->access($key, @_);
186
 
        }
187
 
        
188
 
        if (my $info = $ph->{auto_features}->access($key)) {
189
 
            my $failures = $self->prereq_failures($info);
190
 
            my $disabled = grep( /^(?:\w+_)?(?:$checking_types)$/, keys %$failures ) ? 1 : 0;
191
 
            return !$disabled;
192
 
        }
193
 
        
194
 
        return $ph->{features}->access($key, @_);
195
 
    }
196
 
  
197
 
    # No args - get the auto_features & overlay the regular features
198
 
    my %features;
199
 
    my %auto_features = $ph->{auto_features}->access();
200
 
    while (my ($name, $info) = each %auto_features) {
201
 
        my $failures = $self->prereq_failures($info);
202
 
        my $disabled = grep( /^(?:\w+_)?(?:$checking_types)$/, keys %$failures ) ? 1 : 0;
203
 
        $features{$name} = $disabled ? 0 : 1;
204
 
    }
205
 
    %features = (%features, $ph->{features}->access());
206
 
  
207
 
    return wantarray ? %features : \%features;
208
 
}
209
 
*feature = \&features;
210
 
 
211
 
# overridden to fix a stupid bug in Module::Build and extended to handle extra
212
 
# checking types
213
 
sub check_autofeatures {
214
 
    my ($self) = @_;
215
 
    my $features = $self->auto_features;
216
 
    
217
 
    return unless %$features;
218
 
    
219
 
    $self->log_info("Checking features:\n");
220
 
    
221
 
    my $max_name_len = 0; # this wasn't set to 0 in Module::Build, causing warning in next line
222
 
    $max_name_len = ( length($_) > $max_name_len ) ? length($_) : $max_name_len for keys %$features;
223
 
    
224
 
    while (my ($name, $info) = each %$features) {
225
 
        $self->log_info("  $name" . '.' x ($max_name_len - length($name) + 4));
226
 
        if ($name eq 'PL_files') {
227
 
            print "got $name => $info\n";
228
 
            print "info has:\n";
229
 
            while (my ($key, $val) = each %$info) {
230
 
                print "  $key => $val\n";
231
 
            }
232
 
        }
233
 
        
234
 
        if ( my $failures = $self->prereq_failures($info) ) {
235
 
            my $disabled = grep( /^(?:\w+_)?(?:$checking_types)$/, keys %$failures ) ? 1 : 0;
236
 
            $self->log_info( $disabled ? "disabled\n" : "enabled\n" );
237
 
            
238
 
            my $log_text;
239
 
            while (my ($type, $prereqs) = each %$failures) {
240
 
                while (my ($module, $status) = each %$prereqs) {
241
 
                    my $required = ($type =~ /^(?:\w+_)?(?:requires|conflicts)$/) ? 1 : 0;
242
 
                    my $prefix = ($required) ? '-' : '*';
243
 
                    $log_text .= "    $prefix $status->{message}\n";
244
 
                }
245
 
            }
246
 
            $self->log_warn($log_text) if $log_text && ! $self->quiet;
247
 
        }
248
 
        else {
249
 
            $self->log_info("enabled\n");
250
 
        }
251
 
    }
252
 
    
253
 
    $self->log_info("\n");
254
 
}
255
 
 
256
 
# overriden just to hide pointless ugly warnings
257
 
sub check_installed_status {
258
 
    my $self = shift;
259
 
    open (my $olderr, ">&", \*STDERR);
260
 
    open(STDERR, "/dev/null");
261
 
    my $return = $self->SUPER::check_installed_status(@_);
262
 
    open(STDERR, ">&", $olderr);
263
 
    return $return;
264
 
}
265
 
 
266
 
# extend to handle option checking (which takes an array ref) and code test
267
 
# checking (which takes a code ref and must return a message only on failure)
268
 
# and excludes_os (which takes an array ref of regexps).
269
 
# also handles more informative output of recommends section
270
 
sub prereq_failures {
271
 
    my ($self, $info) = @_;
272
 
    
273
 
    my @types = (@{ $self->prereq_action_types }, @extra_types);
274
 
    $info ||= {map {$_, $self->$_()} @types};
275
 
    
276
 
    my $out = {};
277
 
    foreach my $type (@types) {
278
 
        my $prereqs = $info->{$type} || next;
279
 
        
280
 
        my $status = {};
281
 
        if ($type eq 'test') {
282
 
            unless (keys %$out) {
283
 
                $status->{message} = &{$prereqs};
284
 
                $out->{$type}{'test'} = $status if $status->{message};
285
 
            }
286
 
        }
287
 
        elsif ($type eq 'options') {
288
 
            my @not_ok;
289
 
            foreach my $wanted_option (@{$prereqs}) {
290
 
                unless ($self->args($wanted_option)) {
291
 
                    push(@not_ok, $wanted_option);
292
 
                }
293
 
            }
294
 
            
295
 
            if (@not_ok > 0) {
296
 
                $status->{message} = "Command line option(s) '@not_ok' not supplied";
297
 
                $out->{$type}{'options'} = $status;
298
 
            }
299
 
        }
300
 
        elsif ($type eq 'excludes_os') {
301
 
            foreach my $os (@{$prereqs}) {
302
 
                if ($^O =~ /$os/i) {
303
 
                    $status->{message} = "This feature isn't supported under your OS ($os)";
304
 
                    $out->{$type}{'excludes_os'} = $status;
305
 
                    last;
306
 
                }
307
 
            }
308
 
        }
309
 
        else {
310
 
            while ( my ($modname, $spec) = each %$prereqs ) {
311
 
                $status = $self->check_installed_status($modname, $spec);
312
 
                
313
 
                if ($type =~ /^(?:\w+_)?conflicts$/) {
314
 
                    next if !$status->{ok};
315
 
                    $status->{conflicts} = delete $status->{need};
316
 
                    $status->{message} = "$modname ($status->{have}) conflicts with this distribution";
317
 
                }
318
 
                elsif ($type =~ /^(?:\w+_)?recommends$/) {
319
 
                    next if $status->{ok};
320
 
                    
321
 
                    my ($preferred_version, $why, $by_what) = split("/", $spec);
322
 
                    $by_what = join(", ", split(",", $by_what));
323
 
                    $by_what =~ s/, (\S+)$/ and $1/;
324
 
                    
325
 
                    $status->{message} = (!ref($status->{have}) && $status->{have} eq '<none>'
326
 
                                  ? "Optional prerequisite $modname is not installed"
327
 
                                  : "$modname ($status->{have}) is installed, but we prefer to have $preferred_version");
328
 
                    
329
 
                    $status->{message} .= "\n   (wanted for $why, used by $by_what)";
330
 
                    
331
 
                    my $installed = $self->install_optional($modname, $preferred_version, $status->{message});
332
 
                    next if $installed eq 'ok';
333
 
                    $status->{message} = $installed unless $installed eq 'skip';
334
 
                }
335
 
                elsif ($type =~ /^feature_requires/) {
336
 
                    next if $status->{ok};
337
 
                }
338
 
                else {
339
 
                    next if $status->{ok};
340
 
                    
341
 
                    my $installed = $self->install_required($modname, $spec, $status->{message});
342
 
                    next if $installed eq 'ok';
343
 
                    $status->{message} = $installed;
344
 
                }
345
 
                
346
 
                $out->{$type}{$modname} = $status;
347
 
            }
348
 
        }
349
 
    }
350
 
    
351
 
    return keys %{$out} ? $out : return;
352
 
}
353
 
 
354
 
# install an external module using CPAN prior to testing and installation
355
 
# should only be called by install_required or install_optional
356
 
sub install_prereq {
357
 
    my ($self, $desired, $version) = @_;
358
 
    
359
 
    if ($self->under_cpan) {
360
 
        # Just add to the required hash, which CPAN >= 1.81 will check prior
361
 
        # to install
362
 
        $self->{properties}{requires}->{$desired} = $version;
363
 
        $self->log_info("   I'll get CPAN to prepend the installation of this\n");
364
 
        return 'ok';
365
 
    }
366
 
    else {
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
 
        if (CPAN::Shell->expand("Module", $desired)->uptodate) {
379
 
            $self->log_info("\n\n*** (back in Bioperl Build.PL) ***\n * You chose to install $desired and it installed fine\n");
380
 
            $msg = 'ok';
381
 
        }
382
 
        else {
383
 
            $self->log_info("\n\n*** (back in Bioperl Build.PL) ***\n");
384
 
            $msg = "You chose to install $desired but it failed to install";
385
 
        }
386
 
        
387
 
        chdir $cwd or die "Cannot chdir() back to $cwd: $!";
388
 
        return $msg;
389
 
    }
390
 
}
391
 
 
392
 
# install required modules listed in 'requires' or 'build_requires' arg to
393
 
# new that weren't already installed. Should only be called by prereq_failures
394
 
sub install_required {
395
 
    my ($self, $desired, $version, $msg) = @_;
396
 
    
397
 
    $self->log_info(" - ERROR: $msg\n");
398
 
    
399
 
    return $self->install_prereq($desired, $version);
400
 
}
401
 
 
402
 
# install optional modules listed in 'recommends' arg to new that weren't
403
 
# already installed. Should only be called by prereq_failures
404
 
sub install_optional {
405
 
    my ($self, $desired, $version, $msg) = @_;
406
 
    
407
 
    unless (defined $self->{ask_optional}) {
408
 
        $self->{ask_optional} = $self->prompt("Install [a]ll optional external modules, [n]one, or choose [i]nteractively?", 'n');
409
 
    }
410
 
    return 'skip' if $self->{ask_optional} =~ /^n/i;
411
 
    
412
 
    my $install;
413
 
    if ($self->{ask_optional} =~ /^a/i) {
414
 
        $self->log_info(" * $msg\n");
415
 
        $install = 1;
416
 
    }
417
 
    else {
418
 
        $install = $self->y_n(" * $msg\n   Do you want to install it? y/n", 'n');
419
 
    }
420
 
    
421
 
    if ($install) {
422
 
        return $self->install_prereq($desired, $version);
423
 
    }
424
 
    else {
425
 
        $self->log_info(" * You chose not to install $desired\n");
426
 
        return 'ok';
427
 
    }
428
 
}
429
 
 
430
 
# there's no official way to discover if being run by CPAN, we take an approach
431
 
# similar to that of Module::AutoInstall
432
 
sub under_cpan {
433
 
    my $self = shift;
434
 
    
435
 
    unless (defined $self->{under_cpan}) {
436
 
        ## modified from Module::AutoInstall
437
 
        
438
 
        # load cpan config
439
 
        require CPAN;
440
 
        if ($CPAN::HandleConfig::VERSION) {
441
 
            # Newer versions of CPAN have a HandleConfig module
442
 
            CPAN::HandleConfig->load;
443
 
        }
444
 
        else {
445
 
            # Older versions had the load method in Config directly
446
 
            CPAN::Config->load;
447
 
        }
448
 
        
449
 
        # Find the CPAN lock-file
450
 
        my $lock = File::Spec->catfile($CPAN::Config->{cpan_home}, '.lock');
451
 
        if (-f $lock) {
452
 
            # Module::AutoInstall now goes on to open the lock file and compare
453
 
            # its pid to ours, but we're not in a situation where we expect
454
 
            # the pids to match, so we take the windows approach for all OSes:
455
 
            # find out if we're in cpan_home
456
 
            my $cwd  = File::Spec->canonpath(Cwd::cwd());
457
 
            my $cpan = File::Spec->canonpath($CPAN::Config->{cpan_home});
458
 
            
459
 
            $self->{under_cpan} = index($cwd, $cpan) > -1;
460
 
        }
461
 
        
462
 
        if ($self->{under_cpan}) {
463
 
            $self->log_info("(I think I'm being run by CPAN, so will rely on CPAN to handle prerequisite installation)\n");
464
 
        }
465
 
        else {
466
 
            $self->log_info("(I think you ran Build.PL directly, so will use CPAN to install prerequisites on demand)\n");
467
 
            $self->{under_cpan} = 0;
468
 
        }
469
 
    }
470
 
    
471
 
    return $self->{under_cpan};
472
 
}
473
 
 
474
 
# overridden simply to not print the default answer if chosen by hitting return
475
 
sub prompt {
476
 
    my $self = shift;
477
 
    my $mess = shift or die "prompt() called without a prompt message";
478
 
    
479
 
    my $def;
480
 
    if ( $self->_is_unattended && !@_ ) {
481
 
        die <<EOF;
482
 
ERROR: This build seems to be unattended, but there is no default value
483
 
for this question.  Aborting.
484
 
EOF
485
 
    }
486
 
    $def = shift if @_;
487
 
    ($def, my $dispdef) = defined $def ? ($def, "[$def] ") : ('', ' ');
488
 
    
489
 
    local $|=1;
490
 
    print "$mess $dispdef";
491
 
  
492
 
    my $ans = $self->_readline();
493
 
  
494
 
    if ( !defined($ans)        # Ctrl-D or unattended
495
 
         or !length($ans) ) {  # User hit return
496
 
        #print "$def\n"; didn't like this!
497
 
        $ans = $def;
498
 
    }
499
 
    
500
 
    return $ans;
501
 
}
502
 
 
503
 
# like the Module::Build version, except that we always get version from
504
 
# dist_version
505
 
sub find_dist_packages {
506
 
    my $self = shift;
507
 
    
508
 
    # Only packages in .pm files are candidates for inclusion here.
509
 
    # Only include things in the MANIFEST, not things in developer's
510
 
    # private stock.
511
 
    
512
 
    my $manifest = $self->_read_manifest('MANIFEST') or die "Can't find dist packages without a MANIFEST file - run 'manifest' action first";
513
 
    
514
 
    # Localize
515
 
    my %dist_files = map { $self->localize_file_path($_) => $_ } keys %$manifest;
516
 
    
517
 
    my @pm_files = grep {exists $dist_files{$_}} keys %{ $self->find_pm_files };
518
 
    
519
 
    my $actual_version = $self->dist_version;
520
 
    
521
 
    # First, we enumerate all packages & versions,
522
 
    # seperating into primary & alternative candidates
523
 
    my( %prime, %alt );
524
 
    foreach my $file (@pm_files) {
525
 
        next if $dist_files{$file} =~ m{^t/};  # Skip things in t/
526
 
        
527
 
        my @path = split( /\//, $dist_files{$file} );
528
 
        (my $prime_package = join( '::', @path[1..$#path] )) =~ s/\.pm$//;
529
 
        
530
 
        my $pm_info = Module::Build::ModuleInfo->new_from_file( $file );
531
 
        
532
 
        foreach my $package ( $pm_info->packages_inside ) {
533
 
            next if $package eq 'main';  # main can appear numerous times, ignore
534
 
            next if grep /^_/, split( /::/, $package ); # private package, ignore
535
 
            
536
 
            my $version = $pm_info->version( $package );
537
 
            if ($version && $version != $actual_version) {
538
 
                $self->log_warn("Package $package had version $version!\n");
539
 
            }
540
 
            $version = $actual_version;
541
 
            
542
 
            if ( $package eq $prime_package ) {
543
 
                if ( exists( $prime{$package} ) ) {
544
 
                    # M::B::ModuleInfo will handle this conflict
545
 
                    die "Unexpected conflict in '$package'; multiple versions found.\n";
546
 
                }
547
 
                else {
548
 
                    $prime{$package}{file} = $dist_files{$file};
549
 
                    $prime{$package}{version} = $version if defined( $version );
550
 
                }
551
 
            }
552
 
            else {
553
 
                push( @{$alt{$package}}, { file => $dist_files{$file}, version => $version } );
554
 
            }
555
 
        }
556
 
    }
557
 
    
558
 
    # Then we iterate over all the packages found above, identifying conflicts
559
 
    # and selecting the "best" candidate for recording the file & version
560
 
    # for each package.
561
 
    foreach my $package ( keys( %alt ) ) {
562
 
        my $result = $self->_resolve_module_versions( $alt{$package} );
563
 
        
564
 
        if ( exists( $prime{$package} ) ) { # primary package selected
565
 
            if ( $result->{err} ) {
566
 
                # Use the selected primary package, but there are conflicting
567
 
                 # errors amoung multiple alternative packages that need to be
568
 
                 # reported
569
 
                 $self->log_warn("Found conflicting versions for package '$package'\n" .
570
 
                                 "  $prime{$package}{file} ($prime{$package}{version})\n" . $result->{err});
571
 
            }
572
 
            elsif ( defined( $result->{version} ) ) {
573
 
                # There is a primary package selected, and exactly one
574
 
                # alternative package
575
 
                
576
 
                if ( exists( $prime{$package}{version} ) && defined( $prime{$package}{version} ) ) {
577
 
                    # Unless the version of the primary package agrees with the
578
 
                    # version of the alternative package, report a conflict
579
 
                    if ( $self->compare_versions( $prime{$package}{version}, '!=', $result->{version} ) ) {
580
 
                        $self->log_warn("Found conflicting versions for package '$package'\n" .
581
 
                                        "  $prime{$package}{file} ($prime{$package}{version})\n" .
582
 
                                        "  $result->{file} ($result->{version})\n");
583
 
                    }
584
 
                }
585
 
                else {
586
 
                  # The prime package selected has no version so, we choose to
587
 
                  # use any alternative package that does have a version
588
 
                  $prime{$package}{file}    = $result->{file};
589
 
                  $prime{$package}{version} = $result->{version};
590
 
                }
591
 
            }
592
 
            else {
593
 
                # no alt package found with a version, but we have a prime
594
 
                # package so we use it whether it has a version or not
595
 
            }
596
 
        }
597
 
        else { # No primary package was selected, use the best alternative
598
 
            if ( $result->{err} ) {
599
 
                $self->log_warn("Found conflicting versions for package '$package'\n" . $result->{err});
600
 
            }
601
 
            
602
 
            # Despite possible conflicting versions, we choose to record
603
 
            # something rather than nothing
604
 
            $prime{$package}{file}    = $result->{file};
605
 
            $prime{$package}{version} = $result->{version} if defined( $result->{version} );
606
 
        }
607
 
    }
608
 
  
609
 
    # Stringify versions
610
 
    for (grep exists $_->{version}, values %prime) {
611
 
        $_->{version} = $_->{version}->stringify if ref($_->{version});
612
 
    }
613
 
  
614
 
    return \%prime;
615
 
}
616
 
 
617
 
# our recommends syntax contains extra info that needs to be ignored at this
618
 
# stage
619
 
sub _parse_conditions {
620
 
    my ($self, $spec) = @_;
621
 
    
622
 
    ($spec) = split("/", $spec);
623
 
    
624
 
    if ($spec =~ /^\s*([\w.]+)\s*$/) { # A plain number, maybe with dots, letters, and underscores
625
 
        return (">= $spec");
626
 
    }
627
 
    else {
628
 
        return split /\s*,\s*/, $spec;
629
 
    }
630
 
}
631
 
 
632
 
# when generating META.yml, we output optional_features syntax (instead of
633
 
# recommends syntax). Note that as of CPAN v1.8802 nothing useful is done
634
 
# with this information, which is why we implement our own request to install
635
 
# the optional modules in install_optional()
636
 
sub prepare_metadata {
637
 
    my ($self, $node, $keys) = @_;
638
 
    my $p = $self->{properties};
639
 
    
640
 
    # A little helper sub
641
 
    my $add_node = sub {
642
 
        my ($name, $val) = @_;
643
 
        $node->{$name} = $val;
644
 
        push @$keys, $name if $keys;
645
 
    };
646
 
    
647
 
    foreach (qw(dist_name dist_version dist_author dist_abstract license)) {
648
 
        (my $name = $_) =~ s/^dist_//;
649
 
        $add_node->($name, $self->$_());
650
 
        die "ERROR: Missing required field '$_' for META.yml\n" unless defined($node->{$name}) && length($node->{$name});
651
 
    }
652
 
    $node->{version} = '' . $node->{version}; # Stringify version objects
653
 
    
654
 
    if (defined( $self->license ) && defined( my $url = $self->valid_licenses->{ $self->license } )) {
655
 
        $node->{resources}{license} = $url;
656
 
    }
657
 
    
658
 
    foreach ( @{$self->prereq_action_types} ) {
659
 
        if (exists $p->{$_} and keys %{ $p->{$_} }) {
660
 
            if ($_ eq 'recommends') {
661
 
                my $hash;
662
 
                while (my ($req, $val) = each %{ $p->{$_} }) {
663
 
                    my ($ver, $why, $used_by) = split("/", $val);
664
 
                    my $info = {};
665
 
                    $info->{description} = $why;
666
 
                    $info->{requires} = { $req => $ver };
667
 
                    $hash->{$used_by} = $info;
668
 
                }
669
 
                $add_node->('optional_features', $hash);
670
 
            }
671
 
            else {
672
 
                $add_node->($_, $p->{$_});
673
 
            }
674
 
        }
675
 
    }
676
 
    
677
 
    if (exists $p->{dynamic_config}) {
678
 
        $add_node->('dynamic_config', $p->{dynamic_config});
679
 
    }
680
 
    my $pkgs = eval { $self->find_dist_packages };
681
 
    if ($@) {
682
 
        $self->log_warn("$@\nWARNING: Possible missing or corrupt 'MANIFEST' file.\n" . "Nothing to enter for 'provides' field in META.yml\n");
683
 
    }
684
 
    else {
685
 
        $node->{provides} = $pkgs if %$pkgs;
686
 
    };
687
 
    
688
 
    if (exists $p->{no_index}) {
689
 
        $add_node->('no_index', $p->{no_index});
690
 
    }
691
 
    
692
 
    $add_node->('generated_by', "Module::Build version $Module::Build::VERSION");
693
 
    
694
 
    $add_node->('meta-spec', 
695
 
            {version => '1.2',
696
 
             url     => 'http://module-build.sourceforge.net/META-spec-v1.2.html',
697
 
            });
698
 
    
699
 
    while (my($k, $v) = each %{$self->meta_add}) {
700
 
        $add_node->($k, $v);
701
 
    }
702
 
    
703
 
    while (my($k, $v) = each %{$self->meta_merge}) {
704
 
        $self->_hash_merge($node, $k, $v);
705
 
    }
706
 
    
707
 
    return $node;
708
 
}
709
 
 
710
 
# let us store extra things persistently in _build
711
 
sub _construct {
712
 
    my $self = shift;
713
 
    $self = $self->SUPER::_construct(@_);
714
 
    
715
 
    my ($p, $ph) = ($self->{properties}, $self->{phash});
716
 
    
717
 
    foreach (qw(manifest_skip post_install_scripts)) {
718
 
        my $file = File::Spec->catfile($self->config_dir, $_);
719
 
        $ph->{$_} = Module::Build::Notes->new(file => $file);
720
 
        $ph->{$_}->restore if -e $file;
721
 
    }
722
 
    
723
 
    return $self;
724
 
}
725
 
sub write_config {
726
 
    my $self = shift;
727
 
    $self->SUPER::write_config;
728
 
    
729
 
    # write extra things
730
 
    $self->{phash}{$_}->write() foreach qw(manifest_skip post_install_scripts);
731
 
    
732
 
    # be even more certain we can reload ourselves during a resume by copying
733
 
    # ourselves to _build\lib
734
 
    my $filename = File::Spec->catfile($self->{properties}{config_dir}, 'lib', 'ModuleBuildBioperl.pm');
735
 
    my $filedir  = File::Basename::dirname($filename);
736
 
    
737
 
    File::Path::mkpath($filedir);
738
 
    warn "Can't create directory $filedir: $!" unless -d $filedir;
739
 
    
740
 
    File::Copy::copy('ModuleBuildBioperl.pm', $filename);
741
 
    warn "Unable to copy 'ModuleBuildBioperl.pm' to '$filename'\n" unless -e $filename;
742
 
}
743
 
 
744
 
# add a file to the default MANIFEST.SKIP
745
 
sub add_to_manifest_skip {
746
 
    my $self = shift;
747
 
    my %files = map {$self->localize_file_path($_), 1} @_;
748
 
    $self->{phash}{manifest_skip}->write(\%files);
749
 
}
750
 
 
751
 
# we always generate a new MANIFEST and MANIFEST.SKIP here, instead of allowing
752
 
# existing files to remain
753
 
sub ACTION_manifest {
754
 
    my ($self) = @_;
755
 
    
756
 
    my $maniskip = 'MANIFEST.SKIP';
757
 
    if ( -e 'MANIFEST' || -e $maniskip ) {
758
 
        $self->log_warn("MANIFEST files already exist, will overwrite them\n");
759
 
        unlink('MANIFEST');
760
 
        unlink($maniskip);
761
 
    }
762
 
    $self->_write_default_maniskip($maniskip);
763
 
    
764
 
    require ExtUtils::Manifest;  # ExtUtils::Manifest is not warnings clean.
765
 
    local ($^W, $ExtUtils::Manifest::Quiet) = (0,1);
766
 
    ExtUtils::Manifest::mkmanifest();
767
 
}
768
 
 
769
 
# extended to add extra things to the default MANIFEST.SKIP
770
 
sub _write_default_maniskip {
771
 
    my $self = shift;
772
 
    $self->SUPER::_write_default_maniskip;
773
 
    
774
 
    my @extra = keys %{$self->{phash}{manifest_skip}->read};
775
 
    if (@extra) {
776
 
        open(my $fh, '>>', 'MANIFEST.SKIP') or die "Could not open MANIFEST.SKIP file\n";
777
 
        print $fh "\n# Avoid additional run-time generated things\n";
778
 
        foreach my $line (@extra) {
779
 
            print $fh $line, "\n";
780
 
        }
781
 
        close($fh);
782
 
    }
783
 
}
784
 
 
785
 
# extended to run scripts post-installation
786
 
sub ACTION_install {
787
 
  my ($self) = @_;
788
 
  require ExtUtils::Install;
789
 
  $self->depends_on('build');
790
 
  ExtUtils::Install::install($self->install_map, !$self->quiet, 0, $self->{args}{uninst}||0);
791
 
  $self->run_post_install_scripts;
792
 
}
793
 
sub add_post_install_script {
794
 
    my $self = shift;
795
 
    my %files = map {$self->localize_file_path($_), 1} @_;
796
 
    $self->{phash}{post_install_scripts}->write(\%files);
797
 
}
798
 
sub run_post_install_scripts {
799
 
    my $self = shift;
800
 
    my @scripts = keys %{$self->{phash}{post_install_scripts}->read};
801
 
    foreach my $script (@scripts) {
802
 
        $self->run_perl_script($script);
803
 
    }
804
 
}
805
 
 
806
 
# for use with auto_features, which should require LWP::UserAgent as one of
807
 
# its reqs
808
 
sub test_internet {
809
 
    eval {require LWP::UserAgent;};
810
 
    if ($@) {
811
 
        # ideally this won't happen because auto_feature already specified
812
 
        # LWP::UserAgent, so this sub wouldn't get called if LWP not installed
813
 
        return "LWP::UserAgent not installed";
814
 
    }
815
 
    my $ua = LWP::UserAgent->new;
816
 
    $ua->timeout(10);
817
 
    $ua->env_proxy;
818
 
    my $response = $ua->get('http://search.cpan.org/');
819
 
    unless ($response->is_success) {
820
 
        return "Could not connect to the internet (http://search.cpan.org/)";
821
 
    }
822
 
    return;
823
 
}
824
 
 
825
 
# nice directory names for dist-related actions
826
 
sub dist_dir {
827
 
    my ($self) = @_;
828
 
    my $version = $self->dist_version;
829
 
    if ($version =~ /^\d\.\d{6}\d$/) {
830
 
        # 1.x.x.100 returned as 1.x.x.1
831
 
        $version .= '00';
832
 
    }
833
 
    $version =~ s/00(\d)/$1./g;
834
 
    $version =~ s/\.$//;
835
 
    
836
 
    if (my ($minor, $rev) = $version =~ /^\d\.(\d)\.\d\.(\d+)$/) {
837
 
        my $dev = ! ($minor % 2 == 0);
838
 
        if ($rev == 100) {
839
 
            my $replace = $dev ? "_$rev" : '';
840
 
            $version =~ s/\.\d+$/$replace/;
841
 
        }
842
 
        elsif ($rev < 100) {
843
 
            $rev = sprintf("%03d", $rev);
844
 
            $version =~ s/\.\d+$/_$rev-RC/;
845
 
        }
846
 
        else {
847
 
            $rev -= 100 unless $dev;
848
 
            my $replace = $dev ? "_$rev" : ".$rev";
849
 
            $version =~ s/\.\d+$/$replace/;
850
 
        }
851
 
    }
852
 
    
853
 
    return "$self->{properties}{dist_name}-$version";
854
 
}
855
 
sub ppm_name {
856
 
    my $self = shift;
857
 
    return $self->dist_dir.'-ppm';
858
 
}
859
 
 
860
 
# generate complete ppd4 version file
861
 
sub ACTION_ppd {
862
 
    my $self = shift;
863
 
    
864
 
    my $file = $self->make_ppd(%{$self->{args}});
865
 
    $self->add_to_cleanup($file);
866
 
    $self->add_to_manifest_skip($file);
867
 
}
868
 
 
869
 
# add pod2htm temp files to MANIFEST.SKIP, generated during ppmdist most likely
870
 
sub htmlify_pods {
871
 
    my $self = shift;
872
 
    $self->SUPER::htmlify_pods(@_);
873
 
    $self->add_to_manifest_skip('pod2htm*');
874
 
}
875
 
 
876
 
# don't copy across man3 docs since they're of little use under Windows and
877
 
# have bad filenames
878
 
sub ACTION_ppmdist {
879
 
    my $self = shift;
880
 
    my @types = $self->install_types(1);
881
 
    $self->SUPER::ACTION_ppmdist(@_);
882
 
    $self->install_types(0);
883
 
}
884
 
 
885
 
# when supplied a true value, pretends libdoc doesn't exist (preventing man3
886
 
# installation for ppmdist). when supplied false, they exist again
887
 
sub install_types {
888
 
    my ($self, $no_libdoc) = @_;
889
 
    $self->{no_libdoc} = $no_libdoc if defined $no_libdoc;
890
 
    my @types = $self->SUPER::install_types;
891
 
    if ($self->{no_libdoc}) {
892
 
        my @altered_types;
893
 
        foreach my $type (@types) {
894
 
            push(@altered_types, $type) unless $type eq 'libdoc';
895
 
        }
896
 
        return @altered_types;
897
 
    }
898
 
    return @types;
899
 
}
900
 
 
901
 
# overridden from Module::Build::PPMMaker for ppd4 compatability
902
 
sub make_ppd {
903
 
    my ($self, %args) = @_;
904
 
    
905
 
    require Module::Build::PPMMaker;
906
 
    my $mbp = Module::Build::PPMMaker->new();
907
 
    
908
 
    my %dist;
909
 
    foreach my $info (qw(name author abstract version)) {
910
 
        my $method = "dist_$info";
911
 
        $dist{$info} = $self->$method() or die "Can't determine distribution's $info\n";
912
 
    }
913
 
    $dist{codebase} = $self->ppm_name.'.tar.gz';
914
 
    $mbp->_simple_xml_escape($_) foreach $dist{abstract}, $dist{codebase}, @{$dist{author}};
915
 
    
916
 
    my (undef, undef, undef, $mday, $mon, $year) = localtime();
917
 
    $year += 1900;
918
 
    $mon++;
919
 
    my $date = "$year-$mon-$mday";
920
 
    
921
 
    my $softpkg_version = $self->dist_dir;
922
 
    $softpkg_version =~ s/^$dist{name}-//;
923
 
    
924
 
    # to avoid a ppm bug, instead of including the requires in the softpackage
925
 
    # for the distribution we're making, we'll make a seperate Bundle::
926
 
    # softpackage that contains all the requires, and require only the Bundle in
927
 
    # the real softpackage
928
 
    my ($bundle_name) = $dist{name} =~ /^.+-(.+)/;
929
 
    $bundle_name ||= 'core';
930
 
    $bundle_name =~ s/^(\w)/\U$1/;
931
 
    my $bundle_dir = "Bundle-BioPerl-$bundle_name-$softpkg_version-ppm";
932
 
    my $bundle_file = "$bundle_dir.tar.gz";
933
 
    my $bundle_softpkg_name = "Bundle-BioPerl-$bundle_name";
934
 
    $bundle_name = "Bundle::BioPerl::$bundle_name";
935
 
    
936
 
    # header
937
 
    my $ppd = <<"PPD";
938
 
    <SOFTPKG NAME=\"$dist{name}\" VERSION=\"$softpkg_version\" DATE=\"$date\">
939
 
        <TITLE>$dist{name}</TITLE>
940
 
        <ABSTRACT>$dist{abstract}</ABSTRACT>
941
 
@{[ join "\n", map "        <AUTHOR>$_</AUTHOR>", @{$dist{author}} ]}
942
 
        <PROVIDE NAME=\"$dist{name}::\" VERSION=\"$dist{version}\"/>
943
 
PPD
944
 
    
945
 
    # provide section
946
 
    foreach my $pm (@{$self->rscan_dir('Bio', qr/\.pm$/)}) {
947
 
        # convert these filepaths to Module names
948
 
        $pm =~ s/\//::/g;
949
 
        $pm =~ s/\.pm//;
950
 
        
951
 
        $ppd .= sprintf(<<'EOF', $pm, $dist{version});
952
 
        <PROVIDE NAME="%s" VERSION="%s"/>
953
 
EOF
954
 
    }
955
 
    
956
 
    # rest of softpkg
957
 
    $ppd .= <<"PPD";
958
 
        <IMPLEMENTATION>
959
 
            <ARCHITECTURE NAME=\"MSWin32-x86-multi-thread-5.8\"/>
960
 
            <CODEBASE HREF=\"$dist{codebase}\"/>
961
 
            <REQUIRE NAME=\"$bundle_name\" VERSION=\"$dist{version}\"/>
962
 
        </IMPLEMENTATION>
963
 
    </SOFTPKG>
964
 
PPD
965
 
    
966
 
    # now a new softpkg for the bundle
967
 
    $ppd .= <<"PPD";
968
 
    
969
 
    <SOFTPKG NAME=\"$bundle_softpkg_name\" VERSION=\"$softpkg_version\" DATE=\"$date\">
970
 
        <TITLE>$bundle_name</TITLE>
971
 
        <ABSTRACT>Bundle of pre-requisites for $dist{name}</ABSTRACT>
972
 
@{[ join "\n", map "        <AUTHOR>$_</AUTHOR>", @{$dist{author}} ]}
973
 
        <PROVIDE NAME=\"$bundle_name\" VERSION=\"$dist{version}\"/>
974
 
        <IMPLEMENTATION>
975
 
            <ARCHITECTURE NAME=\"MSWin32-x86-multi-thread-5.8\"/>
976
 
            <CODEBASE HREF=\"$bundle_file\"/>
977
 
PPD
978
 
    
979
 
    # required section
980
 
    # we do both requires and recommends to make installation on Windows as
981
 
    # easy (mindless) as possible
982
 
    for my $type ('requires', 'recommends') {
983
 
        my $prereq = $self->$type;
984
 
        while (my ($modname, $version) = each %$prereq) {
985
 
            next if $modname eq 'perl';
986
 
            ($version) = split("/", $version) if $version =~ /\//;
987
 
            
988
 
            # Module names must have at least one ::
989
 
            unless ($modname =~ /::/) {
990
 
                $modname .= '::';
991
 
            }
992
 
            
993
 
            # Bio::Root::Version number comes out as triplet number like 1.5.2;
994
 
            # convert to our own version
995
 
            if ($modname eq 'Bio::Root::Version') {
996
 
                $version = $dist{version};
997
 
            }
998
 
            
999
 
            $ppd .= sprintf(<<'EOF', $modname, $version || '');
1000
 
            <REQUIRE NAME="%s" VERSION="%s"/>
1001
 
EOF
1002
 
        }
1003
 
    }
1004
 
    
1005
 
    # footer
1006
 
    $ppd .= <<'EOF';
1007
 
        </IMPLEMENTATION>
1008
 
    </SOFTPKG>
1009
 
EOF
1010
 
    
1011
 
    my $ppd_file = "$dist{name}.ppd";
1012
 
    my $fh = IO::File->new(">$ppd_file") or die "Cannot write to $ppd_file: $!";
1013
 
    print $fh $ppd;
1014
 
    close $fh;
1015
 
    
1016
 
    $self->delete_filetree($bundle_dir);
1017
 
    mkdir($bundle_dir) or die "Cannot create '$bundle_dir': $!";
1018
 
    $self->make_tarball($bundle_dir);
1019
 
    $self->delete_filetree($bundle_dir);
1020
 
    $self->add_to_cleanup($bundle_file);
1021
 
    $self->add_to_manifest_skip($bundle_file);
1022
 
    
1023
 
    return $ppd_file;
1024
 
}
1025
 
 
1026
 
# we make all archive formats we want, not just .tar.gz
1027
 
# we also auto-run manifest action, since we always want to re-create
1028
 
# MANIFEST and MANIFEST.SKIP just-in-time
1029
 
sub ACTION_dist {
1030
 
    my ($self) = @_;
1031
 
    
1032
 
    $self->depends_on('manifest');
1033
 
    $self->depends_on('distdir');
1034
 
    
1035
 
    my $dist_dir = $self->dist_dir;
1036
 
    
1037
 
    $self->make_zip($dist_dir);
1038
 
    $self->make_tarball($dist_dir);
1039
 
    $self->delete_filetree($dist_dir);
1040
 
}
1041
 
 
1042
 
# makes zip file for windows users and bzip2 files as well
1043
 
sub make_zip {
1044
 
    my ($self, $dir, $file) = @_;
1045
 
    $file ||= $dir;
1046
 
    
1047
 
    $self->log_info("Creating $file.zip\n");
1048
 
    my $zip_flags = $self->verbose ? '-r' : '-rq';
1049
 
    $self->do_system($self->split_like_shell("zip"), $zip_flags, "$file.zip", $dir);
1050
 
    
1051
 
    $self->log_info("Creating $file.bz2\n");
1052
 
    require Archive::Tar;
1053
 
    # Archive::Tar versions >= 1.09 use the following to enable a compatibility
1054
 
    # hack so that the resulting archive is compatible with older clients.
1055
 
    $Archive::Tar::DO_NOT_USE_PREFIX = 0;
1056
 
    my $files = $self->rscan_dir($dir);
1057
 
    Archive::Tar->create_archive("$file.tar", 0, @$files);
1058
 
    $self->do_system($self->split_like_shell("bzip2"), "-k", "$file.tar");
1059
 
}
1060
 
 
1061
 
1;