Nntp

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