File Coverage

blib/lib/CPAN/Module.pm
Criterion Covered Total %
statement 72 363 19.8
branch 24 206 11.6
condition 6 91 6.5
subroutine 15 42 35.7
pod 0 34 0.0
total 117 736 15.9


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