1#!/usr/local/bin/perl -w
2
3use strict;
4use Tk;
5use Data::Dumper;
6use Tk::ErrorDialog;
7require Tk::Text;
8require Mail::Internet;
9require Net::NNTP;
10
11package News::Group;
12use Carp;
13
14my %groups = ();
15my @subscribed = ();
16
17sub new
18{
19 my $class = shift;
20 my $obj;
21 if (@_ == 1)
22  {
23   local $_ = shift;
24   my ($group,$state,$read) = /^([\w+.-]+)([:!])\s*(.*)$/;
25   my @read = ();
26   my %hash = (name => $group, subscribed => ($state eq ':'), Read => \@read);
27   if (defined $read)
28    {
29     foreach (split(/,/,$read))
30      {
31       if (/^\d+$/)
32        {
33         push(@read,[$_,$_]);
34        }
35       else
36        {
37         my ($start,$end) = split(/-/,$_);
38         push(@read,[$start,$end]);
39        }
40      }
41     $obj = bless \%hash,$class;
42    }
43  }
44 else
45  {
46   my %args = @_;
47   $obj  = bless \%args,$class;
48  }
49 $groups{$obj->name}     = $obj;
50 if ($obj->subscribed)
51  {
52   push(@subscribed,$obj);
53  }
54}
55
56sub subscribed
57{
58 my $self = shift;
59 if (ref($self))
60  {
61   $self->{subscribed} = shift if (@_);
62   return $self->{subscribed};
63  }
64 else
65  {
66   return @subscribed;
67  }
68}
69
70sub read
71{
72 my $self = shift;
73 if (@_)
74  {
75   my $art = shift;
76   croak "No article" unless (defined $art);
77   if (@_)
78    {
79     my $state = shift;
80     croak "No state" unless (defined $state);
81     my $i;
82     for ($i=0; $i < @{$self->{Read}}; $i++)
83      {
84       my ($low,$high) = @{$self->{Read}[$i]};
85       croak "$low > $high" unless ($low <= $high);
86       if ($art >= $low && $art <= $high)
87        {
88         return if ($state);  # already in the list
89         if ($art == $low)
90          {
91           # At bottom of range
92           if ($art == $high)
93            {
94             # whole of range - remove entry
95             splice(@{$self->{Read}},$i,1);
96             return;
97            }
98           # move range up
99           $self->{Read}[$i][0] = $art+1;
100           return;
101          }
102         elsif ($art == $high)
103          {
104           # move range down
105           $self->{Read}[$i][1] = $art-1;
106           return;
107          }
108         # otherwise split the range into two
109         splice(@{$self->{Read}},$i,1,[$low,$art-1],[$art+1,$high]);
110         return;
111        }
112       if ($state)
113        {
114         if ($art == ($high+1))
115          {
116           # Just off the top end
117           if (($i+1) < @{$self->{Read}} && $art == ($self->{Read}[$i+1][0]-1))
118            {
119             # filled in hole between two ranges
120             $art = $self->{Read}[$i+1][1];  # new top is end of higher range
121             splice(@{$self->{Read}},$i+1);  # loose upper range
122            }
123           $self->{Read}[$i][1] = $art;      # set new upper end
124           return;
125          }
126         if ($art == ($low-1))
127          {
128           # special case hole should be handled above
129           $self->{Read}[$i][0] = $art;      # set new lower end
130           return;
131          }
132         if ($art < $low)
133          {
134           # read something in a hole - add new degenerate range
135           splice(@{$self->{Read}},$i,1,[$art,$art],$self->{Read}[$i]);
136           return;
137          }
138        }
139      }
140     if ($state)
141      {
142       # read something off the end
143       push(@{$self->{Read}},[$art,$art])
144      }
145    }
146   else
147    {
148     my $range;
149     foreach $range (@{$self->{Read}})
150      {
151       return 1 if ($art >= $range->[0] && $art <= $range->[1]);
152      }
153     return 0;
154    }
155  }
156 else
157  {
158   my $range;
159   my $str = "";
160   my @range = @{$self->{Read}};
161   while (@range)
162    {
163     my $range = shift(@range);
164     if ($range->[0] == $range->[1])
165      {
166       $str .= $range->[0];
167      }
168     else
169      {
170       $str .= $range->[0] . '-' . $range->[1];
171      }
172     $str .= ',' if (@range);
173    }
174   return $str;
175  }
176}
177
178sub ReadRC
179{
180 my $class = shift;
181 my $path = "$ENV{'HOME'}/.Newsrc";
182 if (open(RC,"<$path"))
183  {
184   local $/ = "\n";
185   while (<RC>)
186    {
187     $class->new($_);
188    }
189   close(RC);
190  }
191 else
192  {
193   warn "Cannot open $path:$!";
194  }
195}
196
197sub WriteRC
198{
199 my ($self,$fh) = @_;
200 print $fh $self->name,(($self->subscribed) ? ':' : '!'),' ',$self->read,"\n";
201}
202
203sub SaveRC
204{
205 my $class = shift;
206 my $path = "$ENV{'HOME'}/.Newsrc";
207 unlink("$path.bak");
208 link($path,"$path.bak");
209 if (open(RC,">$path.new"))
210  {
211   my $group;
212   foreach $group ($class->subscribed)
213    {
214     $group->WriteRC(\*RC);
215    }
216   foreach $group (values %groups)
217    {
218     $group->WriteRC(\*RC) unless ($group->subscribed);
219    }
220   close(RC);
221   rename("$path.new",$path) || warn "Cannot rename $path.new to $path:$!";
222   system('ned',$path);
223  }
224 else
225  {
226   warn "Cannot open $path.new:$!";
227  }
228}
229
230sub name { shift->{name} }
231
232sub find
233{
234 my ($class,$name) = @_;
235 return $groups{$name};
236}
237
238package main;
239
240use Getopt::Long;
241my %opt;
242GetOptions(\%opt, "server=s")
243    or die "usage: $0 [-server host]";
244
245my $mw    = MainWindow->new;
246my $news  = Net::NNTP->new($opt{server})
247    or die "Can't connect to news server, please specify -server";
248my $group = 'comp.lang.perl.tk';
249
250sub SetGroup
251{
252 my ($lb,$group) = @_;
253 $lb->{Group} = News::Group->find($group);
254 my ($count,$start,$end,$name) = $news->group($group);
255 $lb->delete(0,'end');
256 $lb->Busy;
257 while ($start <= $end)
258  {
259   unless ($lb->{Group}->read($start))
260    {
261     my $head = $news->head($start);
262     if ($head)
263      {
264       my $mail = Mail::Internet->new($head);
265       my @info = (sprintf("%6d",$start));
266       push(@info,scalar $mail->get('Subject'));
267       push(@info,scalar $mail->get('Date'));
268       push(@info,scalar $mail->get('From'));
269       $lb->insert('end',join(' ',@info));
270      }
271    }
272   $start++;
273  }
274 $lb->Unbusy;
275 $lb->focus;
276}
277
278my $n = 0;
279
280sub Reply
281{
282 my ($text) = @_;
283 my @lines  = split(/\n/,$text->get('1.0','end'));
284 foreach (@lines) { $_ .= "\n"; s/^Message-ID:/Message-Id:/ };
285 my $mail = Mail::Internet->new(\@lines);
286 $mail->remove_sig;
287 $mail->tidy_body;
288 my $id = $mail->get('Message-Id');
289 my $groups = $mail->get('Newsgroups');
290 my $refs   = $mail->get('References');
291 my $reply = $mail->reply(": ");
292 $reply->add(Newsgroups => $groups);
293 $reply->add(References => $refs);
294 $reply->add(References => $id);
295 $reply->combine('References');
296 $reply->delete('Cc');
297 $n++;
298 my $path = "/tmp/reply.$$.$n";
299 open(TMP,">$path") || die "Cannot open $path:$!";
300 $reply->print(\*TMP);
301 close(TMP);
302 system($ENV{'EDITOR'}.' '.$path.' &');
303}
304
305sub Catchup
306{
307 my ($lb,$sel,$state) = @_;
308 my $group = $lb->{Group};
309 die "No group" unless (defined $group);
310 my ($art) = ($sel =~ /^\s*(\d+)/);
311 $lb->{Group}->read($art,$state);
312}
313
314sub GetArticle
315{
316 my ($lb,$text,$sel) = @_;
317 my $group = $lb->{Group};
318 die "No group" unless (defined $group);
319 my ($art) = ($sel =~ /^\s*(\d+)/);
320 die "No arg in '$sel'" unless (defined $art);
321 my $data = $news->article($art);
322 $text->delete('1.0','end');
323 $text->Busy;
324 my $header = 1;
325 foreach (@$data)
326  {
327   if ($header && /^([^:]+):/)
328    {
329     $text->insert('end',$_,$1);
330    }
331   else
332    {
333     $text->insert('end',$_);
334    }
335   $header = 0 if ($header && /^\s*$/);
336  }
337 $text->Unbusy;
338 $text->focusNext;
339 die "No arg in '$sel'" unless (defined $art);
340 $lb->{Group}->read($art,1);
341}
342
343my $menubar = $mw->Frame->pack(-fill => 'x');
344
345my $mb = $menubar->Menubutton(-text => 'File', -underline => 0)->pack(-side => 'left');
346$mb->command(-label => 'Save', -underline => 0,
347             -command => sub { $mb->Busy; News::Group->SaveRC; $mb->Unbusy } );
348$mb->command(-label => 'Quit', -underline => 0, -command => [ destroy => $mw ]);
349my $text = $mw->Scrolled('Text', -scrollbars => 'osow',-wrap => 'none');
350$mb->command(-label => 'Reply', -underline => 0, -command => [ \&Reply, $text ]);
351
352my $list = $mw->Scrolled('Listbox',-scrollbars => 'osow');
353$list->pack(-fill => 'both', -expand => 'y');
354
355$list->bind('<1>','focus');
356
357News::Group->ReadRC;
358
359my $sel = $menubar->Optionmenu(-options => [ map($_->name,News::Group->subscribed)]);
360$sel->configure(-command => [\&SetGroup,$list->Subwidget('listbox')]);
361$sel->pack(-side => 'right');
362
363$text->pack(-fill => 'both', -expand => 'y');
364eval { $text->tag('configure','Subject',-foreground => 'blue') };
365$text->tag('configure','From',-underline => 1);
366
367$list->bind('<Double-ButtonRelease-1>',[\&GetArticle,$text,Ev(['getSelected'])]);
368$list->bind('<Return>',[\&GetArticle,$text,Ev(['get','active'])]);
369$list->bind('<c>',[\&Catchup,Ev(['get','active']),1]);
370$list->bind('<u>',[\&Catchup,Ev(['get','active']),0]);
371
372MainLoop;
373