-
Notifications
You must be signed in to change notification settings - Fork 0
/
cpan_watch.pl
87 lines (67 loc) · 2.01 KB
/
cpan_watch.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
#!/usr/bin/env perl
use strict;
use warnings;
use CPAN;
use ExtUtils::Installed;
use Getopt::Std;
BEGIN {
@MyFrontend::ISA = 'CPAN::Shell';
sub MyFrontend::myprint { 1 }
sub MyFrontend::mywarn { 1 }
$CPAN::Frontend = 'MyFrontend';
}
$ENV{FTP_PASSIVE} = 1;
my $MAILTO = 'root';
my $MAIL = '/bin/mail';
my %opts;
getopts( 'im', \%opts );
my $installed = ExtUtils::Installed->new();
my @module = grep( ! /^Perl$/, $installed->modules() );
my $subject;
my $message;
CPAN::Index->reload();
if ( $opts{i} ) {
$subject = 'Install update for CPAN-Modules';
foreach my $mod ( CPAN::Shell->expand( 'Module', @module ) ) {
next if ( $mod->uptodate );
$message .= '_' x 80 . "\n" . '-' x 80 . "\n";
$message .= $mod->id . "\n";
$message .= '-' x 80 . "\n";
$message .= 'Install Modul' . "\n";
my $old_version = $mod->inst_version;
if ( $mod->install ) {
$message .= 'Installation failed' . "\n";
}
else {
$message .= 'Old version :' . "\t" . $old_version . "\n";
$message .= 'New version :' . "\t" . $mod->cpan_version . "\n";
}
$message .= '_' x 80 . "\n\n";
}
unless ( $message ) {
$message = 'No updates installed.';
}
}
else {
$subject = 'Update for CPAN-Modules available';
foreach my $mod ( CPAN::Shell->expand( 'Module', @module ) ) {
next if ( $mod->uptodate );
$message .= '_' x 80 . "\n" . '-' x 80 . "\n";
$message .= $mod->id . "\n";
$message .= '-' x 80 . "\n";
$message .= 'Installed version :' . "\t" . $mod->inst_version . "\n";
$message .= 'CPAN version :' . "\t" . $mod->cpan_version . "\n";
$message .= '_' x 80 . "\n\n";
}
unless ( $message ) {
$message = 'No updates available.';
}
}
if ( $opts{m} ) {
open( PIPE, "|$MAIL" . ' -s "' . $subject . '" "' . $MAILTO . '"' );
print PIPE $message;
close( PIPE );
}
else {
print $subject . "\n\n" . $message . "\n";
}