FM / CPAN

/usr/share/perl5/CPAN

Name	Size	Mode	Actions
API/	-	0755	rm
Exception/	-	0755	rm
FTP/	-	0755	rm
HTTP/	-	0755	rm
Kwalify/	-	0755	rm
LWP/	-	0755	rm
Meta/	-	0755	rm
Plugin/	-	0755	rm
Admin.pm	7780	0444	edit dl rm
Author.pm	6762	0644	edit dl rm
Bundle.pm	9246	0644	edit dl rm
CacheMgr.pm	7537	0644	edit dl rm
Complete.pm	5987	0644	edit dl rm
Config.pm	9890	0644	edit dl rm
Config.pm.1434977693	8985	0644	edit dl rm
Config.pm.1444819868	9124	0644	edit dl rm
Config.pm.1444888049	8987	0644	edit dl rm
Config.pm.1461727960	8987	0644	edit dl rm
Config.pm.1461729994	9151	0644	edit dl rm
Config.pm.1461731967	9151	0644	edit dl rm
Config.pm.1495429294	9151	0644	edit dl rm
Config.pm.1495430169	10263	0644	edit dl rm
Config.pm.1495430701	10263	0644	edit dl rm
Config.pm.1495431258	10263	0644	edit dl rm
Config.pm.1504457527	10263	0644	edit dl rm
Config.pm.1504459141	9493	0644	edit dl rm
Config.pm.1504459628	9493	0644	edit dl rm
Config.pm.1552234956	9493	0644	edit dl rm
Config.pm.1552237737	9891	0644	edit dl rm
Debug.pm	1998	0644	edit dl rm
DeferredCode.pm	189	0644	edit dl rm
Distribution.pm	144125	0644	edit dl rm
Distroprefs.pm	11107	0644	edit dl rm
Distrostatus.pm	972	0644	edit dl rm
FirstTime.pm	57496	0644	edit dl rm
FTP.pm	39868	0644	edit dl rm
HandleConfig.pm	21521	0644	edit dl rm
Index.pm	21662	0644	edit dl rm
InfoObj.pm	6909	0644	edit dl rm
Kwalify.pm	3428	0644	edit dl rm
Mirrors.pm	16687	0444	edit dl rm
Module.pm	21721	0644	edit dl rm
Nox.pm	928	0644	edit dl rm
Plugin.pm	3204	0444	edit dl rm
Prompt.pm	567	0644	edit dl rm
Queue.pm	6369	0644	edit dl rm
Shell.pm	68763	0644	edit dl rm
Tarzip.pm	13889	0644	edit dl rm
URL.pm	588	0644	edit dl rm
Version.pm	4322	0644	edit dl rm

Edit: /usr/share/perl5/CPAN/CacheMgr.pm (7537B)

# -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
# vim: ts=4 sts=4 sw=4:
package CPAN::CacheMgr;
use strict;
use CPAN::InfoObj;
@CPAN::CacheMgr::ISA = qw(CPAN::InfoObj CPAN);
use Cwd qw(chdir);
use File::Find;

use vars qw(
            $VERSION
);
$VERSION = "5.5";

package CPAN::CacheMgr;
use strict;

#-> sub CPAN::CacheMgr::as_string ;
sub as_string {
    eval { require Data::Dumper };
    if ($@) {
        return shift->SUPER::as_string;
    } else {
        return Data::Dumper::Dumper(shift);
    }
}

#-> sub CPAN::CacheMgr::cachesize ;
sub cachesize {
    shift->{DU};
}

#-> sub CPAN::CacheMgr::tidyup ;
sub tidyup {
  my($self) = @_;
  return unless $CPAN::META->{LOCK};
  return unless -d $self->{ID};
  my @toremove = grep { $self->{SIZE}{$_}==0 } @{$self->{FIFO}};
  for my $current (0..$#toremove) {
    my $toremove = $toremove[$current];
    $CPAN::Frontend->myprint(sprintf(
                                     "DEL(%d/%d): %s \n",
                                     $current+1,
                                     scalar @toremove,
                                     $toremove,
                                    )
                            );
    return if $CPAN::Signal;
    $self->_clean_cache($toremove);
    return if $CPAN::Signal;
  }
}

#-> sub CPAN::CacheMgr::dir ;
sub dir {
    shift->{ID};
}

#-> sub CPAN::CacheMgr::entries ;
sub entries {
    my($self,$dir) = @_;
    return unless defined $dir;
    $self->debug("reading dir[$dir]") if $CPAN::DEBUG;
    $dir ||= $self->{ID};
    my($cwd) = CPAN::anycwd();
    chdir $dir or Carp::croak("Can't chdir to $dir: $!");
    my $dh = DirHandle->new(File::Spec->curdir)
        or Carp::croak("Couldn't opendir $dir: $!");
    my(@entries);
    for ($dh->read) {
        next if $_ eq "." || $_ eq "..";
        if (-f $_) {
            push @entries, File::Spec->catfile($dir,$_);
        } elsif (-d _) {
            push @entries, File::Spec->catdir($dir,$_);
        } else {
            $CPAN::Frontend->mywarn("Warning: weird direntry in $dir: $_\n");
        }
    }
    chdir $cwd or Carp::croak("Can't chdir to $cwd: $!");
    sort { -M $a <=> -M $b} @entries;
}

