lib/CPAN/Module.pm

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