René Nyffenegger's collection of things on the web
René Nyffenegger on Oracle - Most wanted - Feedback -
 

Net::NNTP [Perl]

Retrieving an article

#!/usr/bin/perl

use Net::NNTP;

use strict;
use warnings;

my $srv = 'news.cis.dfn.de';
my $grp = 'comp.lang.perl.moderated';
my $usr;
my $pw;

my $authinfo_file = '/var/spool/news/slrnpull/authinfo';

# if there is an authinfo file, use it
if (-r $authinfo_file) {
  open AUTHINFO, $authinfo_file;
  $usr = <AUTHINFO>;
  $pw  = <AUTHINFO>;
} 
# otherwise, that is, if the authinfo file does not exist, read username and
# password from STDIN
else {
  print "Username: "; $usr=<STDIN>;
  print "Password: "; $pw =<STDIN>;
}

chomp ($usr, $pw);

my $nntp=Net::NNTP->new($srv);

$nntp->authinfo($usr,$pw) or die "Could not authenticate $usr";

# Make $grp current group
my ($nof_arts,   # How many articles on $srv for $grp
    $first_art,  # first article
    $last_art)   # last article
    =     
    $nntp->group($grp);

print @{$nntp->article($first_art)};

Who wrote what

#!/usr/bin/perl

use Net::NNTP;

use strict;
use warnings;

my $srv = 'news.cis.dfn.de';
my $grp = 'comp.databases.oracle.server';
my $usr;
my $pw;

my $authinfo_file = '/var/spool/news/slrnpull/authinfo';

# if there is an authinfo file, use it
if (-r $authinfo_file) {
  open AUTHINFO, $authinfo_file;
  $usr = <AUTHINFO>;
  $pw  = <AUTHINFO>;
  close AUTHINFO;
} 
# otherwise, that is, if the authinfo file does not exist, read username and
# password from STDIN
else {
  print "Username: "; $usr=<STDIN>;
  print "Password: "; $pw =<STDIN>;
}

chomp ($usr, $pw);

my $nntp=Net::NNTP->new($srv);

$nntp->authinfo($usr,$pw) or die "Could not authenticate $usr";

# Make $grp current group
my ($nof_arts,   # How many articles on $srv for $grp
    $first_art,  # first article
    $last_art)   # last article
    =     
    $nntp->group($grp);



my $art = $last_art-20;
while ($art <= $last_art) {
  my $in_hdr = 1;
  my $poster = "";
  my $subject= "";

  for my $line (@{$nntp->article($art)}) {


    if ($in_hdr) {
      if ($line =~ /^$/) {
        $in_hdr=0;
        $poster =~ s/^"? *//;
        $poster =~ s/"? *$//;
      }
      $poster = $1 if $line =~ /from: ([^<]*)</i;
      $poster = $1 if $line =~ /from: [^(]*\(([^)]*)\)/i;

      $subject= $1 if $line =~ /subject: (.*)/i;
    }
    else {
    ;
    }
  }

  printf "  %-25s%-60s\n",$poster, $subject;
  $art ++;
}


Which poster uses which words

#!/usr/bin/perl

use Net::NNTP;

use strict;
use warnings;

my $srv = 'news.cis.dfn.de';
my $grp = 'comp.databases.oracle.server';
my $usr;
my $pw;

my $authinfo_file = '/var/spool/news/slrnpull/authinfo';

# if there is an authinfo file, use it
if (-r $authinfo_file) {
  open AUTHINFO, $authinfo_file;
  $usr = <AUTHINFO>;
  $pw  = <AUTHINFO>;
  close AUTHINFO;
} 
# otherwise, that is, if the authinfo file does not exist, read username and
# password from STDIN
else {
  print "Username: "; $usr=<STDIN>;
  print "Password: "; $pw =<STDIN>;
}

chomp ($usr, $pw);

my $nntp=Net::NNTP->new($srv);

$nntp->authinfo($usr,$pw) or die "Could not authenticate $usr";

# Make $grp current group
my ($nof_arts,   # How many articles on $srv for $grp
    $first_art,  # first article
    $last_art)   # last article
    =     
    $nntp->group($grp);

my %posters;

#my $art = $last_art-200;
for (my $art = $last_art-200; $art<=$last_art;$art++) {
  my $in_hdr = 1;
  my $in_sig = 0;
  my $poster = "";

  my $art_ref=$nntp->article($art);

  next unless $art_ref;
  print "$art\n";
  for my $line (@$art_ref) {


    if ($in_hdr) {
      if ($line =~ /^$/) {
        $in_hdr = 0;
        $poster =~ s/^"? *//;
        $poster =~ s/"? *$//;
        next;
      }
      $poster = $1 if $line =~ /from: ([^<]*)</i;
      $poster = $1 if $line =~ /from: [^(]*\(([^)]*)\)/i;
    }
    else {
      chomp $line;
      $in_sig = 1 if $line=~ /^-- $/;
      next if $in_sig;
      next if $line =~ /^>/;
      foreach my $word (split / +/, $line) {
        $posters{$poster}{lc $word} ++;
        #print $posters{$poster}{lc $word};
      }
    }
  }
  
  #$art ++;
}

foreach my $poster (keys %posters) {
  print "\n\n\n$poster\n\n";

  foreach my $word (
    sort {
      $posters{$poster}{$a} <=> $posters{$poster}{$b}
    } 
    grep { $posters{$poster}{$_} > 3 } keys %{$posters{$poster}}
  ) {
    printf "%-20s %6d\n", $word, $posters{$poster}{$word};
  }

}