File Coverage

blib/lib/News/Web.pm
Criterion Covered Total %
statement 36 505 7.1
branch 0 202 0.0
condition 0 163 0.0
subroutine 12 33 36.3
pod 14 15 93.3
total 62 918 6.7


"
line stmt bran cond sub pod time code
1             $VERSION = "0.51";
2             package News::Web;
3             our $VERSION = "0.51";
4              
5             # -*- Perl -*- # Sun Oct 12 16:05:05 CDT 2003
6             #############################################################################
7             # Written by Tim Skirvin . Copyright 2003, Tim
8             # Skirvin. Redistribution terms are below.
9             #############################################################################
10              
11             =head1 NAME
12              
13             News::Web - a News<->Web gateway, for a web-based newsreader
14              
15             =head1 SYNOPSIS
16              
17             use News::Web;
18             [...]
19              
20             See 'news.cgi', included with this distribution, to see how this actually
21             works.
22              
23             =head1 DESCRIPTION
24              
25             News::Web is the basis for web-based newsreaders. It's essentially a
26             collection of functions called by CGI scripts appropriately.
27              
28             =head1 USAGE
29              
30             =cut
31              
32             ###############################################################################
33             ### main() ####################################################################
34             ###############################################################################
35              
36 1     1   979 use strict;
  1         2  
  1         37  
37 1     1   1254 use Net::NNTP;
  1         69125  
  1         208  
38 1     1   1312 use News::Article;
  1         12759  
  1         51  
39 1     1   1250 use News::Article::Response; # Newslib
  1         1217  
  1         26  
40 1     1   748 use News::Article::Ref; # Newslib
  1         6330  
  1         38  
41 1     1   949 use IO::File;
  1         2533  
  1         145  
42 1     1   9 use Carp;
  1         3  
  1         51  
43 1     1   2102 use CGI;
  1         19669  
  1         7  
44 1     1   1128 use Date::Parse;
  1         5005  
  1         132  
45 1     1   862 use News::Overview;
  1         4678  
  1         35  
46              
47 1     1   8 use vars qw( $DEBUG $TIMEOUT @ISA $NAME );
  1         1  
  1         100  
48             $DEBUG = 0;
49             $TIMEOUT = 120;
50             $NAME = "News::Web v$VERSION";
51              
52 1     1   5 use vars qw( @DEFAULTHEAD $MAXHEADLENGTH $COLUMNS $ROWS $SIGROWS );
  1         2  
  1         8120  
