/usr/share/perl5/Sepia/CPAN.pm is in sepia 0.991.05-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 | package Sepia::CPAN;
use CPAN ();
sub init
{
CPAN::HandleConfig->load;
CPAN::Shell::setup_output;
CPAN::Index->reload;
}
sub interesting_parts
{
my $mod = shift;
# XXX: stupid CPAN.pm functions die for some modules...
+{ map {
$_ => scalar eval { $mod->$_ }
} qw(id cpan_version inst_version fullname cpan_file)};
}
# Only list the "root" module of each package, meaning either (1) the
# module matching the dist name or (2) the module with the shortest
# name, whichever comes first.
# XXX: this is hacky.
sub group_by_dist
{
my %h;
for (@_) {
my $cf = $_->{cpan_file};
if (!exists $h{$cf}) {
$h{$_->{cpan_file}} = $_;
} else {
(my $tmp = $cf) =~ s/-/::/g;
if ($tmp =~ /^\Q$h{$cf}{id}\E/) {
next; # already perfect
} elsif ($tmp =~ /^\Q$_->{id}\E/) {
$h{$cf} = $_; # perfect
} # elsif (length $h{$cf}{id} > length $_->{id}) {
# $h{$cf} = $_; # short, at least...
# }
}
}
sort { $a->{id} cmp $b->{id} } values %h;
}
sub _list
{
CPAN::Shell->expand('Module', shift || '/./');
}
sub list
{
group_by_dist map { interesting_parts $_ } _list @_
}
sub _ls
{
my $want = shift;
grep {
# XXX: key to test in this order, because inst_file is slow.
$_->userid eq $want
} CPAN::Shell->expand('Module', '/./')
}
sub ls
{
group_by_dist map { interesting_parts $_ } _ls @_
}
sub _desc
{
my $pat = qr/$_[0]/i;
grep {
$_->description &&
($_->description =~ /$pat/ || $_->id =~ /$pat/)
} CPAN::Shell->expand('Module', '/./');
}
sub desc
{
group_by_dist map { interesting_parts $_ } _desc @_;
}
sub outdated
{
grep !$_->uptodate, list @_;
}
## stolen from CPAN::Shell...
sub readme
{
my $dist = CPAN::Shell->expand('Module', shift);
return unless $dist;
my $wantfile = shift;
$dist = $dist->cpan_file;
# my ($dist) = $self->id;
my ($sans, $suffix) = $dist =~ /(.+)\.(tgz|tar[\._-]gz|tar\.Z|zip)$/;
my ($local_file);
my ($local_wanted) = File::Spec->catfile(
$CPAN::Config->{keep_source_where}, "authors", "id",
split(/\//,"$sans.readme"));
$local_file = CPAN::FTP->localize("authors/id/$sans.readme", $local_wanted);
## Return filename rather than contents to avoid Elisp reader issues...
if ($wantfile) {
$local_file;
} else {
local (*IN, $/);
open IN, $local_wanted;
my $ret = <IN>;
close IN;
$ret;
}
}
sub perldoc
{
eval q{ use LWP::Simple; };
if ($@) {
print STDERR "Can't get perldocs: LWP::Simple not installed.\n";
"Can't get perldocs: LWP::Simple not installed.\n";
} else {
*perldoc = sub { get($CPAN::Defaultdocs . shift) };
goto &perldoc;
}
}
sub install
{
my $dist = CPAN::Shell->expand('Module', shift);
$dist->install if $dist;
}
# Based on CPAN::Shell::_u_r_common
sub _recommend
{
my $pat = shift || '/./';
my (@result, %seen, %need);
$version_undefs = $version_zeroes = 0;
for my $module (CPAN::Shell->expand('Module',$pat)) {
my $file = $module->cpan_file;
next unless defined $file && $module->inst_file;
$file =~ s!^./../!!;
my $latest = $module->cpan_version;
my $have = $module->inst_version;
local ($^W) = 0;
next unless CPAN::Version->vgt($latest, $have);
push @result, $module;
next if $seen{$file}++;
$need{$module->id}++;
}
@result;
}
sub recommend
{
group_by_dist map { interesting_parts $_ } _recommend @_;
}
1;
|