-
Notifications
You must be signed in to change notification settings - Fork 6
/
updater.pl
103 lines (90 loc) · 2.42 KB
/
updater.pl
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
use strict;
use warnings;
use Term::UI;
use Term::ReadLine;
use ExtUtils::Installed;
use File::Spec;
use File::Fetch;
use IO::Zlib;
use version;
use Module::Load::Conditional qw[check_install];
use CPANPLUS::Backend;
$ENV{PERL_MM_USE_DEFAULT} = 1; # despite verbose setting
$ENV{PERL_EXTUTILS_AUTOINSTALL} = '--defaultdeps';
my %installed;
my %cpan;
foreach my $module ( sort ExtUtils::Installed->new->modules() ) {
my $href = check_install( module => $module );
next unless $href;
$installed{ $module } = defined $href->{version} ? $href->{version} : 'undef';
}
my $loc = fetch_indexes('.','ftp://localhost/CPAN/') or die;
populate_cpan( $loc );
foreach my $module ( sort keys %installed ) {
# Eliminate core modules
if ( supplied_with_core( $module ) and !$cpan{ $module } ) {
delete $installed{ $module };
next;
}
if ( $installed{ $module } eq 'undef' and $cpan{ $module } eq 'undef' ) {
delete $installed{ $module };
next;
}
unless ( _vcmp( $cpan{ $module }, $installed{ $module} ) > 0 ) {
delete $installed{ $module };
next;
}
}
# Further eliminate choices.
my $term = Term::ReadLine->new('brand');
foreach my $module ( sort keys %installed ) {
delete $installed{ $module }
unless $term->ask_yn(
prompt => "Update module '$module' ?",
default => 'y',
);
}
my $cb = CPANPLUS::Backend->new();
my $conf = $cb->configure_object;
$conf->set_conf( 'prereqs' => 1 );
foreach my $mod ( sort keys %installed ) {
my $module = $cb->module_tree($mod);
next unless $module;
$module->install();
}
exit 0;
sub supplied_with_core {
my $name = shift;
my $ver = shift || $];
require Module::CoreList;
return $Module::CoreList::version{ 0+$ver }->{ $name };
}
sub _vcmp {
my ($x, $y) = @_;
s/_//g foreach $x, $y;
return version->parse($x) <=> version->parse($y);
}
sub populate_cpan {
my $pfile = shift;
my $fh = IO::Zlib->new( $pfile, "rb" ) or die "$!\n";
my %dists;
while (<$fh>) {
last if /^\s*$/;
}
while (<$fh>) {
chomp;
my ($module,$version,$package_path) = split ' ', $_;
$cpan{ $module } = $version;
}
return 1;
}
sub fetch_indexes {
my ($location,$mirror) = @_;
my $packages = 'modules/02packages.details.txt.gz';
my $url = join '', $mirror, $packages;
my $ff = File::Fetch->new( uri => $url );
my $stat = $ff->fetch( to => $location );
return unless $stat;
print "Downloaded '$url' to '$stat'\n";
return $stat;
}