#!/usr/local/bin/perl -w
use strict;
use Tk;
use Data::Dumper;
use Tk::ErrorDialog;
require Tk::Text;
require Mail::Internet;
require Net::NNTP;
package News::Group;
use Carp;
my %groups = ();
my @subscribed = ();
sub new
{
my $class = shift;
my $obj;
if (@_ == 1)
{
local $_ = shift;
my ($group,$state,$read) = /^([\w+.-]+)([:!])\s*(.*)$/;
my @read = ();
my %hash = (name => $group, subscribed => ($state eq ':'), Read => \@read);
if (defined $read)
{
foreach (split(/,/,$read))
{
if (/^\d+$/)
{
push(@read,[$_,$_]);
}
else
{
my ($start,$end) = split(/-/,$_);
push(@read,[$start,$end]);
}
}
$obj = bless \%hash,$class;
}
}
else
{
my %args = @_;
$obj = bless \%args,$class;
}
$groups{$obj->name} = $obj;
if ($obj->subscribed)
{
push(@subscribed,$obj);
}
}
sub subscribed
{
my $self = shift;
if (ref($self))
{
$self->{subscribed} = shift if (@_);
return $self->{subscribed};
}
else
{
return @subscribed;
}
}
sub read
{
my $self = shift;
if (@_)
{
my $art = shift;
croak "No article" unless (defined $art);
if (@_)
{
my $state = shift;
croak "No state" unless (defined $state);
my $i;
for ($i=0; $i < @{$self->{Read}}; $i++)
{
my ($low,$high) = @{$self->{Read}[$i]};
croak "$low > $high" unless ($low <= $high);
if ($art >= $low && $art <= $high)
{
return if ($state); # already in the list
if ($art == $low)
{
# At bottom of range
if ($art == $high)
{
# whole of range - remove entry
splice(@{$self->{Read}},$i,1);
return;
}
# move range up
$self->{Read}[$i][0] = $art+1;
return;
}
elsif ($art == $high)
{
# move range down
$self->{Read}[$i][1] = $art-1;
return;
}
# otherwise split the range into two
splice(@{$self->{Read}},$i,1,[$low,$art-1],[$art+1,$high]);
return;
}
if ($state)
{
if ($art == ($high+1))
{
# Just off the top end
if (($i+1) < @{$self->{Read}} && $art == ($self->{Read}[$i+1][0]-1))
{
# filled in hole between two ranges
$art = $self->{Read}[$i+1][1]; # new top is end of higher range
splice(@{$self->{Read}},$i+1); # loose upper range
}
$self->{Read}[$i][1] = $art; # set new upper end
return;
}
if ($art == ($low-1))
{
# special case hole should be handled above
$self->{Read}[$i][0] = $art; # set new lower end
return;
}
if ($art < $low)
{
# read something in a hole - add new degenerate range
splice(@{$self->{Read}},$i,1,[$art,$art],$self->{Read}[$i]);
return;
}
}
}
if ($state)
{
# read something off the end
push(@{$self->{Read}},[$art,$art])
}
}
else
{
my $range;
foreach $range (@{$self->{Read}})
{
return 1 if ($art >= $range->[0] && $art <= $range->[1]);
}
return 0;
}
}
else
{
my $range;
my $str = "";
my @range = @{$self->{Read}};
while (@range)
{
my $range = shift(@range);
if ($range->[0] == $range->[1])
{
$str .= $range->[0];
}
else
{
$str .= $range->[0] . '-' . $range->[1];
}
$str .= ',' if (@range);
}
return $str;
}
}
sub ReadRC
{
my $class = shift;
my $path = "$ENV{'HOME'}/.Newsrc";
if (open(RC,"<$path"))
{
local $/ = "\n";
while (<RC>)
{
$class->new($_);
}
close(RC);
}
else
{
warn "Cannot open $path:$!";
}
}
sub WriteRC
{
my ($self,$fh) = @_;
print $fh $self->name,(($self->subscribed) ? ':' : '!'),' ',$self->read,"\n";
}
sub SaveRC
{
my $class = shift;
my $path = "$ENV{'HOME'}/.Newsrc";
unlink("$path.bak");
link($path,"$path.bak");
if (open(RC,">$path.new"))
{
my $group;
foreach $group ($class->subscribed)
{
$group->WriteRC(\*RC);
}
foreach $group (values %groups)
{
$group->WriteRC(\*RC) unless ($group->subscribed);
}
close(RC);
rename("$path.new",$path) || warn "Cannot rename $path.new to $path:$!";
system('ned',$path);
}
else
{
warn "Cannot open $path.new:$!";
}
}
sub name { shift->{name} }
sub find
{
my ($class,$name) = @_;
return $groups{$name};
}
package main;
my $mw = MainWindow->new;
my $news = new Net::NNTP;
my $group = 'comp.lang.perl.tk';
sub SetGroup
{
my ($lb,$group) = @_;
$lb->{Group} = News::Group->find($group);
my ($count,$start,$end,$name) = $news->group($group);
$lb->delete(0,'end');
$lb->Busy;
while ($start <= $end)
{
unless ($lb->{Group}->read($start))
{
my $head = $news->head($start);
if ($head)
{
my $mail = Mail::Internet->new($head);
my @info = (sprintf("%6d",$start));
push(@info,scalar $mail->get('Subject'));
push(@info,scalar $mail->get('Date'));
push(@info,scalar $mail->get('From'));
$lb->insert('end',join(' ',@info));
}
}
$start++;
}
$lb->Unbusy;
$lb->focus;
}
my $n = 0;
sub Reply
{
my ($text) = @_;
my @lines = split(/\n/,$text->get('1.0','end'));
foreach (@lines) { $_ .= "\n"; s/^Message-ID:/Message-Id:/ };
my $mail = Mail::Internet->new(\@lines);
$mail->remove_sig;
$mail->tidy_body;
my $id = $mail->get('Message-Id');
my $groups = $mail->get('Newsgroups');
my $refs = $mail->get('References');
my $reply = $mail->reply(": ");
$reply->add(Newsgroups => $groups);
$reply->add(References => $refs);
$reply->add(References => $id);
$reply->combine('References');
$reply->delete('Cc');
$n++;
my $path = "/tmp/reply.$$.$n";
open(TMP,">$path") || die "Cannot open $path:$!";
$reply->print(\*TMP);
close(TMP);
system($ENV{'EDITOR'}.' '.$path.' &');
}
sub Catchup
{
my ($lb,$sel,$state) = @_;
my $group = $lb->{Group};
die "No group" unless (defined $group);
my ($art) = ($sel =~ /^\s*(\d+)/);
$lb->{Group}->read($art,$state);
}
sub GetArticle
{
my ($lb,$text,$sel) = @_;
my $group = $lb->{Group};
die "No group" unless (defined $group);
my ($art) = ($sel =~ /^\s*(\d+)/);
die "No arg in '$sel'" unless (defined $art);
my $data = $news->article($art);
$text->delete('1.0','end');
$text->Busy;
my $header = 1;
foreach (@$data)
{
if ($header && /^([^:]+):/)
{
$text->insert('end',$_,$1);
}
else
{
$text->insert('end',$_);
}
$header = 0 if ($header && /^\s*$/);
}
$text->Unbusy;
$text->focusNext;
die "No arg in '$sel'" unless (defined $art);
$lb->{Group}->read($art,1);
}
my $menubar = $mw->Frame->pack(-fill => 'x');
my $mb = $menubar->Menubutton(-text => 'File', -underline => 0)->pack(-side => 'left');
$mb->command(-label => 'Save', -underline => 0,
-command => sub { $mb->Busy; News::Group->SaveRC; $mb->Unbusy } );
$mb->command(-label => 'Quit', -underline => 0, -command => [ destroy => $mw ]);
my $text = $mw->Scrolled('Text', -scrollbars => 'osow',-wrap => 'none');
$mb->command(-label => 'Reply', -underline => 0, -command => [ \&Reply, $text ]);
my $list = $mw->Scrolled('Listbox',-scrollbars => 'osow');
$list->pack(-fill => 'both', -expand => 'y');
$list->bind('<1>','focus');
News::Group->ReadRC;
my $sel = $menubar->Optionmenu(-options => [ map($_->name,News::Group->subscribed)]);
$sel->configure(-command => [\&SetGroup,$list->Subwidget('listbox')]);
$sel->pack(-side => 'right');
$text->pack(-fill => 'both', -expand => 'y');
eval { $text->tag('configure','Subject',-foreground => 'blue') };
$text->tag('configure','From',-underline => 1);
$list->bind('<Double-ButtonRelease-1>',[\&GetArticle,$text,Ev(['getSelected'])]);
$list->bind('<Return>',[\&GetArticle,$text,Ev(['get','active'])]);
$list->bind('<c>',[\&Catchup,Ev(['get','active']),1]);
$list->bind('<u>',[\&Catchup,Ev(['get','active']),0]);
MainLoop;