Category Archives: Perl

Which IMAP-folders exist?

The following script will make a list of which folders exist in an IMAP account. The script requires you pass hostname, accountname and password on the commandline, but it should be quite easy to change as you like.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
#!/usr/bin/perl -w
use strict;
 
use Mail::IMAPClient::BodyStructure;
use Mail::IMAPClient;
 
my ($serv, $usr, $pwd) = (@ARGV); # server, username and password as comandline parameters...
 
my $imap = Mail::IMAPClient->new(Server=>$serv,User=>$usr,Password=>$pwd);
my @folders = $imap->folders;
 
foreach my $f (@folders) {
  print 	"$f is a folder with ", $imap->message_count($f), " messages.n";
}
 
exit();

POP3: List messages in mailbox

Lists sender and subject on all mails in mailbox. MIME::WordDecoder is used to parse heads as most mails often has ISO-8859-1 encoded parts. It should be save to test it on any mailbox as it dosn’t change or remove anything from the mailbox.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
#!/usr/local/bin/perl -w
use strict;
use Mail::POP3Client;
use MIME::WordDecoder;
 
my ($serv, $usr, $pwd) = (@ARGV); # server, username and password as comandline parameters...
 
my $wd = default MIME::WordDecoder;
 
my $pop = new Mail::POP3Client( USER => $usr, PASSWORD => $pwd, HOST => $serv );
print "Found " . $pop->Count() . " messages.n";
for (my $i = 1; $i <= $pop->Count(); $i++) {
  foreach ( $pop->Head( $i ) ) {
    if (/^(From|Subject):s+/i) {
  print $wd->decode($_);
    }
  }
  print "n";
}
 
exit();

Fetching recent headlines from a news server

The followig piece connects to a news-server and fetches subjects from the last week in a specific newsgroup (the Danish perl-newsgroup) and prints these.

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
#!/usr/bin/perl -w
use strict;
use Net::NNTP;
use MIME::Base64 qw(decode_base64);
use MIME::QuotedPrint qw(decode_qp);
 
my  $server= "sunsite.auc.dk";
print STDERR "connecting to $server... ";
my $nntp= Net::NNTP->new($server);
unless($nntp) {
  print STDERR "failedn";
  exit 1;
}
print STDERR "okn";
 
print STDERR "getting messages... ";
my $newstuff= $nntp->newnews(time - 7*24*2600, "dk.edb.programmering.perl");
unless($newstuff) {
  print STDERR "failedn";
  exit 1;
}
print STDERR "okn";
 
my @messages;
foreach my $msgid (@$newstuff) {
  my $head= $nntp->head($msgid);
  next unless $head;
 
  my %msg;
  push @messages, %msg;
  foreach(@$head) {
    next unless /^(Newsgroups|Subject|From):s+(.+)$/i;
    $msg{lc $1}= $2;
  }
}
 
my $last= "";
foreach(sort { $a->{newsgroups} cmp $b->{newsgroups} } @messages) {
  if($_->{newsgroups} ne $last) {
    print "n" if $last;
    $last= $_->{newsgroups};
    print "$last:n";
  }
  print "t" . decode_header($_->{subject}) .
    " - " . decode_header($_->{from}) ."n";
}
 
sub decode_header {
  my($text)= @_;
 
  $text=~ s/=?(iso-?8859-.?|us-ascii|utf-8)?(q|b)?([^?]*)?=(s*(?==?))?/&decode_header_block(lc $1,$2,$3);/gei;
  return $text;
}
 
sub decode_header_block {
  my ($input,$enc,$text) = @_;
  if ($enc =~ /q/i) {
    $text=~ s/_/ /g;
    $text= decode_qp($text);
  } else {
    $text= decode_base64($text);
  }
  return $text; # oh well  [:-)]
}
 
exit();

Fetching available newsgroups from a news server

This script fetches a list of available newsgroups (and descriptions) from a news server. The group list is returned as a hashref where the keys are the groupname and the value is a description of the group.

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
#!/usr/bin/perl -w
use strict;
use Net::NNTP;
use MIME::Base64 qw(decode_base64);
use MIME::QuotedPrint qw(decode_qp);
 
