MIME

Ejecución

lhp@nereida:~/Lperl/src/perl_networking/ch7$ mail_recent.pl Math
logging in
fetching RECENT file from ftp.perl.org/pub/CPANRECENT
retrieving Math-0.509.tar.gz
retrieving Math-Polynom-0.09.tar.gz
retrieving Math-0.511.tar.gz
retrieving Math-0.525.tar.gz
retrieving Math-Polynom-0.08.tar.gz
retrieving Math-0.514.tar.gz
retrieving Math-0.523.tar.gz
retrieving Math-0.506.tar.gz
sending mail

Código

lhp@nereida:~/Lperl/src/perl_networking/ch7$ cat -n mail_recent.pl
 1  #!/usr/bin/perl -w
 2  # See: ftp://ftp.perl.org/pub/CPAN/RECENT
 3  #      and ftp://ftp.perl.org/pub/CPAN/modules/by-module/
 4  use strict;
 5  use Net::FTP;
 6  use MIME::Entity;
 7
 8  use constant HOST   => 'ftp.perl.org';
 9  use constant DIR    => '/pub/CPAN';
10  use constant RECENT => 'RECENT';
11  use constant MAILTO => 'juan.sin.miedo@gmail.com';
12  use constant DEBUG  => 1;
13
14  my $regexp = shift || '.*';
15  my %RETRIEVE;
16  my $TMPDIR = $ENV{TMPDIR} || '/tmp';
17
18  warn "logging in\n" if DEBUG;
19
20  my $ftp = Net::FTP->new(HOST) or die "Couldn't connect: $@\n";
21  $ftp->login('anonymous')      or die $ftp->message;
22  $ftp->cwd(DIR)                or die $ftp->message;
23
24  # Get the RECENT file
25  warn "fetching RECENT file from ".HOST.DIR.RECENT."\n" if DEBUG;
26  my $fh = $ftp->retr(RECENT) or die $ftp->message;
27  while (<$fh>) {
28    chomp;
29
30    # File line format: modules/by-module/Lemonldap/Lemonldap-NG-Handler-0.8.tar.gz
31    $RETRIEVE{$1} = $_ if m{^modules/by-module/.+/([^/]+\.tar\.gz)};
32  }
33  $fh->close;
34
35  my $count = keys %RETRIEVE;
36  my $message = "Please find enclosed $count recent modules submitted to CPAN.\n\n";
37
38  # start the MIME message
39  my $mail = MIME::Entity->build(Subject => 'Recent CPAN submissions',
40                                 To       => MAILTO,
41                                 Type     => 'text/plain',
42                                 Encoding => '7bit',
43                                 Data     => $message,
44                                );
45
46  # get each of the named files and turn them into an attachment
47  my @dist = grep { /$regexp/i } keys %RETRIEVE;
48  for my $file (@dist) {
49    my $remote_path = $RETRIEVE{$file};
50    my $local_path  = "$TMPDIR/$file";
51    warn "retrieving $file\n" if DEBUG;
52    $ftp->get($remote_path,$local_path) or warn($ftp->message ) and next;
53    $mail->attach(Path        => $local_path,
54                  Encoding    => 'base64',
55                  Type        => 'application/x-gzip',
56                  Description => $file,
57                  Filename    => $file);
58  }
59
60  $mail->sign(File => "$ENV{HOME}/.signature") if -e "$ENV{HOME}/.signature";
61
62  warn "sending mail\n" if DEBUG;
63  $mail->send('sendmail');
64  $mail->purge;
65
66  $ftp->quit;



Subsecciones
Casiano Rodríguez León
Licencia de Creative Commons
Programación Distribuida y Mejora del Rendimiento
por Casiano Rodríguez León is licensed under a Creative Commons Reconocimiento 3.0 Unported License.

Permissions beyond the scope of this license may be available at http://campusvirtual.ull.es/ocw/course/view.php?id=44.
2012-06-19