File Coverage

blib/lib/CPAN/Module.pm
Criterion Covered Total %
statement 72 360 20.0
branch 24 204 11.7
condition 6 91 6.5
subroutine 15 42 35.7
pod 0 34 0.0
total 117 731 16.0


line stmt bran cond sub pod time code
1             # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
2             # vim: ts=4 sts=4 sw=4:
3             package CPAN::Module;
4 12     12   63 use strict;
  12         23  
  12         561  
5             @CPAN::Module::ISA = qw(CPAN::InfoObj);
6              
7 12         1264 use vars qw(
8             $VERSION
9 12     12   62 );
  12         21  
10             $VERSION = "5.5002";
11              
12             BEGIN {
13             # alarm() is not implemented in perl 5.6.x and earlier under Windows
14 12 50   12   60319 *ALARM_IMPLEMENTED = sub () { $] >= 5.007 || $^O !~ /MSWin/ };
  2     2   15  
15             }
16              
17             # Accessors
18             #-> sub CPAN::Module::userid
19             sub userid {
20 38     38 0 42 my $self = shift;
21 38         86 my $ro = $self->ro;
22 38 50       150 return unless $ro;
23 0   0     0 return $ro->{userid} || $ro->{CPAN_USERID};
24             }
25             #-> sub CPAN::Module::description
26             sub description {
27 0     0 0 0 my $self = shift;
28 0 0       0 my $ro = $self->ro or return "";
29             $ro->{description}
30 0         0 }
31              
32             #-> sub CPAN::Module::distribution
33             sub distribution {
34 1     1 0 3 my($self) = @_;
35 1         4 CPAN::Shell->expand("Distribution",$self->cpan_file);
36             }
37              
38             #-> sub CPAN::Module::_is_representative_module
39             sub _is_representative_module {
40 0     0   0 my($self) = @_;
41 0 0       0 return $self->{_is_representative_module} if defined $self->{_is_representative_module};
42 0 0       0 my $pm = $self->cpan_file or return $self->{_is_representative_module} = 0;
43 0         0 $pm =~ s|.+/||;
44 0         0 $pm =~ s{\.(?:tar\.(bz2|gz|Z)|t(?:gz|bz)|zip)$}{}i; # see base_id
45 0         0 $pm =~ s|-\d+\.\d+.+$||;
46 0         0 $pm =~ s|-[\d\.]+$||;
47 0         0 $pm =~ s/-/::/g;
48 0 0       0 $self->{_is_representative_module} = $pm eq $self->{ID} ? 1 : 0;
49             # warn "DEBUG: $pm eq $self->{ID} => $self->{_is_representative_module}";
50 0         0 $self->{_is_representative_module};
51             }
52              
53             #-> sub CPAN::Module::undelay
54             sub undelay {
55 0     0 0 0 my $self = shift;
56 0         0 delete $self->{later};
57 0 0       0 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
58 0         0 $dist->undelay;
59             }
60             }
61              
62             # mark as dirty/clean
63             #-> sub CPAN::Module::color_cmd_tmps ;
64             sub color_cmd_tmps {
65 0     0 0 0 my($self) = shift;
66 0   0     0 my($depth) = shift || 0;
67 0   0     0 my($color) = shift || 0;
68 0   0     0 my($ancestors) = shift || [];
69             # a module needs to recurse to its cpan_file
70              
71             return if exists $self->{incommandcolor}
72             && $color==1
73 0 0 0     0 && $self->{incommandcolor}==$color;
      0        
74 0 0 0     0 return if $color==0 && !$self->{incommandcolor};
75 0 0       0 if ($color>=1) {
76 0 0       0 if ( $self->uptodate ) {
    0          
77 0         0 $self->{incommandcolor} = $color;
78 0         0 return;
79             } elsif (my $have_version = $self->available_version) {
80             # maybe what we have is good enough
81 0 0       0 if (@$ancestors) {
82 0         0 my $who_asked_for_me = $ancestors->[-1];
83 0         0 my $obj = CPAN::Shell->expandany($who_asked_for_me);
84 0 0       0 if (0) {
    0          
85 0         0 } elsif ($obj->isa("CPAN::Bundle")) {
86             # bundles cannot specify a minimum version
87 0         0 return;
88             } elsif ($obj->isa("CPAN::Distribution")) {
89 0 0       0 if (my $prereq_pm = $obj->prereq_pm) {
90 0         0 for my $k (keys %$prereq_pm) {
91 0 0       0 if (my $want_version = $prereq_pm->{$k}{$self->id}) {
92 0 0       0 if (CPAN::Version->vcmp($have_version,$want_version) >= 0) {
93 0         0 $self->{incommandcolor} = $color;
94 0         0 return;
95             }
96             }
97             }
98             }
99             }
100             }
101             }
102             } else {
103 0         0 $self->{incommandcolor} = $color; # set me before recursion,
104             # so we can break it
105             }
106 0 0       0 if ($depth>=$CPAN::MAX_RECURSION) {
107 0         0 die(CPAN::Exception::RecursiveDependency->new($ancestors));
108             }
109             # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1;
110              
111 0 0       0 if ( my $dist = CPAN::Shell->expand("Distribution", $self->cpan_file) ) {
112 0         0 $dist->color_cmd_tmps($depth+1,$color,[@$ancestors, $self->id]);
113             }
114             # unreached code?
115             # if ($color==0) {
116             # delete $self->{badtestcnt};
117             # }
118 0         0 $self->{incommandcolor} = $color;
119             }
120              
121             #-> sub CPAN::Module::as_glimpse ;
122             sub as_glimpse {
123 0     0 0 0 my($self) = @_;
124 0         0 my(@m);
125 0         0 my $class = ref($self);
126 0         0 $class =~ s/^CPAN:://;
127 0         0 my $color_on = "";
128 0         0 my $color_off = "";
129 0 0 0     0 if (
      0        
130             $CPAN::Shell::COLOR_REGISTERED
131             &&
132             $CPAN::META->has_inst("Term::ANSIColor")
133             &&
134             $self->description
135             ) {
136 0         0 $color_on = Term::ANSIColor::color("green");
137 0         0 $color_off = Term::ANSIColor::color("reset");
138             }
139 0         0 my $uptodateness = " ";
140 0 0       0 unless ($class eq "Bundle") {
141 0         0 my $u = $self->uptodate;
142 0 0       0 $uptodateness = $u ? "=" : "<" if defined $u;
    0          
143             };
144 0         0 my $id = do {
145 0         0 my $d = $self->distribution;
146 0 0       0 $d ? $d -> pretty_id : $self->cpan_userid;
147             };
148 0         0 push @m, sprintf("%-7s %1s %s%-22s%s (%s)\n",
149             $class,
150             $uptodateness,
151             $color_on,
152             $self->id,
153             $color_off,
154             $id,
155             );
156 0         0 join "", @m;
157             }
158              
159             #-> sub CPAN::Module::dslip_status
160             sub dslip_status {
161 0     0 0 0 my($self) = @_;
162 0         0 my($stat);
163             # development status
164 0         0 @{$stat->{D}}{qw,i c a b R M S,} = qw,idea
  0         0  
165             pre-alpha alpha beta released
166             mature standard,;
167             # support level
168 0         0 @{$stat->{S}}{qw,m d u n a,} = qw,mailing-list
  0         0  
169             developer comp.lang.perl.*
170             none abandoned,;
171             # language
172 0         0 @{$stat->{L}}{qw,p c + o h,} = qw,perl C C++ other hybrid,;
  0         0  
173             # interface
174 0         0 @{$stat->{I}}{qw,f r O p h n,} = qw,functions
  0         0  
175             references+ties
176             object-oriented pragma
177             hybrid none,;
178             # public licence
179 0         0 @{$stat->{P}}{qw,p g l b a 2 o d r n,} = qw,Standard-Perl
  0         0  
180             GPL LGPL
181             BSD Artistic Artistic_2
182             open-source
183             distribution_allowed
184             restricted_distribution
185             no_licence,;
186 0         0 for my $x (qw(d s l i p)) {
187 0         0 $stat->{$x}{' '} = 'unknown';
188 0         0 $stat->{$x}{'?'} = 'unknown';
189             }
190 0         0 my $ro = $self->ro;
191 0 0 0     0 return +{} unless $ro && $ro->{statd};
192             return {
193             D => $ro->{statd},
194             S => $ro->{stats},
195             L => $ro->{statl},
196             I => $ro->{stati},
197             P => $ro->{statp},
198             DV => $stat->{D}{$ro->{statd}},
199             SV => $stat->{S}{$ro->{stats}},
200             LV => $stat->{L}{$ro->{statl}},
201             IV => $stat->{I}{$ro->{stati}},
202             PV => $stat->{P}{$ro->{statp}},
203 0         0 };
204             }
205              
206             #-> sub CPAN::Module::as_string ;
207             sub as_string {
208 0     0 0 0 my($self) = @_;
209 0         0 my(@m);
210 0 0       0 CPAN->debug("$self entering as_string") if $CPAN::DEBUG;
211 0         0 my $class = ref($self);
212 0         0 $class =~ s/^CPAN:://;
213 0         0 local($^W) = 0;
214 0         0 push @m, $class, " id = $self->{ID}\n";
215 0         0 my $sprintf = " %-12s %s\n";
216 0 0       0 push @m, sprintf($sprintf, 'DESCRIPTION', $self->description)
217             if $self->description;
218 0         0 my $sprintf2 = " %-12s %s (%s)\n";
219 0         0 my($userid);
220 0         0 $userid = $self->userid;
221 0 0       0 if ( $userid ) {
222 0         0 my $author;
223 0 0       0 if ($author = CPAN::Shell->expand('Author',$userid)) {
224 0         0 my $email = "";
225 0         0 my $m; # old perls
226 0 0       0 if ($m = $author->email) {
227 0         0 $email = " <$m>";
228             }
229 0         0 push @m, sprintf(
230             $sprintf2,
231             'CPAN_USERID',
232             $userid,
233             $author->fullname . $email
234             );
235             }
236             }
237 0 0       0 push @m, sprintf($sprintf, 'CPAN_VERSION', $self->cpan_version)
238             if $self->cpan_version;
239 0 0       0 if (my $cpan_file = $self->cpan_file) {
240 0         0 push @m, sprintf($sprintf, 'CPAN_FILE', $cpan_file);
241 0 0       0 if (my $dist = CPAN::Shell->expand("Distribution",$cpan_file)) {
242 0         0 my $upload_date = $dist->upload_date;
243 0 0       0 if ($upload_date) {
244 0         0 push @m, sprintf($sprintf, 'UPLOAD_DATE', $upload_date);
245             }
246             }
247             }
248 0         0 my $sprintf3 = " %-12s %1s%1s%1s%1s%1s (%s,%s,%s,%s,%s)\n";
249 0         0 my $dslip = $self->dslip_status;
250             push @m, sprintf(
251             $sprintf3,
252             'DSLIP_STATUS',
253 0         0 @{$dslip}{qw(D S L I P DV SV LV IV PV)},
254 0 0       0 ) if $dslip->{D};
255 0         0 my $local_file = $self->inst_file;
256 0 0       0 unless ($self->{MANPAGE}) {
257 0         0 my $manpage;
258 0 0       0 if ($local_file) {
259 0         0 $manpage = $self->manpage_headline($local_file);
260             } else {
261             # If we have already untarred it, we should look there
262 0         0 my $dist = $CPAN::META->instance('CPAN::Distribution',
263             $self->cpan_file);
264             # warn "dist[$dist]";
265             # mff=manifest file; mfh=manifest handle
266 0         0 my($mff,$mfh);
267 0 0 0     0 if (
      0        
268             $dist->{build_dir}
269             and
270             (-f ($mff = File::Spec->catfile($dist->{build_dir}, "MANIFEST")))
271             and
272             $mfh = FileHandle->new($mff)
273             ) {
274 0 0       0 CPAN->debug("mff[$mff]") if $CPAN::DEBUG;
275 0         0 my $lfre = $self->id; # local file RE
276 0         0 $lfre =~ s/::/./g;
277 0         0 $lfre .= "\\.pm\$";
278 0         0 my($lfl); # local file file
279 0         0 local $/ = "\n";
280 0         0 my(@mflines) = <$mfh>;
281 0         0 for (@mflines) {
282 0         0 s/^\s+//;
283 0         0 s/\s.*//s;
284             }
285 0   0     0 while (length($lfre)>5 and !$lfl) {
286 0         0 ($lfl) = grep /$lfre/, @mflines;
287 0 0       0 CPAN->debug("lfl[$lfl]lfre[$lfre]") if $CPAN::DEBUG;
288 0         0 $lfre =~ s/.+?\.//;
289             }
290 0         0 $lfl =~ s/\s.*//; # remove comments
291 0         0 $lfl =~ s/\s+//g; # chomp would maybe be too system-specific
292 0         0 my $lfl_abs = File::Spec->catfile($dist->{build_dir},$lfl);
293             # warn "lfl_abs[$lfl_abs]";
294 0 0       0 if (-f $lfl_abs) {
295 0         0 $manpage = $self->manpage_headline($lfl_abs);
296             }
297             }
298             }
299 0 0       0 $self->{MANPAGE} = $manpage if $manpage;
300             }
301 0         0 my($item);
302 0         0 for $item (qw/MANPAGE/) {
303             push @m, sprintf($sprintf, $item, $self->{$item})
304 0 0       0 if exists $self->{$item};
305             }
306 0         0 for $item (qw/CONTAINS/) {
307 0         0 push @m, sprintf($sprintf, $item, join(" ",@{$self->{$item}}))
308 0 0 0     0 if exists $self->{$item} && @{$self->{$item}};
  0         0  
309             }
310 0   0     0 push @m, sprintf($sprintf, 'INST_FILE',
311             $local_file || "(not installed)");
312 0 0       0 push @m, sprintf($sprintf, 'INST_VERSION',
313             $self->inst_version) if $local_file;
314 0 0       0 if (%{$CPAN::META->{is_tested}||{}}) { # XXX needs to be methodified somehow
  0 0       0  
315 0         0 my $available_file = $self->available_file;
316 0 0 0     0 if ($available_file && $available_file ne $local_file) {
317 0         0 push @m, sprintf($sprintf, 'AVAILABLE_FILE', $available_file);
318 0         0 push @m, sprintf($sprintf, 'AVAILABLE_VERSION', $self->available_version);
319             }
320             }
321 0         0 join "", @m, "\n";
322             }
323              
324             #-> sub CPAN::Module::manpage_headline
325             sub manpage_headline {
326 0     0 0 0 my($self,$local_file) = @_;
327 0         0 my(@local_file) = $local_file;
328 0         0 $local_file =~ s/\.pm(?!\n)\Z/.pod/;
329 0         0 push @local_file, $local_file;
330 0         0 my(@result,$locf);
331 0         0 for $locf (@local_file) {
332 0 0       0 next unless -f $locf;
333 0 0       0 my $fh = FileHandle->new($locf)
334             or $Carp::Frontend->mydie("Couldn't open $locf: $!");
335 0         0 my $inpod = 0;
336 0         0 local $/ = "\n";
337 0         0 while (<$fh>) {
338 0 0       0 $inpod = m/^=(?!head1\s+NAME\s*$)/ ? 0 :
    0          
339             m/^=head1\s+NAME\s*$/ ? 1 : $inpod;
340 0 0       0 next unless $inpod;
341 0 0       0 next if /^=/;
342 0 0       0 next if /^\s+$/;
343 0         0 chomp;
344 0         0 push @result, $_;
345             }
346 0         0 close $fh;
347 0 0       0 last if @result;
348             }
349 0         0 for (@result) {
350 0         0 s/^\s+//;
351 0         0 s/\s+$//;
352             }
353 0         0 join " ", @result;
354             }
355              
356             #-> sub CPAN::Module::cpan_file ;
357             # Note: also inherited by CPAN::Bundle
358             sub cpan_file {
359 20     20 0 28 my $self = shift;
360             # CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG;
361 20 100       62 unless ($self->ro) {
362 19         43 CPAN::Index->reload;
363             }
364 20         62 my $ro = $self->ro;
365 20 100 66     68 if ($ro && defined $ro->{CPAN_FILE}) {
366 1         6 return $ro->{CPAN_FILE};
367             } else {
368 19         47 my $userid = $self->userid;
369 19 50       35 if ( $userid ) {
370 0 0       0 if ($CPAN::META->exists("CPAN::Author",$userid)) {
371 0         0 my $author = $CPAN::META->instance("CPAN::Author",
372             $userid);
373 0         0 my $fullname = $author->fullname;
374 0         0 my $email = $author->email;
375 0 0 0     0 unless (defined $fullname && defined $email) {
376 0         0 return sprintf("Contact Author %s",
377             $userid,
378             );
379             }
380 0         0 return "Contact Author $fullname <$email>";
381             } else {
382 0         0 return "Contact Author $userid (Email address not available)";
383             }
384             } else {
385 19         101 return "N/A";
386             }
387             }
388             }
389              
390             #-> sub CPAN::Module::cpan_version ;
391             sub cpan_version {
392 1     1 0 2 my $self = shift;
393              
394 1         5 my $ro = $self->ro;
395 1 50       6 unless ($ro) {
396             # Can happen with modules that are not on CPAN
397 0         0 $ro = {};
398             }
399             $ro->{CPAN_VERSION} = 'undef'
400 1 50       4 unless defined $ro->{CPAN_VERSION};
401 1         4 $ro->{CPAN_VERSION};
402             }
403              
404             #-> sub CPAN::Module::force ;
405             sub force {
406 0     0 0 0 my($self) = @_;
407 0         0 $self->{force_update} = 1;
408             }
409              
410             #-> sub CPAN::Module::fforce ;
411             sub fforce {
412 0     0 0 0 my($self) = @_;
413 0         0 $self->{force_update} = 2;
414             }
415              
416             #-> sub CPAN::Module::notest ;
417             sub notest {
418 0     0 0 0 my($self) = @_;
419             # $CPAN::Frontend->mywarn("XDEBUG: set notest for Module");
420 0         0 $self->{notest}++;
421             }
422              
423             #-> sub CPAN::Module::rematein ;
424             sub rematein {
425 0     0 0 0 my($self,$meth) = @_;
426 0         0 $CPAN::Frontend->myprint(sprintf("Running %s for module '%s'\n",
427             $meth,
428             $self->id));
429 0         0 my $cpan_file = $self->cpan_file;
430 0 0 0     0 if ($cpan_file eq "N/A" || $cpan_file =~ /^Contact Author/) {
431 0         0 $CPAN::Frontend->mywarn(sprintf qq{
432             The module %s isn\'t available on CPAN.
433              
434             Either the module has not yet been uploaded to CPAN, or it is
435             temporary unavailable. Please contact the author to find out
436             more about the status. Try 'i %s'.
437             },
438             $self->id,
439             $self->id,
440             );
441 0         0 return;
442             }
443 0         0 my $pack = $CPAN::META->instance('CPAN::Distribution',$cpan_file);
444 0         0 $pack->called_for($self->id);
445 0 0       0 if (exists $self->{force_update}) {
446 0 0       0 if ($self->{force_update} == 2) {
447 0         0 $pack->fforce($meth);
448             } else {
449 0         0 $pack->force($meth);
450             }
451             }
452 0 0 0     0 $pack->notest($meth) if exists $self->{notest} && $self->{notest};
453              
454 0   0     0 $pack->{reqtype} ||= "";
455 0 0       0 CPAN->debug("dist-reqtype[$pack->{reqtype}]".
456             "self-reqtype[$self->{reqtype}]") if $CPAN::DEBUG;
457 0 0       0 if ($pack->{reqtype}) {
458 0 0 0     0 if ($pack->{reqtype} eq "b" && $self->{reqtype} =~ /^[rc]$/) {
459 0         0 $pack->{reqtype} = $self->{reqtype};
460 0 0 0     0 if (
    0          
461             exists $pack->{install}
462             &&
463             (
464             UNIVERSAL::can($pack->{install},"failed") ?
465             $pack->{install}->failed :
466             $pack->{install} =~ /^NO/
467             )
468             ) {
469 0         0 delete $pack->{install};
470 0         0 $CPAN::Frontend->mywarn
471             ("Promoting $pack->{ID} from 'build_requires' to 'requires'");
472             }
473             }
474             } else {
475 0         0 $pack->{reqtype} = $self->{reqtype};
476             }
477              
478 0         0 my $success = eval {
479 0         0 $pack->$meth();
480             };
481 0         0 my $err = $@;
482 0 0 0     0 $pack->unforce if $pack->can("unforce") && exists $self->{force_update};
483 0 0 0     0 $pack->unnotest if $pack->can("unnotest") && exists $self->{notest};
484 0         0 delete $self->{force_update};
485 0         0 delete $self->{notest};
486 0 0       0 if ($err) {
487 0         0 die $err;
488             }
489 0         0 return $success;
490             }
491              
492             #-> sub CPAN::Module::perldoc ;
493 0     0 0 0 sub perldoc { shift->rematein('perldoc') }
494             #-> sub CPAN::Module::readme ;
495 0     0 0 0 sub readme { shift->rematein('readme') }
496             #-> sub CPAN::Module::look ;
497 0     0 0 0 sub look { shift->rematein('look') }
498             #-> sub CPAN::Module::cvs_import ;
499 0     0 0 0 sub cvs_import { shift->rematein('cvs_import') }
500             #-> sub CPAN::Module::get ;
501 0     0 0 0 sub get { shift->rematein('get',@_) }
502             #-> sub CPAN::Module::make ;
503 0     0 0 0 sub make { shift->rematein('make') }
504             #-> sub CPAN::Module::test ;
505             sub test {
506 0     0 0 0 my $self = shift;
507             # $self->{badtestcnt} ||= 0;
508 0         0 $self->rematein('test',@_);
509             }
510              
511             #-> sub CPAN::Module::deprecated_in_core ;
512             sub deprecated_in_core {
513 1     1 0 3 my ($self) = @_;
514 1 50 33     5 return unless $CPAN::META->has_inst('Module::CoreList') && Module::CoreList->can('is_deprecated');
515 1         10 return Module::CoreList::is_deprecated($self->{ID});
516             }
517              
518             #-> sub CPAN::Module::inst_deprecated;
519             # Indicates whether the *installed* version of the module is a deprecated *and*
520             # installed as part of the Perl core library path
521             sub inst_deprecated {
522 1     1 0 3 my ($self) = @_;
523 1 50       3 my $inst_file = $self->inst_file or return;
524 1   33     8 return $self->deprecated_in_core && $self->_in_priv_or_arch($inst_file);
525             }
526              
527             #-> sub CPAN::Module::uptodate ;
528             sub uptodate {
529 1     1 0 8 my ($self) = @_;
530 1         2 local ($_);
531 1 50       10 my $inst = $self->inst_version or return 0;
532 1         7 my $cpan = $self->cpan_version;
533 1 50 33     10 return 0 if CPAN::Version->vgt($cpan,$inst) || $self->inst_deprecated;
534 1 50       519 CPAN->debug
535             (join
536             ("",
537             "returning uptodate. ",
538             "cpan[$cpan]inst[$inst]",
539             )) if $CPAN::DEBUG;
540 1         5 return 1;
541             }
542              
543             # returns true if installed in privlib or archlib
544             sub _in_priv_or_arch {
545 0     0   0 my($self,$inst_file) = @_;
546 0         0 foreach my $pair (
547             [qw(sitearchexp archlibexp)],
548             [qw(sitelibexp privlibexp)]
549             ) {
550 0         0 my ($site, $priv) = @Config::Config{@$pair};
551 0 0       0 if ($^O eq 'VMS') {
552 0         0 for my $d ($site, $priv) { $d = VMS::Filespec::unixify($d) };
  0         0  
553             }
554 0         0 s!/*$!!g foreach $site, $priv;
555 0 0       0 next if $site eq $priv;
556              
557 0 0       0 if ($priv eq substr($inst_file,0,length($priv))) {
558 0         0 return 1;
559             }
560             }
561 0         0 return 0;
562             }
563              
564             #-> sub CPAN::Module::install ;
565             sub install {
566 0     0 0 0 my($self) = @_;
567 0         0 my($doit) = 0;
568 0 0 0     0 if ($self->uptodate
569             &&
570             not exists $self->{force_update}
571             ) {
572 0         0 $CPAN::Frontend->myprint(sprintf("%s is up to date (%s).\n",
573             $self->id,
574             $self->inst_version,
575             ));
576             } else {
577 0         0 $doit = 1;
578             }
579 0         0 my $ro = $self->ro;
580 0 0 0     0 if ($ro && $ro->{stats} && $ro->{stats} eq "a") {
      0        
581 0         0 $CPAN::Frontend->mywarn(qq{
582             \n\n\n ***WARNING***
583             The module $self->{ID} has no active maintainer (CPAN support level flag 'abandoned').\n\n\n
584             });
585 0         0 $CPAN::Frontend->mysleep(5);
586             }
587 0 0       0 return $doit ? $self->rematein('install') : 1;
588             }
589             #-> sub CPAN::Module::clean ;
590 0     0 0 0 sub clean { shift->rematein('clean') }
591              
592             #-> sub CPAN::Module::inst_file ;
593             sub inst_file {
594 2     2 0 4 my($self) = @_;
595 2         21 $self->_file_in_path([@INC]);
596             }
597              
598             #-> sub CPAN::Module::available_file ;
599             sub available_file {
600 0     0 0 0 my($self) = @_;
601 0         0 my $sep = $Config::Config{path_sep};
602 0         0 my $perllib = $ENV{PERL5LIB};
603 0 0       0 $perllib = $ENV{PERLLIB} unless defined $perllib;
604 0 0       0 my @perllib = split(/$sep/,$perllib) if defined $perllib;
605 0         0 my @cpan_perl5inc;
606 0 0       0 if ($CPAN::Perl5lib_tempfile) {
607 0         0 my $yaml = CPAN->_yaml_loadfile($CPAN::Perl5lib_tempfile);
608 0 0       0 @cpan_perl5inc = @{$yaml->[0]{inc} || []};
  0         0  
609             }
610 0         0 $self->_file_in_path([@cpan_perl5inc,@perllib,@INC]);
611             }
612              
613             #-> sub CPAN::Module::file_in_path ;
614             sub _file_in_path {
615 2     2   5 my($self,$path) = @_;
616 2         2 my($dir,@packpath);
617 2         8 @packpath = split /::/, $self->{ID};
618 2         3 $packpath[-1] .= ".pm";
619 2 50 33     16 if (@packpath == 1 && $packpath[0] eq "readline.pm") {
620 0         0 unshift @packpath, "Term", "ReadLine"; # historical reasons
621             }
622 2         5 foreach $dir (@$path) {
623 20         156 my $pmfile = File::Spec->catfile($dir,@packpath);
624 20 100       414 if (-f $pmfile) {
625 2         12 return $pmfile;
626             }
627             }
628 0         0 return;
629             }
630              
631             #-> sub CPAN::Module::xs_file ;
632             sub xs_file {
633 0     0 0 0 my($self) = @_;
634 0         0 my($dir,@packpath);
635 0         0 @packpath = split /::/, $self->{ID};
636 0         0 push @packpath, $packpath[-1];
637 0         0 $packpath[-1] .= "." . $Config::Config{'dlext'};
638 0         0 foreach $dir (@INC) {
639 0         0 my $xsfile = File::Spec->catfile($dir,'auto',@packpath);
640 0 0       0 if (-f $xsfile) {
641 0         0 return $xsfile;
642             }
643             }
644 0         0 return;
645             }
646              
647             #-> sub CPAN::Module::inst_version ;
648             sub inst_version {
649 1     1 0 2 my($self) = @_;
650 1 50       4 my $parsefile = $self->inst_file or return;
651 1         6 my $have = $self->parse_version($parsefile);
652 1         5 $have;
653             }
654              
655             #-> sub CPAN::Module::inst_version ;
656             sub available_version {
657 0     0 0 0 my($self) = @_;
658 0 0       0 my $parsefile = $self->available_file or return;
659 0         0 my $have = $self->parse_version($parsefile);
660 0         0 $have;
661             }
662              
663             #-> sub CPAN::Module::parse_version ;
664             sub parse_version {
665 1     1 0 3 my($self,$parsefile) = @_;
666 1 50       3 if (ALARM_IMPLEMENTED) {
667             my $timeout = (exists($CPAN::Config{'version_timeout'}))
668 1 50       4 ? $CPAN::Config{'version_timeout'}
669             : 15;
670 1         16 alarm($timeout);
671             }
672 1         2 my $have = eval {
673 1     0   24 local $SIG{ALRM} = sub { die "alarm\n" };
  0         0  
674 1         40 MM->parse_version($parsefile);
675             };
676 1 50       584 if ($@) {
677 0         0 $CPAN::Frontend->mywarn("Error while parsing version number in file '$parsefile'\n");
678             }
679 1 50       3 alarm(0) if ALARM_IMPLEMENTED;
680 1 50       3 my $leastsanity = eval { defined $have && length $have; };
  1         10  
681 1 50       4 $have = "undef" unless $leastsanity;
682 1         6 $have =~ s/^ //; # since the %vd hack these two lines here are needed
683 1         3 $have =~ s/ $//; # trailing whitespace happens all the time
684              
685 1         12 $have = CPAN::Version->readable($have);
686              
687 1         10 $have =~ s/\s*//g; # stringify to float around floating point issues
688 1         4 $have; # no stringify needed, \s* above matches always
689             }
690              
691             #-> sub CPAN::Module::reports
692             sub reports {
693 0     0 0   my($self) = @_;
694 0           $self->distribution->reports;
695             }
696              
697             1;