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