53              
54             @DEFAULTHEAD = qw( message-id newsgroups followup-to from subject date
55             references );
56             # References?
57             $MAXHEADLENGTH = 1024;
58             $COLUMNS = 80;
59             $ROWS = 30;
60             $SIGROWS = 4;
61              
62             =head2 Basic Functions
63              
64             These functions create and deal with the object itself.
65              
66             =over 4
67              
68             =item new ( ITEM )
69              
70             C is a reference to an object similar to Net::NNTP - that is, this
71             was designed to work directly with Net::NNTP, but will also work with
72             other similar classes such as News::Archive. Returns a reference to the
73             new object.
74              
75             =cut
76              
77             sub new {
78 0     0 1   my ($proto, $item) = @_;
79 0   0       my $class = ref($proto) || $proto;
80 0           my $self = { 'connection' => $item };
81 0           bless $self, $class;
82 0           $self;
83             }
84              
85             =item connect ()
86              
87             =item nntp ()
88              
89             These functions return the actual NNTP connection (or whatever was passed
90             into new()), to be manipulated directly by other functions.
91              
92             =cut
93              
94 0     0 0   sub connection { shift->{connection} }
95 0     0 1   sub nntp { shift->{connection} }
96              
97             =back
98              
99             =head2 HTML functions
100              
101             These functions create the HTML tables used by the various CGI scripts.
102              
103             =over 4
104              
105             =item html_article ( ARGHASH )
106              
107             Returns an HTML-formatted version of a news article, either by passing in
108             a full article, a message ID of an article to retrieve, or a newsgroup and
109             message number to pass. Also includes several linkback()'d sets of actions
110             we can perform on the article.
111              
112             Arguments we take from C:
113              
114             article A full news article, read directly into the
115             News::Article object.
116             mid The Message-ID of an article to read.
117             group \ Together, the group and article number to read in
118             number / from the NNTP connection to get the article.
119             fullhead Should we use full headers, or a limited set (as
120             specified in @News::Web::DEFAULTHEAD)? Defaults to 0.
121             clean Just print the article, and not the linkbacks.
122             Defaults to 0.
123             plaintext Should we print this as plaintext or as HTML?
124             Defaults to 0 (HTML).
125             default A hashref of defaults; this isn't actually used here,
126             but is passed on where necessary to other functions.
127              
128             Current linkbacks (we'll work out a way to better format and select these
129             later).
130              
131             Follow Up Respond to this article (with html_makearticle()).
132             Full Headers Show all of the headers, not just the limited set.
133             Original Format The message in its original format (only if we're
134             not already doing so).
135             First in Thread The first article in the thread (only if there
136             is one).
137             Immediate Parent The article that this message responded to (if
138             there is one).
139              
140             Next Article \ Links to the next/previous article in each
141             Previous Article / group (not based on thread, sadly)
142              
143             I'm not entirely happy with the format of this yet, but it works for now.
144             I would also to add "next/previous in thread", rot13, lists of children,
145             and so forth. And the linkback list may at some point be more consistent
146             and available programmatically, which would let it be tied into other
147             functions, such as moderation 'bots.
148            
149             =cut
150              
151             sub html_article {
152 0     0 1   my ($self, %args) = @_;
153              
154             # Get the article, one way or the other
155 0           my ($article, @return, %linkback);
156 0 0 0       if ($args{'article'}) { $article = $args{'article'}; }
  0 0          
    0          
157             elsif (my $mid = $self->clean('Message-ID', $args{'mid'})) {
158 0 0         (carp "Bad Message-ID" && return '') unless $mid;
159 0           $article = $self->nntp->article($mid);
160 0 0         unless ($article) {
161 0 0         my $clean = $args{'plaintext'} ? $mid : $self->html_clean($mid);
162 0           return "No such article: $clean";
163             }
164 0           $mid =~ s/^$//g;
  0            
165 0           $linkback{'mid'} = $mid;
166             } elsif ($args{'group'} && $args{'number'}) {
167 0 0         $self->nntp->group($args{'group'}) || return "No such group '$args{group}'";
168 0   0       $article = $self->nntp->article($args{'number'})
169             || return "No such message '$args{number}' in '$args{group}'";
170 0           $linkback{'group'} = $args{'group'}; $linkback{'number'} = $args{'number'};
  0            
171 0           } else { return "No message specified" }
172              
173             # Read in the article into a News::Article object
174 0           my $art = News::Article->new($article);
175 0 0         return "No article" unless $art;
176              
177             # Actually print the article
178 0 0         if ($args{'plaintext'}) {
179 0           push @return, join('', join("\n", $art->headers, '', $art->body, ''));
180 0   0       } else { push @return, $self->_html_article($art, $args{'fullhead'} || 0) }
181            
182             # If we're just getting the article with 'clean' or 'plaintext', don't
183             # offer the linkbacks.
184 0 0 0       return @return if $args{'clean'} || $args{'plaintext'};
185              
186             # Additional linkbacks for the article
187 0           my @linkback;
188 0           my $mid = $art->header('message-id'); $mid =~ s/(^<|>$)//g;
  0            
189 0 0         push @linkback, $self->linkback( "Follow Up", { 'post' => 1, 'mid' => $mid })
190             if $self->nntp->postok; # Should look at something else
191 0           push @linkback, $self->linkback( "Full Headers",
192             { 'fullhead' => 1, %linkback } );
193 0 0 0       push @linkback, $self->linkback( "Normal Format", { %linkback } )
194             if ($args{'fullhead'} || $args{'plaintext'});
195              
196 0           my @ids = split(/\s+/, $art->header('references'));
197 0           my %linkarts = ( "First in Thread" => $ids[0],
198             "Immediate Parent" => $ids[scalar @ids - 1] );
199 0           foreach my $desc (sort keys %linkarts) {
200 0           my $id = $linkarts{$desc}; $id =~ s/^<|>$//g;
  0            
201 0 0         push @linkback, $self->linkback( $desc, { 'mid' => $id } ) if $id;
202             }
203              
204 0 0         push @return, join(" ", "

Article actions: [ ",

205             join(" | ", @linkback), " ]

") if scalar @linkback;
206              
207             # Determine which groups we will use the 'next' and 'previous' article
208             # options on. We use Xref for the list; this isn't really ideal, IMO,
209             # but it's a good start.
210 0           my %grouplist;
211 0 0 0       if (my $group = $args{'group'} and my $number = $args{'number'}) {
212 0           $grouplist{$group} = $number;
213             } else {
214 0           my ($server, @grouplist) = split(/\s+/, $art->header('xref'));
215 0           foreach (@grouplist) {
216 0           my ($group, $number) = split(':', $_);
217 0           $grouplist{$group} = $number;
218             }
219             }
220              
221 0           foreach my $group (sort keys %grouplist) {
222 0           my $number = $grouplist{$group};
223              
224             # We really want a 'next in thread' option, sadly. Or whatever sorting
225             # method we used. This will be *TRICKY* to accomplish.
226 0           my ($count, $first, $last, $name) = $self->nntp->group($group);
227 0           my @linkback2;
228            
229 0 0         push @linkback2, $number <= $first ? "Previous"
230             : $self->linkback( "Previous",
231             { 'group' => $group, 'number' => $number - 1 } );
232 0 0         push @linkback2, $number >= $last ? "Next"
233             : $self->linkback( "Next",
234             { 'group' => $group, 'number' => $number + 1 } );
235            
236 0 0         push @return, join("", "

Articles in $group: [ ",

237             join(" | ", @linkback2), " ]

") if scalar @linkback2;
238             }
239              
240 0           join("\n", @return);
241             }
242              
243              
244             =item html_makearticle ( ARGHASH )
245              
246             Creates an HTML form to write new articles, based on a previous article if
247             the proper information is passed in with C. This is put into a
248             table that has three major sections - the header section, the body, and
249             the signature.
250              
251             If a previous article is indicated (with 'mid'), then we base the new
252             message off of that article with News::Article::Response.
253              
254             Arguments we take from C:
255             mid The Message-ID of a message we're responding to;
256             group The newsgroup we're posting to
257             prefix A prefix to the new message-ID (see News::Article)
258             domain The domain of the new message-ID (see News::Article).
259             columns The number of columns to format the body and
260             signature. Defaults to $News::Web::COLUMNS or 80.
261             rows The number of rows for the textarea box of the body;
262             defaults to $News::Web::ROWS or 30.
263             sigrows The number of rows for the textarea box of the
264             signature box; defaults to $News::Web::SIGROWS or 30.
265             nosignature Don't offer use the signature box.
266             wraptype How should we wrap the quoted material? See
267             News::Article::Reference. Defaults to 'overflow'.
268             params A hashref of extra parameters to pass into html_post()
269             default A hashref of defaults; this isn't actually used here,
270             but is passed on where necessary to other functions.
271              
272             Current linkbacks:
273              
274             Post Meant to invoke html_post()
275             Preview Meant to invoke html_post() with the preview flag
276              
277             We're not really using CSS at all yet, which is a mistake.
278              
279             =cut
280              
281             sub html_makearticle {
282 0     0 1   my ($self, %args) = @_;
283 0           my $cgi = new CGI;
284              
285 0   0       my $default = $args{'default'} || {};
286 0   0       my $params = $args{'params'} || {};
287              
288             # Get defaults out of %args or from the module
289 0   0       my $cols = $args{'columns'} || $COLUMNS || 80;
290 0   0       my $rows = $args{'rows'} || $ROWS || 30;
291 0   0       my $sigrows = $args{'sigrows'} || $SIGROWS || 4;
292              
293             # Get the article that we're starting from
294 0           my $oldart;
295 0 0         if (my $mid = $args{'mid'}) {
296 0           my $clean = $self->clean('Message-ID', $mid);
297 0   0       my $message = $self->nntp->article($clean) || [];
298 0           $oldart = News::Article->new( $message );
299 0           } else { $oldart = new News::Article }
300 0 0 0       my $art = $args{'article'} ? $args{'article'}
      0        
      0        
      0        
      0        
301             : News::Article->response($oldart,
302             { 'From' => $args{'author'} || "",
303             'Newsgroups' => $args{'group'} || undef },
304              
305             'prefix' => $args{'prefix'} || "",
306             'domain' => $args{'domain'} || "",
307             'colwrap' => $cols,
308             'wraptype' => $args{'wraptype'} || 'overflow',
309             'nodate' => 1,
310             );
311            
312 0           my @return = "

Composing Article

";
313 0           push @return, $cgi->start_form('post');
314              
315 0           push @return, $cgi->start_table({ -cellpadding => 0,
316             -cellspacing => 0 });
317            
318             # User-modifiable headers
319 0           foreach ( qw( Newsgroups From Subject ) ) {
320 0 0         next unless $art->header($_);
321 0   0       push @return, $cgi->Tr({-align=>'left', -valign=>'CENTER'},
322             [ $cgi->td( [$_, $cgi->textfield(-name => "header_$_",
323             -default => $art->header($_) || "",
324             -size => $cols - length $_, -maxlength => $MAXHEADLENGTH) ]) ]);
325             }
326             # Headers that are already set
327 0           foreach ( qw( Message-ID References ) ) {
328 0 0         next unless $art->header($_);
329 0   0       push @return, $cgi->Tr({-align=>'left', -valign=>'CENTER'},
      0        
330             [ $cgi->td( [$_, join("\n",
331             $self->html_clean($art->header($_) || ""),
332             $cgi->hidden(-name => "header_$_",
333             -default => $art->header($_) || "" )) ]) ]);
334             }
335              
336             # Body of the message - this will be in its own textarea box.
337 0           my @body = $art->body;
338              
339             # Put headers beyond the ones we've already processed into the body of
340             # the message, so they can be looked at and all.
341 0           my %extrahead;
342             BODYHEAD:
343 0           foreach my $head ($art->header_names) {
344 0           foreach ( qw( Message-ID References Newsgroups From Subject ) ) {
345 0 0         next BODYHEAD if lc $_ eq lc $head;
346             }
347 0           $extrahead{News::Article::canonical($head)} = $art->header($head);
348             }
349 0 0         unshift @body, '' if scalar keys %extrahead;
350 0           foreach (keys %extrahead) { unshift @body, "$_: $extrahead{$_}" }
  0            
351 0           my $body = join("\n", @body);
352              
353             # Blank line between the headers and body
354 0           push @return, $cgi->Tr( [ $cgi->td( " " ) ] );
355 0           push @return, $cgi->Tr({-align=>'left', -valign=>'CENTER'},
356             [ $cgi->td( { -colspan => 2, -nowrap => 1 },
357             [ $cgi->textarea( -name => 'body', -default => $body,
358             -rows => $rows, -cols => $cols, -wrap => 'hard') ]
359             ) ]);
360              
361             # Signature field, if so desired (with '-- ')
362 0 0         unless ($args{'nosignature'}) {
363 0           push @return, $cgi->Tr({-align=>'left', -valign=>'CENTER'},
364             [ $cgi->td( { -align=>'left', -colspan=>2}, "-- ") ] );
365              
366 0   0       push @return, $cgi->Tr({-align=>'left', -valign=>'CENTER'},
367             [ $cgi->td( { -colspan=>2, -nowrap=>1 }, [
368             $cgi->textarea(-name => 'signature', -wrap => 'hard',
369             -default => $args{signature} || "",
370             -rows => $sigrows, -cols => $cols) ] ) ]);
371             }
372              
373             # Submit/preview the article
374 0           push @return, $cgi->Tr({},
375             [ $cgi->td({-colspan=>2, -align=>'right'},
376             [ join(" ", $cgi->submit(-name=>'preview', -value=>'Preview'),
377             $cgi->submit(-name=>'post', -value=>'Post') ) ]) ]);
378              
379 0           foreach (keys %{$params}) {
  0            
380 0 0         next if lc $_ eq 'preview';
381 0 0         next if lc $_ eq 'post';
382 0           push @return, $cgi->hidden($_, $$params{$_});
383             }
384              
385 0           push @return, $cgi->end_table;
386 0           push @return, $cgi->end_form;
387              
388 0           join("\n", @return);
389             }
390              
391             =item html_post ( ARGHASH )
392              
393             Actually posts the message. Gets the article from passed in arguments
394             through C, adds some headers, and does the work.
395              
396             Arguments we take from C:
397              
398             params CGI parameters that were passed in
399             header_* The headers of the message
400             body The body of the message, separated by newlines
401             signature The signature of the message
402              
403             trace The content to set 'X-Local-Trace' to, which is
404             currently set by the CGI (but should probably be
405             done locally).
406             default A hashref of defaults; this isn't actually used here,
407             but is passed on where necessary to other functions.
408              
409             Extra headers are pulled out of the first lines of the body of the
410             message. Adds 'X-Newsreader' and 'X-Local-Trace', drops 'Approved' and
411             'Date'. Runs html_makearticle() if necessary because the article didn't,
412             or wouldn't, post.
413              
414             =cut
415              
416             sub html_post {
417 0     0 1   my ($self, %args) = @_;
418 0 0         return "Can't post to this server" unless $self->nntp->postok;
419            
420 0           my $article = new News::Article;
421 0   0       my $params = $args{'params'} || {};
422              
423             # Get headers out of the $params hashref; all headers are preceded with
424             # header_.
425 0           foreach (sort %{$params}) {
  0            
426 0 0         next unless /^header_(.*)$/;
427 0           my $header = $1;
428 0           $article->set_headers($header, $$params{$_});
429             }
430              
431 0           my $body = $$params{'body'};
432 0           my $signature = $$params{'signature'};
433 0           $signature =~ s/\s*$//; # Trim out trailing whitespace
434              
435 0           $article->set_body($body);
436 0           $article->trim_blank_lines;
437 0 0         if ($signature) { $article->add_body("-- ", $signature); }
  0            
438              
439             # Get headers out of the body
440 0           my (@body, $headers);
441 0           foreach my $line ($article->body) {
442 0 0 0       if (!$headers && $line =~ /^([\w-]+):\s+(.*)$/) {
    0 0        
443 0           $article->set_headers($1, $2);
444 0           } elsif (!$headers && /^\s+/) { $headers++ }
445 0           else { push @body, $line }
446             }
447 0           $article->set_body(@body);
448              
449 0           $article->drop_headers('approved', 'date', 'x-newsreader');
450 0           $article->add_date;
451 0           $article->set_headers('x-newsreader', $NAME );
452 0           $article->set_headers('x-local-trace', $args{'trace'});
453              
454             # Abort if we don't have all of the necessary headers
455 0           my @problems;
456 0           foreach ( qw( Newsgroups Date Message-ID From Subject ) ) {
457 0 0         push @problems, "Missing the '$_' header" unless $article->header($_);
458             }
459              
460 0 0         if (scalar @problems) {
461 0           my @return;
462 0           push @return, "

Problems Posting

", "
    ";
463 0           foreach (@problems) { push @return, "
  • $_"; }
    •   0            
    464 0           push @return, "";
    465 0           push @return, $self->html_makearticle( 'article' => $article, %args);
    466 0           return @return;
    467             }
    468              
    469             # Here's the actual posting
    470 0           my $messageid = $article->header('message-id');
    471 0           my $nntp = $self->nntp;
    472 0           my @return;
    473 0           my $preview = $$params{'preview'};
    474 0 0         if ($preview) {
    475 0           push @return, "

    Preview

    ";
    476 0           push @return, $self->_html_article($article, 1);
    477 0           push @return, $self->html_makearticle( 'article' => $article, %args);
    478             } else {
    479 0           my $ret = eval { $article->post( $nntp ) };
      0            
    480 0 0         if ($@) {
    481 0           my $error = $@;
    482 0           chomp $error; # Remove trailing whitespace
    483 0           warn "Error in posting $messageid: $error\n";
    484 0           push @return, "

    Problems Posting

    ", "
      ";
    485 0           push @return, "
  • $error";
    • 486 0           push @return, "";
    487 0           push @return, $self->html_makearticle( 'article' => $article, %args);
    488             } else {
    489 0           my $id = $article->header('message-id');
    490 0           push @return, "Message $id posted successfully

    \n";
    491            
    492 0           push @return, $self->_html_article($article, 1);
    493             }
    494             }
    495              
    496 0           @return;
    497             }
    498              
    499             =item html_overview ( ARGHASH )
    500              
    501             Generate an HTML-formatted table of the overview entries of a given
    502             newsgroup (see News::Overview). This table consists of nexttable(),
    503             tableheaders(), lines for each entry, then nexttable() again.
    504              
    505             COUNT is the number of articles we should get; it should be the number of
    506             articles that we actually return, but this isn't done yet. The subject is
    507             linkback()'d to the actual message.
    508              
    509             Arguments we take in C:
    510              
    511             count The number of articles that we should return.
    512             Currently, this is actually the number that we ask
    513             for.
    514             last The last article we should get. With 'count', FIRST =
    515             COUNT - LAST + 1.
    516             first The first article we should get. With 'count' and no
    517             'last', LAST = first + count - 1
    518             sort The sorting method for the articles, as set in
    519             News::Overview.
    520             fields The fields from the overview DB to add columns for;
    521             defaults to News::Overview's defaults. These
    522             default A hashref of defaults; this isn't actually used here,
    523             but is passed on where necessary to other functions.
    524              
    525             =cut
    526              
    527             sub html_overview {
    528 0     0 1   my ($self, %args) = @_;
    529 0   0       my $group = $args{'group'} || "";
    530 0 0 0       my ($count, $first, $last, $name) = $self->nntp->group($group)
    531             or ( carp "Couldn't connect to $group: $!\n" && return '');
    532              
    533             # If we actually set count in args, then we should base things off of it
    534 0 0         if (defined $args{count}) {
    535 0 0 0       if ($args{first}) {
        0          
    536 0           $first = $args{first};
    537 0           $last = $first + $args{count} - 1;
    538             } elsif ($args{last} && $args{last} >= $first ) {
    539 0           $first = $args{last} - $args{count} + 1;
    540 0           $last = $args{last};
    541             } else { # We always take the last batch of articles; good idea?
    542 0           $first = $last - $args{count} + 1;
    543             }
    544 0           $count = $args{count};
    545             } else {
    546             # Figure out where to start and stop with this overview information
    547 0 0 0       $first = $args{first} if (defined $args{first} && $args{first} >= $first);
    548 0 0 0       $last = $args{last} if (defined $args{last} && $args{last} <= $last );
    549             }
    550              
    551 0 0         $first = 1 if ($first <= 1);
    552              
    553 0   0       my $default = $args{'default'} || \%args;
    554 0   0       my $sort = $args{'sort'} || 'thread';
    555              
    556             # Get the overview format information
    557 0   0       my $fmt = $self->nntp->overview_fmt || undef;
    558              
    559             # Start the overview object
    560 0 0         my $overview = News::Overview->new( ref $fmt ? $fmt : "" );
    561              
    562             # Request and parse the overview information
    563 0 0 0       my $xover= $self->nntp->xover("$first-$last")
    564             or ( carp "Couldn't get xover info: $!\n" && return '' );
    565 0           foreach my $msg (sort keys %{$xover}) {
      0            
    566 0           $overview->add_from_nntp($msg, $$xover{$msg});
    567             }
    568              
    569             # return '' unless scalar keys %{$xover};
    570 0 0         unless (scalar keys %{$xover}) {
      0            
    571 0 0         return $self->nntp->postok ?
    572             join("", "

    ", $self->linkback( "Post a New Message",

    573             { 'post' => 1, 'group' => $group }), "

    ")
    574             : "";
    575             }
    576              
    577             # If we didn't get a fields list, default to the default overview ones
    578 0   0       my $fields = $args{'fields'} || $overview->fields();
    579              
    580 0           my @return;
    581              
    582             # Not ideal, but it'll do briefly; we should have it only pass those
    583             # values that we absolutely need.
    584             my %passargs;
    585 0 0         $passargs{'group'} = $group if $group;
    586 0           $passargs{'first'} = $first;
    587 0           $passargs{'last'} = $last;
    588 0           $passargs{'count'} = $count;
    589 0           $passargs{'sort'} = $args{'sort'};
    590              
    591 0           push @return, $self->nexttable ( \%passargs, [ $self->nntp->group($group) ],
    592             $default );
    593              
    594 0           push @return, "", ""; "; "; " "; "; ", "
    595 0           push @return, $self->tableheaders( $fields, \%passargs, $default);
    596 0           push @return, "
    597              
    598 0           my $even = '0';
    599              
    600 0           foreach my $entry ( $overview->sort( $sort, $overview->entries ) ) {
    601 0           my $mid = $entry->values->{'Message-ID'};
    602 0           $mid =~ s/^$//g;
      0            
    603 0           my $number = $entry->values->{'Number'};
    604              
    605 0           push @return, "
    606 0           foreach (@{$fields}) {
      0            
    607 0           my $nowrap = "nowrap";
    608 0           my $value = $self->html_clean(
    609             $self->clean($_, $entry->values->{$_}, $entry));
    610 0 0         $value = $self->linkback($value,
    611             { 'group' => $group, 'number' => $number })
    612             # { 'mid' => $mid })
    613             if lc $_ eq 'subject';
    614 0 0         if (lc $_ eq 'newsgroups') {
    615 0           $nowrap = "";
    616 0           my @groups = split(',', $value);
    617 0           @groups = grep { $_ !~ /archive\..*/ } @groups; # Drop archive.* groups
      0            
    618 0           map { $_ = $self->linkback($_, { 'group' => $_ }) } @groups;
      0            
    619 0           $value = join(', ', @groups);
    620             }
    621            
    622 0 0         push @return, defined $value
    623             ? "$value
    624             : "  
    625             }
    626 0           push @return, "
    627 0 0         if ($even == 0) { $even++ } else { $even = 0 }
      0            
      0            
    628             }
    629              
    630 0           push @return, "
    ";
    631 0           my ($self, $params, $groupinfo, $defaults) = @_;
    632 0           push @return, $self->nexttable ( \%passargs, [ $self->nntp->group($group) ],
    633             $default );
    634              
    635 0 0         push @return, join("", "

    ",

    636             $self->linkback( "Post a New Message", { 'post' => 1, 'group' => $group }),
    637             "

    ") if $self->nntp->postok;
    638 0           join("\n", @return);
    639             }
    640              
    641             =item nexttable ( PARAMHASH, GROUPINFO, DEFAULTHASH )
    642              
    643             Creates the 'next table' bits for html_overview(). C is an
    644             arrayref that is the response of Net::NNTP->group(), and is used to
    645             determine what articles exist so we know what to link to.
    646              
    647             C and C are passed to linkback() (with different
    648             'sort' options).
    649              
    650             We don't have any CSS hooks right now, again a mistake.
    651              
    652             Returns as an array of HTML lines.
    653              
    654             =cut
    655              
    656             sub nexttable {
    657 0     0 1   my ($self, $params, $groupinfo, $defaults) = @_;
    658 0 0 0       return "" unless ($params && ref $params);
    659 0 0         my $count = $$params{count}; return "" unless $count;
      0            
    660 0           my $first = $$params{first}; my $last = $$params{last};
      0            
    661              
    662 0   0       $defaults ||= {};
    663              
    664 0 0         $last = @{$groupinfo}[2] if $last >= @{$groupinfo}[2];
      0            
      0            
    665              
    666 0   0       $first ||= 1;
    667 0           my @return = ""; "; \n"; \n"; ", "
    668 0           push @return, "
    669              
    670             # Initialize hashes
    671 0           my %prev; foreach (keys %{$params}) { $prev{$_} = $$params{$_} };
      0            
      0            
      0            
    672 0           my %next; foreach (keys %{$params}) { $next{$_} = $$params{$_} };
      0            
      0            
      0            
    673              
    674 0           $prev{last} = $first - 1; delete $prev{first};
      0            
    675 0           $next{first} = $first + $count; delete $next{last};
      0            
    676              
    677 0           my %sort1; foreach (keys %{$params}) { $sort1{$_} = $$params{$_} };
      0            
      0            
      0            
    678 0   0       $sort1{'sort'} ||= "thread";
    679 0           my %sort2; foreach (keys %{$params}) { $sort2{$_} = $$params{$_} };
      0            
      0            
      0            
    680 0   0       $sort2{'sort'} ||= "-thread";
    681              
    682 0 0         my $prev = $first < @{$groupinfo}[1]
      0            
    683             ? "Previous
    684             : $self->linkback("Previous", \%prev, $defaults) ;
    685 0           push @return, "$prev
    686 0 0         push @return, "", "Articles $first - $last",
    687             ( $$params{sort} eq 'thread' ? "" :
    688             "
    " . $self->linkback( "Sort by Thread", \%sort1, $defaults ) ),
    689             "";
    690 0 0         my $next = $last >= @{$groupinfo}[2]
      0            
    691             ? "Next"
    692             : $self->linkback("Next", \%next, $defaults) ;
    693 0           push @return, "$next
    694            
    695 0           push @return, "
    ";
    696 0           @return;
    697             }
    698              
    699             =item tableheaders ( FIELDARRAYREF, PARAMHASH, DEFAULTHASH )
    700              
    701             Creates the table headers for html_overview(). C is the
    702             list of fields that will be printed in the table body. Each of these is
    703             printed as two linkback()s, one to sort based on this field and the other
    704             to sort the same but backwards. These links are parsed by
    705             html_overview(). C and C are passed to linkback()
    706             (with different 'sort' options).
    707              
    708             Stylesheet hooks:
    709              
    710             groupinfo TH style to describe the headers
    711              
    712             Returns as an array of lines.
    713              
    714             =cut
    715              
    716             sub tableheaders {
    717 0     0 1   my ($self, $fields, $params, $default) = @_;
    718 0           my @return;
    719 0           foreach my $field (@{$fields}) {
      0            
    720 0           my %local; foreach (keys %{$params}) { $local{$_} = $$params{$_} }
      0            
      0            
      0            
    721 0           $local{'sort'} = ucfirst lc $field;
    722 0           my $field1 = $self->linkback($field, \%local, $default);
    723 0           $local{'sort'} = join('-', '', ucfirst lc $field);
    724 0           my $field2 = $self->linkback('-', \%local, $default);
    725 0           push @return, "$field1
    ($field2)
    726             };
    727 0           @return;
    728             }
    729              
    730             =item html_grouplist ( [PATTERN] )
    731              
    732             Lists all of the active newsgroups, based on C (defaults to '*'),
    733             with descriptions. Returns the text to be printed, joined by newlines.
    734              
    735             If C is not passed in, then we will instead get the default list
    736             of groups out of 'subscriptions'.
    737              
    738             Possible refinements: should we list the number of messages (estimated or
    739             real)? The posting status of the group (moderated, no-posting, etc)?
    740              
    741             Stylesheet hooks:
    742              
    743             grouplist_head TR and TD style, for the headers of the table.
    744             grouplist TR style, for the actual table content lines.
    745             grouplist_1 TD style, alternating between the two styles,
    746             grouplist_2 to allow the lines to look different (and
    747             and therefore be easier to follow).
    748              
    749             =cut
    750              
    751             sub html_grouplist {
    752 0     0 1   my ($self, $pattern, $newsrc, $print) = @_; # Not using the last two
    753 0           my ($groups, $descs);
    754 0 0         if ($pattern) {
    755 0 0 0       $groups = $self->nntp->active($pattern)
    756             or ( carp "Couldn't get newsgroups: $!\n" && return '');
    757             } else {
    758 0           $groups = {};
    759 0           foreach ( @{$self->nntp->subscriptions()} ) {
      0            
    760 0           my $value = [ $self->nntp->active($_) ];
    761 0 0         next unless $value;
    762 0           $$groups{$_} = [ $value ];
    763             }
    764 0           $pattern = "*";
    765             }
    766 0 0 0       $descs = $self->nntp->newsgroups('*')
    767             or ( carp "Couldn't get group descriptions: $!\n" && return '');
    768              
    769 0 0         return "" unless scalar keys %{$groups};
      0            
    770              
    771 0           my (@return);
    772 0           my $even = 0;
    773            
    774 0           push @return, ""; ", ", ", ""; "; "; " "; ";
    775 0           push @return, "
    776             "Group
    777             "Description
    778 0           foreach my $group (sort keys %{$groups}) {
      0            
    779 0           my ($last, $first, $flags) = @{$$groups{$group}};
      0            
    780 0           push @return, "
    781 0           my $link = $self->linkback($group, { 'group' => $group });
    782 0           push @return,
    783             " $link
    784 0 0         push @return, $$descs{$group}
    785             ? "$$descs{$group}
    786             : "  
    787 0           push @return, "
    788 0 0         if ($even == 0) { $even++ } else { $even = 0 }
      0            
      0            
    789             }
    790              
    791 0           push @return, "
    ";
    792 0           join("\n", @return, '');
    793             }
    794              
    795             =item html_hierarchies ( LEVELS, PATTERN )
    796              
    797             Gives a set of linkback()'d group listings, based on the newsgroups
    798             available on the server. C is the WILDMAT pattern to decide
    799             which groups to match; C defines how many levels down to go down
    800             when matching the pattern ('news' would be one level, 'news.admin' would
    801             be two, etc). Doesn't match actual newsgroups, just hierarchies.
    802              
    803             Returns the list of linkbacks in an array context, or a line of them
    804             combined with ' | ' as a scalar.
    805              
    806             =cut
    807              
    808             sub html_hierarchies {
    809 0     0 1   my ($self, $levels, $pattern) = @_;
    810 0   0       $levels ||= 1; $pattern ||= "*";
      0   0        
    811              
    812 0 0 0       my $groups = $self->nntp->active($pattern)
    813             or ( carp "Couldn't get newsgroups: $!\n" && return '');
    814              
    815 0           my %hiers;
    816 0           foreach (sort keys %{$groups}) {
      0            
    817 0           my @array = split('\.', $_);
    818 0           $hiers{$array[0]}++;
    819 0   0       for (my $i = 1; ( $i < scalar @array ) && ( $i < $levels ); $i++) {
    820 0 0         my $string = $i eq 0 ? $array[0] : join('.', @array[0..$i]);
    821 0           $hiers{$string}++;
    822             }
    823             }
    824 0           my @return;
    825 0           foreach (sort keys %hiers) {
    826 0           push @return, $self->linkback($_, { 'pattern' => "$_.*" });
    827             }
    828 0 0         wantarray ? @return : join(" | ", @return);
    829             }
    830              
    831             =item linkback( TEXT, HASHREF, DEFAULT )
    832              
    833             Returns an HTML link back to the same program, based on the hash
    834             references C and C. C is the string that appears
    835             in the link. The key/value pairs in C are the options passed in
    836             the URL; however, if the C hash matching value matches
    837             C, then we assume that we don't need that argument (and we should
    838             try to keep the URL short anyway).
    839              
    840             This probably needs more refinement, but it more or less works.
    841              
    842             =cut
    843              
    844             sub linkback {
    845 0     0 1   my ($self, $text, $hash, $default) = @_;
    846 0   0       $hash ||= {}; $default ||= {};
      0   0        
    847 0           my $url = $0; $url =~ s%.*/%%g; # Should be something better
      0            
    848 0           my @opts;
    849 0           foreach (sort keys %{$hash}) {
      0            
    850 0 0         push @opts, "$_=$$hash{$_}" unless $$default{$_} eq $$hash{$_};
    851             }
    852 0           my $opts = join('&', @opts);
    853 0           my $text = "$text";
    854 0           $text;
    855             }
    856              
    857             =item clean ( HEADER, INFO, ENTRY, ARGS )
    858              
    859             Cleans up the news information for the best distribution. Mostly useful
    860             for creating new articles and parsing article inforation properly; not so
    861             useful for actually printing articles, where the original formatting may
    862             have been generally useful. C
    choices that are currently
    863             supported:
    864              
    865             subject Formats the Subject: line to have quote characters
    866             at the start (based on the number of entries in
    867             References: within C) and trim the total
    868             length of the string.
    869             from Formats the From: line consistently; by default it
    870             gets the actual author and drops the email address.
    871             Also trims the total length of the string (see
    872             the arguments section).
    873             date Format the date consistently with Format::Date's
    874             str2time() command.
    875             message-id Make sure that the passed ID is properly formatted
    876             with '<' and '>' characters.
    877              
    878             Arguments we take:
    879            
    880             subjwidth Width to trim the Subject: line to; if less than 0,
    881             then we don't trim the header at all. Defaults to 55.
    882             fromwidth Width to trim the From: line to; if less than 0, then
    883             we don't trim the header at all. Defaults to 25.
    884             fromtype The formatting method for the From: line. Possible
    885             options: 'name', 'nameemail', 'email', 'emailname'.
    886             Defaults to 'name'.
    887              
    888             This should be replaced with something from News::Article::Ref, or moved
    889             into there.
    890              
    891             =cut
    892              
    893             sub clean {
    894 0     0 1   my ($self, $header, $info, $entry, %args) = @_;
    895 0           my @return;
    896 0 0         if (lc $header eq 'subject') {
        0          
        0          
        0          
    897 0 0 0       @return = $self->_subject($info, $entry ? $entry->depth : 0,
    898             $args{'subjwidth'} || 55 )
    899             }
    900             elsif (lc $header eq 'from') {
    901 0   0       @return = $self->_author($info, $args{'fromwidth'} || 25,
          0        
    902             $args{'fromtype'} || 'name' )
    903             }
    904 0           elsif (lc $header eq 'date') { @return = $self->_date($info, %args) }
    905 0           elsif (lc $header eq 'message-id') { @return = $self->_mid($info, %args) }
    906 0           else { @return = $info }
    907 0 0         wantarray ? @return : join("\n", @return);
    908             }
    909              
    910              
    911             =item html_clean ( LINE [, LINE [...]] )
    912              
    913             Cleans up C(s) for the web - ie, fixes special HTML characters, and
    914             sets up links for http:// and ftp:// links. Returns a string containing
    915             the modified lines, joined with newlines.
    916              
    917             There's probably a lot more that can be done here.
    918              
    919             =cut
    920              
    921             sub html_clean {
    922 0     0 1   my ($self, @return) = @_;
    923 0           map { s/\
      0            
    924 0           map { s/\>/\>/g } @return;
      0            
    925 0           map { s%((?:http|ftp):\/\/[^\s&]+)%$1%g } @return;
      0            
    926 0           join("\n", @return);
    927             }
    928              
    929             =item html_markup ( HEADER, TEXT [, ARGS] )
    930              
    931             Marks up C
    and C to be printed in HTML. C is put
    932             through html_clean() and an additional set of fixes:
    933            
    934             newsgroups linkback() to the given group
    935              
    936             C
    is bolded. The final layout - "HEADER: TEXT".
    937              
    938             =cut
    939              
    940             sub html_markup {
    941 0     0 1   my ($self, $header, $text, %args) = @_;
    942 0           $text = $self->html_clean($text);
    943 0 0         if (lc $header eq 'newsgroups') {
    944 0           $text = $self->_html_newsgroups($text, %args);
    945             }
    946 0           $header = News::Article::canonical($header);
    947 0           $text =~ s/(\r?\n)/
    $1   /g;
    948 0 0         $text ? "$header: $text" : "";
    949             }
    950              
    951             ###############################################################################
    952             ### Internal Functions ########################################################
    953             ###############################################################################
    954              
    955             ### _subject ( STRING, DEPTH, WIDTH )
    956             # Update the subject with an appropriate number of '>' marks (based on
    957             # DEPTH), and to a certain text width (based on WIDTH).
    958             sub _subject {
    959 0     0     my ($self, $string, $depth, $width) = @_;
    960 0   0       $width ||= 55; $depth ||= 0; $string ||= "";
      0   0        
      0   0        
    961              
    962             # This should be more general-purpose, but it'll do for now
    963 0 0         $string =~ s/^Re:\s*//i if $depth;
    964              
    965 0           my $quotestring = "";
    966 0 0         if ($depth < 10) {
        0          
    967 0           for (my $i = 0; $i < $depth; $i++) {
    968 0           $quotestring = join('', '>', $quotestring);
    969             }
    970             }
    971 0           elsif ($depth < 100) { $quotestring = ">>> $depth >>"; }
    972 0           else { $quotestring = ">> lots >"; }
    973 0 0         $string = $depth ? "$quotestring $string" : $string;
    974              
    975 0           my $real = $width - 5;
    976 0 0 0       $string =~ s%^(.{0,$real})(.{5})(.*)$%join('', $1, $3 ? '[...]' : $2)%egx
      0 0          
    977             unless ( $width <= 0 && length $string <= $real );
    978              
    979 0           $string;
    980             }
    981              
    982             ### _author ( STRING, WIDTH, TYPE )
    983             # Get the actual writer out of a From: line, dropping the email address
    984             # and trimming it down to WIDTH characters, and canonicalizes the format
    985             # based on TYPE ('name', 'email', 'namemail', or 'emailname').
    986             #
    987             # Note that this is *far* too complicated, and based on old code that I
    988             # wrote a long time ago and never bothered to make into a real module; I
    989             # should really write that module. Should also do something better than
    990             # 'unknown.site.invalid' and such.
    991             sub _author {
    992 0 0   0     my ($self, $string, $width, $type) = @_; return undef unless $string;
      0            
    993 0   0       $width ||= 25; $type ||= 'nameemail'; $string ||= "";
      0   0        
      0   0        
    994 0           my $address = ""; my $comment = "";
      0            
    995              
    996             # Information from News::Article::Ref
    997 0           my $PLAIN_PHRASE = $News::Article::Ref::PLAIN_PHRASE;
    998 0           my $ADDRESS = $News::Article::Ref::ADDRESS;
    999 0           my $PAREN_PHRASE = $News::Article::Ref::PAREN_PHRASE;
    1000 0           my $LOCAL_PART = $News::Article::Ref::LOCAL_PART;
    1001 0           my $DOMAIN = $News::Article::Ref::DOMAIN;
    1002              
    1003             # RFC 1036 standard From: formats
    1004 0 0         if ($string =~ /^\s*(?:\"?($PLAIN_PHRASE)?\"?\s*<($ADDRESS)>|
        0          
        0          
    1005             ($ADDRESS)\s*(?:\(($PAREN_PHRASE)\))?)\s*$/x) {
    1006 0   0       $address = $2 || $3;
    1007 0   0       $comment = $1 || $4;
    1008              
    1009             # No sitename was attached to the address - either append the local one if
    1010             # appropriate or set something saying that there wasn't one at all.
    1011             } elsif ($string =~ /^\s*(?:\"?($PLAIN_PHRASE)?\"?\s*<($LOCAL_PART)>|
    1012             ($LOCAL_PART)\s*(?:\(($PAREN_PHRASE)\))?)\s*$/x) {
    1013 0   0       $address = $2 || $3;
    1014 0   0       $comment = $1 || $4;
    1015            
    1016 0           my $host = "unknown.site.invalid";
    1017 0           $address = join('@', $address, $host);
    1018              
    1019             # The phrases had a bad part to them - scrap those parts.
    1020             } elsif ($string =~ /^\s*(?:(.*)\s*<($LOCAL_PART\@?$DOMAIN?)>|
    1021             ($LOCAL_PART\@?$DOMAIN?)\s*(.*))\s*$/x) {
    1022 0   0       $address = $2 || $3;
    1023 0   0       $comment = $1 || $4;
    1024            
    1025 0 0         unless ($address =~ /\@\S+$/) {
    1026 0           $address =~ s/\@$//g;
    1027 0           my $host = "unknown.site.invalid";
    1028 0           $address = join('@', $address, $host);
    1029             }
    1030              
    1031             # There's no way we're getting a valid address out of this, so let's see
    1032             # if we can find something *invalid*
    1033             } else {
    1034 0 0         if ($string =~ /^\s*(.*)\s*<(.*\@.*)>\s*$/) { $comment= $1; $address = $2 }
      0 0          
      0            
    1035             elsif ($string =~ /^\s*(\S+\@\S+)\s*(.*)\s*$/) {
    1036 0 0         if ($2) { $address = $1; $comment= $2 }
      0            
      0            
    1037             }
    1038 0           else { $string =~ s/^\s+|\s+$//g; }
    1039 0           map { s/^\s*|\s*//g } $comment, $string, $address;
      0            
    1040 0           $comment =~ s/[\"\(\)]//g;
    1041              
    1042 0   0       $comment ||= $string;
    1043 0   0       $address ||= 'unknown@unknown.site.invalid';
    1044             }
    1045              
    1046 0   0       $address ||= ""; $comment ||= "";
      0   0        
    1047 0           map { s%(^\s*|\s*$)%%g } ($address, $comment);
      0            
    1048              
    1049 0           $comment =~ s/[\"\(\)]//g;
    1050              
    1051 0           my $retstring;
    1052 0 0         if (lc $type eq 'email') { $retstring = $address; }
      0 0          
        0          
        0          
    1053 0           elsif (lc $type eq 'nameemail') { $retstring = "$comment <$address>" }
    1054 0           elsif (lc $type eq 'name') { $retstring = $comment }
    1055 0           elsif (lc $type eq 'emailname') { $retstring = "$address ($comment)" }
    1056 0           else { $retstring = "$comment <$address>" }
    1057              
    1058             # We always want *something*
    1059 0   0       $retstring ||= $address;
    1060              
    1061 0           my $real = $width - 5;
    1062 0 0 0       $retstring =~ s%^(.{0,$real})(.{5})(.*)$%join('', $1, $3 ? '[...]' : $2)%ex
      0 0          
    1063             unless ( $width <= 0 && length $retstring <= $real );
    1064 0           $retstring;
    1065             }
    1066              
    1067             ### _date ( [DATE] )
    1068             # Print the date in a consistent format; this really ought to be the
    1069             # consistent news format, though. If DATE isn't passed, we just use the
    1070             # current time. We should use the stuff from News::Article's add_date().
    1071             sub _date {
    1072 0     0     my $self = shift;
    1073 0           my $time = str2time(shift);
    1074 0           my @MONTHS = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
    1075 0           sprintf("%03s %02d %04d %02d:%02d:%02d",
    1076             @MONTHS[(localtime($time))[4]], (localtime($time))[3],
    1077             (localtime($time))[5] + 1900, # (localtime($time))[4] + 1,
    1078             (localtime($time))[2], (localtime($time))[1], (localtime($time))[0] );
    1079             }
    1080              
    1081             ### _mid ( ID )
    1082             # Make sure the '<' and '>' are on the ID, if the ID exists. Probably
    1083             # ought to make sure the ID is good first.
    1084             sub _mid {
    1085 0     0     my ($self, $mid) = @_;
    1086 0 0         return "" unless $mid;
    1087 0           $mid = join('', '<', $mid, '>');
    1088 0           $mid =~ s/^<>$/>/g;
      0            
    1089 0           $mid;
    1090             }
    1091              
    1092             ### _html_newsgroups ( LINE )
    1093             # html-ify the Newsgroups: header, with linkback().
    1094             sub _html_newsgroups {
    1095 0     0     my ($self, $line) = @_;
    1096 0           my @groups = split(',', $line);
    1097 0           map { $_ = $self->linkback($_, { 'group' => $_ }) } @groups;
      0            
    1098 0           join(',', @groups);
    1099             }
    1100              
    1101             ### _html_article ( ARTICLE, FULLHEAD )
    1102             # Actually does the work of returning the article in HTML form. If
    1103             # FULLHEAD is set, returns all headers; otherwise, only uses DEFAULTHEAD.
    1104             sub _html_article {
    1105 0     0     my ($self, $article, $fullhead) = @_;
    1106 0           my @return;
    1107 0 0         my @headers = $fullhead ? sort $article->header_names : @DEFAULTHEAD;
    1108 0           foreach my $header ( @headers ) {
    1109 0           my $value = $self->html_markup($header, $article->header($header));
    1110 0 0         push @return, "$value
    " if $value;
    1111             }
    1112 0           my @body;
    1113 0           foreach ($article->body) { push @body, $self->html_clean($_) }
      0            
    1114 0           push @return, join('', "
    ", join("\n", @body), "
    ");
    1115 0           @return;
    1116             }
    1117              
    1118             =head1 REQUIREMENTS
    1119              
    1120             News::Overview, Net::NNTP, News::Article, News::Article::Response and
    1121             News::Article::Ref (both part of NewsLib), IO::File, CGI.pm, Date::Parse
    1122              
    1123             =head1 SEE ALSO
    1124              
    1125             B, B, B,
    1126             B
    1127              
    1128             =head1 NOTES
    1129              
    1130             I'm not really done with this thing yet. This is just something that
    1131             generally *works*, and has something resembling documentation. I've got a
    1132             lot of work to do to make this what I really want to do, but I'm happy
    1133             with the start.
    1134              
    1135             =head1 TODO
    1136              
    1137             Still have a ways to go with stylesheets.
    1138              
    1139             Should really use the Tr() type functions for making tables.
    1140              
    1141             Various user interface improvements in html_article(), as well as backend
    1142             improvements.
    1143              
    1144             $count should really offer the number of articles we asked for, no matter
    1145             what, rather than estimating things.
    1146              
    1147             mod_perl-ify this stuff.
    1148              
    1149             It'd be nice if the documentation were a bit more transparent, enough so
    1150             that someone could recreate the actual gateway .cgi files without having
    1151             to refer to them.
    1152              
    1153             =head1 AUTHOR
    1154              
    1155             Tim Skirvin
    1156              
    1157             =head1 COPYRIGHT
    1158              
    1159             Copyright 2003 by Tim Skirvin . This code may be
    1160             distributed under the same terms as Perl itself.
    1161              
    1162             =cut
    1163              
    1164             1;
    1165              
    1166             ###############################################################################
    1167             ### Version History ###########################################################
    1168             ###############################################################################
    1169             # v0.1 Thu Sep 25 16:??:?? CDT 2003
    1170             ### First working version.
    1171             # v0.2
    1172             ### Allows for arbitrary NNTP-like connections.
    1173             ### Formatting in _subject() and _author() works more like it should
    1174             # v0.3
    1175             ### We're still very far away from being releasable, but this version allows
    1176             ### posting and is getting closer to set up in a reasoanable manner
    1177             ### code-wide.
    1178             # v0.40b Fri Oct 10 16:18:48 CDT 2003
    1179             ### Starting the proper commenting.
    1180             # v0.50b Sun Oct 12 16:05:05 CDT 2003
    1181             ### Changed html_overview() to do linkbacks to group/number pairs, instead
    1182             ### of the Message-ID directly
    1183             # v0.50.01 Mon Oct 13 17:32:30 CDT 2003
    1184             ### 'Articles in xxx:' weren't getting the group from the right place.
    1185             # v0.50.02 Mon Oct 13 19:29:56 CDT 2003
    1186             ### Wasn't offering 'post a new article' if the group was empty. Fixed.
    1187             # v0.50.03 Fri Nov 07 15:44:46 CST 2003
    1188             ### Gets information out of 'subscriptions' if there's no PATTERN passed
    1189             ### html_grouplist()
    1190             # v0.50.04 Sun Mar 28 23:52:23 CST 2004
    1191             ### Small fixes in printing article info in html_makearticle().
    1192             # v0.51 Thu Apr 22 14:12:31 CDT 2004
    1193             ### Code cleanup.