#-> sub CPAN::CacheMgr::disk_usage ;
sub disk_usage {
    my($self,$dir,$fast) = @_;
    return if exists $self->{SIZE}{$dir};
    return if $CPAN::Signal;
    my($Du) = 0;
    if (-e $dir) {
        if (-d $dir) {
            unless (-x $dir) {
                unless (chmod 0755, $dir) {
                    $CPAN::Frontend->mywarn("I have neither the -x permission nor the ".
                                            "permission to change the permission; cannot ".
                                            "estimate disk usage of '$dir'\n");
                    $CPAN::Frontend->mysleep(5);
                    return;
                }
            }
        } elsif (-f $dir) {
            # nothing to say, no matter what the permissions
        }
    } else {
        $CPAN::Frontend->mywarn("File or directory '$dir' has gone, ignoring\n");
        return;
    }
    if ($fast) {
        $Du = 0; # placeholder
    } else {
        find(
             sub {
           $File::Find::prune++ if $CPAN::Signal;
           return if -l $_;
           if ($^O eq 'MacOS') {
             require Mac::Files;
             my $cat  = Mac::Files::FSpGetCatInfo($_);
             $Du += $cat->ioFlLgLen() + $cat->ioFlRLgLen() if $cat;
           } else {
             if (-d _) {
               unless (-x _) {
                 unless (chmod 0755, $_) {
                   $CPAN::Frontend->mywarn("I have neither the -x permission nor ".
                                           "the permission to change the permission; ".
                                           "can only partially estimate disk usage ".
                                           "of '$_'\n");
                   $CPAN::Frontend->mysleep(5);
                   return;
                 }
               }
             } else {
               $Du += (-s _);
             }
           }
         },
         $dir
            );
    }
    return if $CPAN::Signal;
    $self->{SIZE}{$dir} = $Du/1024/1024;
    unshift @{$self->{FIFO}}, $dir;
    $self->debug("measured $dir is $Du") if $CPAN::DEBUG;
    $self->{DU} += $Du/1024/1024;
    $self->{DU};
}

#-> sub CPAN::CacheMgr::_clean_cache ;
sub _clean_cache {
    my($self,$dir) = @_;
    return unless -e $dir;
    unless (File::Spec->canonpath(File::Basename::dirname($dir))
            eq File::Spec->canonpath($CPAN::Config->{build_dir})) {
        $CPAN::Frontend->mywarn("Directory '$dir' not below $CPAN::Config->{build_dir}, ".
                                "will not remove\n");
        $CPAN::Frontend->mysleep(5);
        return;
    }
    $self->debug("have to rmtree $dir, will free $self->{SIZE}{$dir}")
        if $CPAN::DEBUG;
    File::Path::rmtree($dir);
    my $id_deleted = 0;
    if ($dir !~ /\.yml$/ && -f "$dir.yml") {
        my $yaml_module = CPAN::_yaml_module();
        if ($CPAN::META->has_inst($yaml_module)) {
            my($peek_yaml) = eval { CPAN->_yaml_loadfile("$dir.yml"); };
            if ($@) {
                $CPAN::Frontend->mywarn("(parse error on '$dir.yml' removing anyway)");
                unlink "$dir.yml" or
                    $CPAN::Frontend->mywarn("(Could not unlink '$dir.yml': $!)");
                return;
            } elsif (my $id = $peek_yaml->[0]{distribution}{ID}) {
                $CPAN::META->delete("CPAN::Distribution", $id);

# XXX we should restore the state NOW, otherise this
                # distro does not exist until we read an index. BUG ALERT(?)

# $CPAN::Frontend->mywarn (" +++\n");
                $id_deleted++;
            }
        }
        unlink "$dir.yml"; # may fail
        unless ($id_deleted) {
            CPAN->debug("no distro found associated with '$dir'");
        }
    }
    $self->{DU} -= $self->{SIZE}{$dir};
    delete $self->{SIZE}{$dir};
}

#-> sub CPAN::CacheMgr::new ;
sub new {
    my $class = shift;
    my $time = time;
    my($debug,$t2);
    $debug = "";
    my $self = {
        ID => $CPAN::Config->{build_dir},
        MAX => $CPAN::Config->{'build_cache'},
        SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
        DU => 0
    };
    File::Path::mkpath($self->{ID});
    my $dh = DirHandle->new($self->{ID});
    bless $self, $class;
    $self->scan_cache;
    $t2 = time;
    $debug .= "timing of CacheMgr->new: ".($t2 - $time);
    $time = $t2;
    CPAN->debug($debug) if $CPAN::DEBUG;
    $self;
}

#-> sub CPAN::CacheMgr::scan_cache ;
sub scan_cache {
    my $self = shift;
    return if $self->{SCAN} eq 'never';
    $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
        unless $self->{SCAN} eq 'atstart';
    return unless $CPAN::META->{LOCK};
    $CPAN::Frontend->myprint(
                             sprintf("Scanning cache %s for sizes\n",
                             $self->{ID}));
    my $e;
    my @entries = $self->entries($self->{ID});
    my $i = 0;
    my $painted = 0;
    for $e (@entries) {
        my $symbol = ".";
        if ($self->{DU} > $self->{MAX}) {
            $symbol = "-";
            $self->disk_usage($e,1);
        } else {
            $self->disk_usage($e);
        }
        $i++;
        while (($painted/76) < ($i/@entries)) {
            $CPAN::Frontend->myprint($symbol);
            $painted++;
        }
        return if $CPAN::Signal;
    }
    $CPAN::Frontend->myprint("DONE\n");
    $self->tidyup;
}

cmd: