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. 

#!/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 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. 

#!/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();

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.

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.

Mark all messages as read in an imap folder

The follow script marks all files in a folder as read. You need to pass hostname, username and password as commandline parameters to the script and the script is hardwired to mark all files in a folder call “INBOX.spam” (Cyrus IMAP folder naming convention). 

#!/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();

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. 

#!/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.