my  $server= "sunsite.auc.dk";
print STDERR "connecting to $server... ";
my $nntp= Net::NNTP->new($server);
unless($nntp) {
  print STDERR "failedn";
  exit 1;
}
print STDERR "okn";
 
print STDERR "getting messages... ";
my $newstuff= $nntp->newnews(time - 7*24*2600, "dk.edb.programmering.perl");
unless($newstuff) {
  print STDERR "failedn";
  exit 1;
}
print STDERR "okn";
 
my @messages;
foreach my $msgid (@$newstuff) {
  my $head= $nntp->head($msgid);
  next unless $head;
 
  my %msg;
  push @messages, %msg;
  foreach(@$head) {
    next unless /^(Newsgroups|Subject|From):s+(.+)$/i;
    $msg{lc $1}= $2;
  }
}
 
my $last= "";
foreach(sort { $a->{newsgroups} cmp $b->{newsgroups} } @messages) {
  if($_->{newsgroups} ne $last) {
    print "n" if $last;
    $last= $_->{newsgroups};
    print "$last:n";
  }
  print "t" . decode_header($_->{subject}) .
    " - " . decode_header($_->{from}) ."n";
}
 
sub decode_header {
  my($text)= @_;
 
  $text=~ s/=?(iso-?8859-.?|us-ascii|utf-8)?(q|b)?([^?]*)?=(s*(?==?))?/&decode_header_block(lc $1,$2,$3);/gei;
  return $text;
}
 
sub decode_header_block {
  my ($input,$enc,$text) = @_;
  if ($enc =~ /q/i) {
    $text=~ s/_/ /g;
    $text= decode_qp($text);
  } else {
    $text= decode_base64($text);
  }
  return $text; # oh well  [:-)]
}
 
exit();

Parsing RSS feeds

del.icio.us is a neat service for managing an online bookmark collection. With a little bit of Perl and a few CPAN modules, you can fetch your most recent bookmarks and include them as links on your homepage.

The sample script could be used in a cronjob and creates a file on you local server. It downloads my del.icio.us bookmark feed, chops it down to the ten most recent bookmarks and writes a unordered bullet list. You may need to adapt the template to your specific needs.

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
#!/usr/local/perl/bin/perl
use strict;
use warnings;
 
use LWP::Simple;
use XML::RSS;
use HTML::Template;
 
my $file = 'include_links.txt';
 
my @links;
my $tmpl = HTML::Template->new(filename => 'rssFetch.tmpl');
my $rss = XML::RSS->new();
my $data = get( 'http://del.icio.us/rss/mahler' ); # RSS Source
$rss->parse( $data );
 
$#{$rss->{'items'}} = 9; # Only the 10 most recent items
 
foreach my $item ( @{ $rss->{'items'} } ) {
  push @links, +{ description => $item->{'dc'}->{'subject'},
		  url => $item->{'link'},
		  title => $item->{'title'}
  }
};
 
$tmpl->param( links => @links );
open (FILEWRITE, ">$file");
print FILEWRITE $tmpl->output();
close FILEWRITE;
 
exit();

With the included modules you can do a lot of other interesting stuff. The XML::RSS module also includes functionality to create feeds and you could quite easily create aggregated feeds and other cool stuff with Perl and RSS-feeds.

IP addresses in Perl

With Perl you can do many interesting transformations of IP-numbers. Below is two small examples allowing conversions from “IP quad” (xxx.xxx.xxx.xxx) format to a single decimal and back.

1
2
3
4
5
6
7
sub ip2dec ($) {
    return unpack N => pack CCCC => split /\./ => shift;
}
 
sub dec2ip ($) {
    return join '.' => map { ($_[0] >> 8*(3-$_)) % 256 } 0 .. 3;
}

In CPAN you can find many modules aimed at using and manipulating IP-addressees. Some include Net::IP and IP::Country.