File Coverage

blib/lib/CPAN/Module.pm
Criterion Covered Total %
statement 72 355 20.2
branch 24 200 12.0
condition 6 91 6.5
subroutine 15 42 35.7
pod 0 34 0.0
total 117 722 16.2


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   46 use strict;
  12         15  
  12         541  
5             @CPAN::Module::ISA = qw(CPAN::InfoObj);
6              
7 12         1076 use vars qw(
8             $VERSION
9 12     12   48 );
  12         23  
10             $VERSION = "5.5001";
11              
12             BEGIN {
13             # alarm() is not implemented in perl 5.6.x and earlier under Windows
14 12 50   12   41190 *ALARM_IMPLEMENTED = sub () { $] >= 5.007 || $^O !~ /MSWin/ };
  2     2   16  
15             }
16              
17             # Accessors
18             #-> sub CPAN::Module::userid
19             sub userid {
20 38     38 0 27 my $self = shift;
21 38         63 my $ro = $self->ro;
22 38 50       158 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 0         0 $ro->{description}
30             }
31              
32             #-> sub CPAN::Module::distribution
33             sub distribution {
34 1     1 0 3 my($self) = @_;
35 1         3 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 0 0 0     0 return if exists $self->{incommandcolor}
      0        
72             && $color==1
73             && $self->{incommandcolor}==$color;
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 0         0 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             };
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 0         0 push @m, sprintf(
251             $sprintf3,
252             'DSLIP_STATUS',
253 0 0       0 @{$dslip}{qw(D S L I P DV SV LV IV PV)},
254             ) 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 0 0       0 push @m, sprintf($sprintf, $item, $self->{$item})
304             if exists $self->{$item};
305             }
306 0         0 for $item (qw/CONTAINS/) {
307 0         0 push @m, sprintf($sprintf, $item, join(" ",@{$self->{$item}}))
  0         0  
308 0 0 0     0 if exists $self->{$item} && @{$self->{$item}};
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 21 my $self = shift;
360             # CPAN->debug(sprintf "id[%s]", $self->id) if $CPAN::DEBUG;
361 20 100       47 unless ($self->ro) {
362 19         39 CPAN::Index->reload;
363             }
364 20         47 my $ro = $self->ro;
365 20 100 66     45 if ($ro && defined $ro->{CPAN_FILE}) {
366 1         4 return $ro->{CPAN_FILE};
367             } else {
368 19         40 my $userid = $self->userid;
369 19 50       24 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         64 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         8 my $ro = $self->ro;
395 1 50       3 unless ($ro) {
396             # Can happen with modules that are not on CPAN
397 0         0 $ro = {};
398             }
399 1 50       3 $ro->{CPAN_VERSION} = 'undef'
400             unless defined $ro->{CPAN_VERSION};
401 1         3 $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 2 my ($self) = @_;
514 1 50 33     6 return unless $CPAN::META->has_inst('Module::CoreList') && Module::CoreList->can('is_deprecated');
515 1         13 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     7 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 10 my ($self) = @_;
530 1         2 local ($_);
531 1 50       7 my $inst = $self->inst_version or return 0;
532 1         4 my $cpan = $self->cpan_version;
533 1 50 33     7 return 0 if CPAN::Version->vgt($cpan,$inst) || $self->inst_deprecated;
534 1 50       575 CPAN->debug
535             (join
536             ("",
537             "returning uptodate. ",
538             "cpan[$cpan]inst[$inst]",
539             )) if $CPAN::DEBUG;
540 1         4 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 for my $confdirname (qw(archlibexp privlibexp)) {
547 0         0 my $confdir = $Config::Config{$confdirname};
548 0 0       0 if ($confdir eq substr($inst_file,0,length($confdir))) {
549 0         0 return 1;
550             }
551             }
552 0         0 return 0;
553             }
554              
555             #-> sub CPAN::Module::install ;
556             sub install {
557 0     0 0 0 my($self) = @_;
558 0         0 my($doit) = 0;
559 0 0 0     0 if ($self->uptodate
560             &&
561             not exists $self->{force_update}
562             ) {
563 0         0 $CPAN::Frontend->myprint(sprintf("%s is up to date (%s).\n",
564             $self->id,
565             $self->inst_version,
566             ));
567             } else {
568 0         0 $doit = 1;
569             }
570 0         0 my $ro = $self->ro;
571 0 0 0     0 if ($ro && $ro->{stats} && $ro->{stats} eq "a") {
      0        
572 0         0 $CPAN::Frontend->mywarn(qq{
573             \n\n\n ***WARNING***
574             The module $self->{ID} has no active maintainer (CPAN support level flag 'abandoned').\n\n\n
575             });
576 0         0 $CPAN::Frontend->mysleep(5);
577             }
578 0 0       0 return $doit ? $self->rematein('install') : 1;
579             }
580             #-> sub CPAN::Module::clean ;
581 0     0 0 0 sub clean { shift->rematein('clean') }
582              
583             #-> sub CPAN::Module::inst_file ;
584             sub inst_file {
585 2     2 0 4 my($self) = @_;
586 2         16 $self->_file_in_path([@INC]);
587             }
588              
589             #-> sub CPAN::Module::available_file ;
590             sub available_file {
591 0     0 0 0 my($self) = @_;
592 0         0 my $sep = $Config::Config{path_sep};
593 0         0 my $perllib = $ENV{PERL5LIB};
594 0 0       0 $perllib = $ENV{PERLLIB} unless defined $perllib;
595 0 0       0 my @perllib = split(/$sep/,$perllib) if defined $perllib;
596 0         0 my @cpan_perl5inc;
597 0 0       0 if ($CPAN::Perl5lib_tempfile) {
598 0         0 my $yaml = CPAN->_yaml_loadfile($CPAN::Perl5lib_tempfile);
599 0 0       0 @cpan_perl5inc = @{$yaml->[0]{inc} || []};
  0         0  
600             }
601 0         0 $self->_file_in_path([@cpan_perl5inc,@perllib,@INC]);
602             }
603              
604             #-> sub CPAN::Module::file_in_path ;
605             sub _file_in_path {
606 2     2   3 my($self,$path) = @_;
607 2         4 my($dir,@packpath);
608 2         10 @packpath = split /::/, $self->{ID};
609 2         3 $packpath[-1] .= ".pm";
610 2 50 33     15 if (@packpath == 1 && $packpath[0] eq "readline.pm") {
611 0         0 unshift @packpath, "Term", "ReadLine"; # historical reasons
612             }
613 2         7 foreach $dir (@$path) {
614 20         123 my $pmfile = File::Spec->catfile($dir,@packpath);
615 20 100       289 if (-f $pmfile) {
616 2         47 return $pmfile;
617             }
618             }
619 0         0 return;
620             }
621              
622             #-> sub CPAN::Module::xs_file ;
623             sub xs_file {
624 0     0 0 0 my($self) = @_;
625 0         0 my($dir,@packpath);
626 0         0 @packpath = split /::/, $self->{ID};
627 0         0 push @packpath, $packpath[-1];
628 0         0 $packpath[-1] .= "." . $Config::Config{'dlext'};
629 0         0 foreach $dir (@INC) {
630 0         0 my $xsfile = File::Spec->catfile($dir,'auto',@packpath);
631 0 0       0 if (-f $xsfile) {
632 0         0 return $xsfile;
633             }
634             }
635 0         0 return;
636             }
637              
638             #-> sub CPAN::Module::inst_version ;
639             sub inst_version {
640 1     1 0 3 my($self) = @_;
641 1 50       5 my $parsefile = $self->inst_file or return;
642 1         9 my $have = $self->parse_version($parsefile);
643 1         4 $have;
644             }
645              
646             #-> sub CPAN::Module::inst_version ;
647             sub available_version {
648 0     0 0 0 my($self) = @_;
649 0 0       0 my $parsefile = $self->available_file or return;
650 0         0 my $have = $self->parse_version($parsefile);
651 0         0 $have;
652             }
653              
654             #-> sub CPAN::Module::parse_version ;
655             sub parse_version {
656 1     1 0 2 my($self,$parsefile) = @_;
657 1 50       4 if (ALARM_IMPLEMENTED) {
658 1 50       4 my $timeout = (exists($CPAN::Config{'version_timeout'}))
659             ? $CPAN::Config{'version_timeout'}
660             : 15;
661 1         12 alarm($timeout);
662             }
663 1         2 my $have = eval {
664 1     0   30 local $SIG{ALRM} = sub { die "alarm\n" };
  0         0  
665 1         27 MM->parse_version($parsefile);
666             };
667 1 50       2990 if ($@) {
668 0         0 $CPAN::Frontend->mywarn("Error while parsing version number in file '$parsefile'\n");
669             }
670 1 50       4 alarm(0) if ALARM_IMPLEMENTED;
671 1 50       2 my $leastsanity = eval { defined $have && length $have; };
  1         9  
672 1 50       3 $have = "undef" unless $leastsanity;
673 1         6 $have =~ s/^ //; # since the %vd hack these two lines here are needed
674 1         2 $have =~ s/ $//; # trailing whitespace happens all the time
675              
676 1         14 $have = CPAN::Version->readable($have);
677              
678 1         7 $have =~ s/\s*//g; # stringify to float around floating point issues
679 1         3 $have; # no stringify needed, \s* above matches always
680             }
681              
682             #-> sub CPAN::Module::reports
683             sub reports {
684 0     0 0   my($self) = @_;
685 0           $self->distribution->reports;
686             }
687              
688             1;