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();