package News; use Exporter; @ISA=(Exporter); @EXPORT=qw(&track); use Net::NNTP; use Dumpvalue; use strict; my $dumper = new Dumpvalue; my $msg_id =0; my $nntp = my $email = my $date = my $pdate = my $kdate = my $subject = my $from = 0; my $h_type = my $message = my $ip_address = my $line = my $h_value = my $group = 0; my $debug=0; my @h_value = my @h_value2 = (); my @messages = my @header = my @ret = my @msg_id = my @group =(); my %attr = (); sub track { %attr = %{$_[0]}; #dereference the argument to the attributes @group= split(",", $attr{Group}); @ret = @msg_id = (); # FILL IN YOUR NEWSSERVER FOR READING, HERE $nntp = Net::NNTP->new("your_news_server"); print $nntp->message(); $date = $nntp->date()-3600; if ($attr{Last} == 0 ) { @messages = @{$nntp->newnews(($date), $group[0])}; print "default -1 hour old messages\n"; } else { @messages = @{$nntp->newnews($attr{Last}, $group[0])}; } $date=$nntp->date(); #print $#messages, "\n"; for $message (@messages) { @header = @{$nntp->head ($message)}; #print join "\n", @header,"<-\n"; for (@header) { #print $_; ($h_type, @h_value) = split (":"); $h_value = join(":",@h_value); #print $h_type,":\n"; if ($h_type =~ /Subject/) { chomp $h_value; $subject = $h_value; } if ($h_type =~ /Message-ID/) { chomp $h_value; $msg_id = $h_value; } if ($h_type =~ /From/) { #print e_mail($h_value),"\\", $h_value,"\n"; chomp $h_value; $from = $h_value; $email =e_mail($h_value); } if ($h_type =~ /NNTP-Posting-Host/) { if ( !$ip_address ){ $ip_address = ip_address($h_value);} } if ($h_type =~ /X-Trace/) { #{print ip_address($h_value),"\n"; if ( !$ip_address ){ $ip_address = ip_address($h_value);} } if ($h_type =~ /^Date/ ) { chomp $h_value; $kdate = $h_value; } if ($h_type =~ /NNTP-Posting-Date/) { chomp $h_value; $pdate = $h_value; } } if ($from =~ $attr{From}) { push @ret, ($subject); push @msg_id, ($msg_id); } } $nntp->quit; return \@ret,$date,\@msg_id; } sub ip_address { my $string =$_[0]; $string =~ s/([0-9]+)\.([0-9]+)\.([0-9]+)\.([0-9]+)/*/; return join(".",$1,$2,$3,$4); } sub e_mail { my $string =$_[0]; $string =~ s/([a-zA-Z0-9.\-]+@[a-zA-Z0-9.\-]+)//; return $1; } 1;