|
1 # Net::NNTP.pm |
|
2 # |
|
3 # Copyright (c) 1995-1997 Graham Barr <gbarr@pobox.com>. All rights reserved. |
|
4 # This program is free software; you can redistribute it and/or |
|
5 # modify it under the same terms as Perl itself. |
|
6 |
|
7 package Net::NNTP; |
|
8 |
|
9 use strict; |
|
10 use vars qw(@ISA $VERSION $debug); |
|
11 use IO::Socket; |
|
12 use Net::Cmd; |
|
13 use Carp; |
|
14 use Time::Local; |
|
15 use Net::Config; |
|
16 |
|
17 $VERSION = "2.22"; # $Id: //depot/libnet/Net/NNTP.pm#18 $ |
|
18 @ISA = qw(Net::Cmd IO::Socket::INET); |
|
19 |
|
20 sub new |
|
21 { |
|
22 my $self = shift; |
|
23 my $type = ref($self) || $self; |
|
24 my $host = shift if @_ % 2; |
|
25 my %arg = @_; |
|
26 my $obj; |
|
27 |
|
28 $host ||= $ENV{NNTPSERVER} || $ENV{NEWSHOST}; |
|
29 |
|
30 my $hosts = defined $host ? [ $host ] : $NetConfig{nntp_hosts}; |
|
31 |
|
32 @{$hosts} = qw(news) |
|
33 unless @{$hosts}; |
|
34 |
|
35 my $h; |
|
36 foreach $h (@{$hosts}) |
|
37 { |
|
38 $obj = $type->SUPER::new(PeerAddr => ($host = $h), |
|
39 PeerPort => $arg{Port} || 'nntp(119)', |
|
40 Proto => 'tcp', |
|
41 Timeout => defined $arg{Timeout} |
|
42 ? $arg{Timeout} |
|
43 : 120 |
|
44 ) and last; |
|
45 } |
|
46 |
|
47 return undef |
|
48 unless defined $obj; |
|
49 |
|
50 ${*$obj}{'net_nntp_host'} = $host; |
|
51 |
|
52 $obj->autoflush(1); |
|
53 $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef); |
|
54 |
|
55 unless ($obj->response() == CMD_OK) |
|
56 { |
|
57 $obj->close; |
|
58 return undef; |
|
59 } |
|
60 |
|
61 my $c = $obj->code; |
|
62 my @m = $obj->message; |
|
63 |
|
64 unless(exists $arg{Reader} && $arg{Reader} == 0) { |
|
65 # if server is INN and we have transfer rights the we are currently |
|
66 # talking to innd not nnrpd |
|
67 if($obj->reader) |
|
68 { |
|
69 # If reader suceeds the we need to consider this code to determine postok |
|
70 $c = $obj->code; |
|
71 } |
|
72 else |
|
73 { |
|
74 # I want to ignore this failure, so restore the previous status. |
|
75 $obj->set_status($c,\@m); |
|
76 } |
|
77 } |
|
78 |
|
79 ${*$obj}{'net_nntp_post'} = $c == 200 ? 1 : 0; |
|
80 |
|
81 $obj; |
|
82 } |
|
83 |
|
84 sub debug_text |
|
85 { |
|
86 my $nntp = shift; |
|
87 my $inout = shift; |
|
88 my $text = shift; |
|
89 |
|
90 if((ref($nntp) and $nntp->code == 350 and $text =~ /^(\S+)/) |
|
91 || ($text =~ /^(authinfo\s+pass)/io)) |
|
92 { |
|
93 $text = "$1 ....\n" |
|
94 } |
|
95 |
|
96 $text; |
|
97 } |
|
98 |
|
99 sub postok |
|
100 { |
|
101 @_ == 1 or croak 'usage: $nntp->postok()'; |
|
102 my $nntp = shift; |
|
103 ${*$nntp}{'net_nntp_post'} || 0; |
|
104 } |
|
105 |
|
106 sub article |
|
107 { |
|
108 @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->article( [ MSGID ], [ FH ] )'; |
|
109 my $nntp = shift; |
|
110 my @fh; |
|
111 |
|
112 @fh = (pop) if @_ == 2 || (@_ && ref($_[0]) || ref(\$_[0]) eq 'GLOB'); |
|
113 |
|
114 $nntp->_ARTICLE(@_) |
|
115 ? $nntp->read_until_dot(@fh) |
|
116 : undef; |
|
117 } |
|
118 |
|
119 sub articlefh { |
|
120 @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->articlefh( [ MSGID ] )'; |
|
121 my $nntp = shift; |
|
122 |
|
123 return unless $nntp->_ARTICLE(@_); |
|
124 return $nntp->tied_fh; |
|
125 } |
|
126 |
|
127 sub authinfo |
|
128 { |
|
129 @_ == 3 or croak 'usage: $nntp->authinfo( USER, PASS )'; |
|
130 my($nntp,$user,$pass) = @_; |
|
131 |
|
132 $nntp->_AUTHINFO("USER",$user) == CMD_MORE |
|
133 && $nntp->_AUTHINFO("PASS",$pass) == CMD_OK; |
|
134 } |
|
135 |
|
136 sub authinfo_simple |
|
137 { |
|
138 @_ == 3 or croak 'usage: $nntp->authinfo( USER, PASS )'; |
|
139 my($nntp,$user,$pass) = @_; |
|
140 |
|
141 $nntp->_AUTHINFO('SIMPLE') == CMD_MORE |
|
142 && $nntp->command($user,$pass)->response == CMD_OK; |
|
143 } |
|
144 |
|
145 sub body |
|
146 { |
|
147 @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->body( [ MSGID ], [ FH ] )'; |
|
148 my $nntp = shift; |
|
149 my @fh; |
|
150 |
|
151 @fh = (pop) if @_ == 2 || (@_ && ref($_[0]) || ref(\$_[0]) eq 'GLOB'); |
|
152 |
|
153 $nntp->_BODY(@_) |
|
154 ? $nntp->read_until_dot(@fh) |
|
155 : undef; |
|
156 } |
|
157 |
|
158 sub bodyfh |
|
159 { |
|
160 @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->bodyfh( [ MSGID ] )'; |
|
161 my $nntp = shift; |
|
162 return unless $nntp->_BODY(@_); |
|
163 return $nntp->tied_fh; |
|
164 } |
|
165 |
|
166 sub head |
|
167 { |
|
168 @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->head( [ MSGID ], [ FH ] )'; |
|
169 my $nntp = shift; |
|
170 my @fh; |
|
171 |
|
172 @fh = (pop) if @_ == 2 || (@_ && ref($_[0]) || ref(\$_[0]) eq 'GLOB'); |
|
173 |
|
174 $nntp->_HEAD(@_) |
|
175 ? $nntp->read_until_dot(@fh) |
|
176 : undef; |
|
177 } |
|
178 |
|
179 sub headfh |
|
180 { |
|
181 @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->headfh( [ MSGID ] )'; |
|
182 my $nntp = shift; |
|
183 return unless $nntp->_HEAD(@_); |
|
184 return $nntp->tied_fh; |
|
185 } |
|
186 |
|
187 sub nntpstat |
|
188 { |
|
189 @_ == 1 || @_ == 2 or croak 'usage: $nntp->nntpstat( [ MSGID ] )'; |
|
190 my $nntp = shift; |
|
191 |
|
192 $nntp->_STAT(@_) && $nntp->message =~ /(<[^>]+>)/o |
|
193 ? $1 |
|
194 : undef; |
|
195 } |
|
196 |
|
197 |
|
198 sub group |
|
199 { |
|
200 @_ == 1 || @_ == 2 or croak 'usage: $nntp->group( [ GROUP ] )'; |
|
201 my $nntp = shift; |
|
202 my $grp = ${*$nntp}{'net_nntp_group'} || undef; |
|
203 |
|
204 return $grp |
|
205 unless(@_ || wantarray); |
|
206 |
|
207 my $newgrp = shift; |
|
208 |
|
209 return wantarray ? () : undef |
|
210 unless $nntp->_GROUP($newgrp || $grp || "") |
|
211 && $nntp->message =~ /(\d+)\s+(\d+)\s+(\d+)\s+(\S+)/; |
|
212 |
|
213 my($count,$first,$last,$group) = ($1,$2,$3,$4); |
|
214 |
|
215 # group may be replied as '(current group)' |
|
216 $group = ${*$nntp}{'net_nntp_group'} |
|
217 if $group =~ /\(/; |
|
218 |
|
219 ${*$nntp}{'net_nntp_group'} = $group; |
|
220 |
|
221 wantarray |
|
222 ? ($count,$first,$last,$group) |
|
223 : $group; |
|
224 } |
|
225 |
|
226 sub help |
|
227 { |
|
228 @_ == 1 or croak 'usage: $nntp->help()'; |
|
229 my $nntp = shift; |
|
230 |
|
231 $nntp->_HELP |
|
232 ? $nntp->read_until_dot |
|
233 : undef; |
|
234 } |
|
235 |
|
236 sub ihave |
|
237 { |
|
238 @_ >= 2 or croak 'usage: $nntp->ihave( MESSAGE-ID [, MESSAGE ])'; |
|
239 my $nntp = shift; |
|
240 my $mid = shift; |
|
241 |
|
242 $nntp->_IHAVE($mid) && $nntp->datasend(@_) |
|
243 ? @_ == 0 || $nntp->dataend |
|
244 : undef; |
|
245 } |
|
246 |
|
247 sub last |
|
248 { |
|
249 @_ == 1 or croak 'usage: $nntp->last()'; |
|
250 my $nntp = shift; |
|
251 |
|
252 $nntp->_LAST && $nntp->message =~ /(<[^>]+>)/o |
|
253 ? $1 |
|
254 : undef; |
|
255 } |
|
256 |
|
257 sub list |
|
258 { |
|
259 @_ == 1 or croak 'usage: $nntp->list()'; |
|
260 my $nntp = shift; |
|
261 |
|
262 $nntp->_LIST |
|
263 ? $nntp->_grouplist |
|
264 : undef; |
|
265 } |
|
266 |
|
267 sub newgroups |
|
268 { |
|
269 @_ >= 2 or croak 'usage: $nntp->newgroups( SINCE [, DISTRIBUTIONS ])'; |
|
270 my $nntp = shift; |
|
271 my $time = _timestr(shift); |
|
272 my $dist = shift || ""; |
|
273 |
|
274 $dist = join(",", @{$dist}) |
|
275 if ref($dist); |
|
276 |
|
277 $nntp->_NEWGROUPS($time,$dist) |
|
278 ? $nntp->_grouplist |
|
279 : undef; |
|
280 } |
|
281 |
|
282 sub newnews |
|
283 { |
|
284 @_ >= 2 && @_ <= 4 or |
|
285 croak 'usage: $nntp->newnews( SINCE [, GROUPS [, DISTRIBUTIONS ]])'; |
|
286 my $nntp = shift; |
|
287 my $time = _timestr(shift); |
|
288 my $grp = @_ ? shift : $nntp->group; |
|
289 my $dist = shift || ""; |
|
290 |
|
291 $grp ||= "*"; |
|
292 $grp = join(",", @{$grp}) |
|
293 if ref($grp); |
|
294 |
|
295 $dist = join(",", @{$dist}) |
|
296 if ref($dist); |
|
297 |
|
298 $nntp->_NEWNEWS($grp,$time,$dist) |
|
299 ? $nntp->_articlelist |
|
300 : undef; |
|
301 } |
|
302 |
|
303 sub next |
|
304 { |
|
305 @_ == 1 or croak 'usage: $nntp->next()'; |
|
306 my $nntp = shift; |
|
307 |
|
308 $nntp->_NEXT && $nntp->message =~ /(<[^>]+>)/o |
|
309 ? $1 |
|
310 : undef; |
|
311 } |
|
312 |
|
313 sub post |
|
314 { |
|
315 @_ >= 1 or croak 'usage: $nntp->post( [ MESSAGE ] )'; |
|
316 my $nntp = shift; |
|
317 |
|
318 $nntp->_POST() && $nntp->datasend(@_) |
|
319 ? @_ == 0 || $nntp->dataend |
|
320 : undef; |
|
321 } |
|
322 |
|
323 sub postfh { |
|
324 my $nntp = shift; |
|
325 return unless $nntp->_POST(); |
|
326 return $nntp->tied_fh; |
|
327 } |
|
328 |
|
329 sub quit |
|
330 { |
|
331 @_ == 1 or croak 'usage: $nntp->quit()'; |
|
332 my $nntp = shift; |
|
333 |
|
334 $nntp->_QUIT; |
|
335 $nntp->close; |
|
336 } |
|
337 |
|
338 sub slave |
|
339 { |
|
340 @_ == 1 or croak 'usage: $nntp->slave()'; |
|
341 my $nntp = shift; |
|
342 |
|
343 $nntp->_SLAVE; |
|
344 } |
|
345 |
|
346 ## |
|
347 ## The following methods are not implemented by all servers |
|
348 ## |
|
349 |
|
350 sub active |
|
351 { |
|
352 @_ == 1 || @_ == 2 or croak 'usage: $nntp->active( [ PATTERN ] )'; |
|
353 my $nntp = shift; |
|
354 |
|
355 $nntp->_LIST('ACTIVE',@_) |
|
356 ? $nntp->_grouplist |
|
357 : undef; |
|
358 } |
|
359 |
|
360 sub active_times |
|
361 { |
|
362 @_ == 1 or croak 'usage: $nntp->active_times()'; |
|
363 my $nntp = shift; |
|
364 |
|
365 $nntp->_LIST('ACTIVE.TIMES') |
|
366 ? $nntp->_grouplist |
|
367 : undef; |
|
368 } |
|
369 |
|
370 sub distributions |
|
371 { |
|
372 @_ == 1 or croak 'usage: $nntp->distributions()'; |
|
373 my $nntp = shift; |
|
374 |
|
375 $nntp->_LIST('DISTRIBUTIONS') |
|
376 ? $nntp->_description |
|
377 : undef; |
|
378 } |
|
379 |
|
380 sub distribution_patterns |
|
381 { |
|
382 @_ == 1 or croak 'usage: $nntp->distributions()'; |
|
383 my $nntp = shift; |
|
384 |
|
385 my $arr; |
|
386 local $_; |
|
387 |
|
388 $nntp->_LIST('DISTRIB.PATS') && ($arr = $nntp->read_until_dot) |
|
389 ? [grep { /^\d/ && (chomp, $_ = [ split /:/ ]) } @$arr] |
|
390 : undef; |
|
391 } |
|
392 |
|
393 sub newsgroups |
|
394 { |
|
395 @_ == 1 || @_ == 2 or croak 'usage: $nntp->newsgroups( [ PATTERN ] )'; |
|
396 my $nntp = shift; |
|
397 |
|
398 $nntp->_LIST('NEWSGROUPS',@_) |
|
399 ? $nntp->_description |
|
400 : undef; |
|
401 } |
|
402 |
|
403 sub overview_fmt |
|
404 { |
|
405 @_ == 1 or croak 'usage: $nntp->overview_fmt()'; |
|
406 my $nntp = shift; |
|
407 |
|
408 $nntp->_LIST('OVERVIEW.FMT') |
|
409 ? $nntp->_articlelist |
|
410 : undef; |
|
411 } |
|
412 |
|
413 sub subscriptions |
|
414 { |
|
415 @_ == 1 or croak 'usage: $nntp->subscriptions()'; |
|
416 my $nntp = shift; |
|
417 |
|
418 $nntp->_LIST('SUBSCRIPTIONS') |
|
419 ? $nntp->_articlelist |
|
420 : undef; |
|
421 } |
|
422 |
|
423 sub listgroup |
|
424 { |
|
425 @_ == 1 || @_ == 2 or croak 'usage: $nntp->listgroup( [ GROUP ] )'; |
|
426 my $nntp = shift; |
|
427 |
|
428 $nntp->_LISTGROUP(@_) |
|
429 ? $nntp->_articlelist |
|
430 : undef; |
|
431 } |
|
432 |
|
433 sub reader |
|
434 { |
|
435 @_ == 1 or croak 'usage: $nntp->reader()'; |
|
436 my $nntp = shift; |
|
437 |
|
438 $nntp->_MODE('READER'); |
|
439 } |
|
440 |
|
441 sub xgtitle |
|
442 { |
|
443 @_ == 1 || @_ == 2 or croak 'usage: $nntp->xgtitle( [ PATTERN ] )'; |
|
444 my $nntp = shift; |
|
445 |
|
446 $nntp->_XGTITLE(@_) |
|
447 ? $nntp->_description |
|
448 : undef; |
|
449 } |
|
450 |
|
451 sub xhdr |
|
452 { |
|
453 @_ >= 2 && @_ <= 4 or croak 'usage: $nntp->xhdr( HEADER, [ MESSAGE-SPEC ] )'; |
|
454 my $nntp = shift; |
|
455 my $hdr = shift; |
|
456 my $arg = _msg_arg(@_); |
|
457 |
|
458 $nntp->_XHDR($hdr, $arg) |
|
459 ? $nntp->_description |
|
460 : undef; |
|
461 } |
|
462 |
|
463 sub xover |
|
464 { |
|
465 @_ == 2 || @_ == 3 or croak 'usage: $nntp->xover( MESSAGE-SPEC )'; |
|
466 my $nntp = shift; |
|
467 my $arg = _msg_arg(@_); |
|
468 |
|
469 $nntp->_XOVER($arg) |
|
470 ? $nntp->_fieldlist |
|
471 : undef; |
|
472 } |
|
473 |
|
474 sub xpat |
|
475 { |
|
476 @_ == 4 || @_ == 5 or croak '$nntp->xpat( HEADER, PATTERN, MESSAGE-SPEC )'; |
|
477 my $nntp = shift; |
|
478 my $hdr = shift; |
|
479 my $pat = shift; |
|
480 my $arg = _msg_arg(@_); |
|
481 |
|
482 $pat = join(" ", @$pat) |
|
483 if ref($pat); |
|
484 |
|
485 $nntp->_XPAT($hdr,$arg,$pat) |
|
486 ? $nntp->_description |
|
487 : undef; |
|
488 } |
|
489 |
|
490 sub xpath |
|
491 { |
|
492 @_ == 2 or croak 'usage: $nntp->xpath( MESSAGE-ID )'; |
|
493 my($nntp,$mid) = @_; |
|
494 |
|
495 return undef |
|
496 unless $nntp->_XPATH($mid); |
|
497 |
|
498 my $m; ($m = $nntp->message) =~ s/^\d+\s+//o; |
|
499 my @p = split /\s+/, $m; |
|
500 |
|
501 wantarray ? @p : $p[0]; |
|
502 } |
|
503 |
|
504 sub xrover |
|
505 { |
|
506 @_ == 2 || @_ == 3 or croak 'usage: $nntp->xrover( MESSAGE-SPEC )'; |
|
507 my $nntp = shift; |
|
508 my $arg = _msg_arg(@_); |
|
509 |
|
510 $nntp->_XROVER($arg) |
|
511 ? $nntp->_description |
|
512 : undef; |
|
513 } |
|
514 |
|
515 sub date |
|
516 { |
|
517 @_ == 1 or croak 'usage: $nntp->date()'; |
|
518 my $nntp = shift; |
|
519 |
|
520 $nntp->_DATE && $nntp->message =~ /(\d{4})(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/ |
|
521 ? timegm($6,$5,$4,$3,$2-1,$1 - 1900) |
|
522 : undef; |
|
523 } |
|
524 |
|
525 |
|
526 ## |
|
527 ## Private subroutines |
|
528 ## |
|
529 |
|
530 sub _msg_arg |
|
531 { |
|
532 my $spec = shift; |
|
533 my $arg = ""; |
|
534 |
|
535 if(@_) |
|
536 { |
|
537 carp "Depriciated passing of two message numbers, " |
|
538 . "pass a reference" |
|
539 if $^W; |
|
540 $spec = [ $spec, $_[0] ]; |
|
541 } |
|
542 |
|
543 if(defined $spec) |
|
544 { |
|
545 if(ref($spec)) |
|
546 { |
|
547 $arg = $spec->[0]; |
|
548 if(defined $spec->[1]) |
|
549 { |
|
550 $arg .= "-" |
|
551 if $spec->[1] != $spec->[0]; |
|
552 $arg .= $spec->[1] |
|
553 if $spec->[1] > $spec->[0]; |
|
554 } |
|
555 } |
|
556 else |
|
557 { |
|
558 $arg = $spec; |
|
559 } |
|
560 } |
|
561 |
|
562 $arg; |
|
563 } |
|
564 |
|
565 sub _timestr |
|
566 { |
|
567 my $time = shift; |
|
568 my @g = reverse((gmtime($time))[0..5]); |
|
569 $g[1] += 1; |
|
570 $g[0] %= 100; |
|
571 sprintf "%02d%02d%02d %02d%02d%02d GMT", @g; |
|
572 } |
|
573 |
|
574 sub _grouplist |
|
575 { |
|
576 my $nntp = shift; |
|
577 my $arr = $nntp->read_until_dot or |
|
578 return undef; |
|
579 |
|
580 my $hash = {}; |
|
581 my $ln; |
|
582 |
|
583 foreach $ln (@$arr) |
|
584 { |
|
585 my @a = split(/[\s\n]+/,$ln); |
|
586 $hash->{$a[0]} = [ @a[1,2,3] ]; |
|
587 } |
|
588 |
|
589 $hash; |
|
590 } |
|
591 |
|
592 sub _fieldlist |
|
593 { |
|
594 my $nntp = shift; |
|
595 my $arr = $nntp->read_until_dot or |
|
596 return undef; |
|
597 |
|
598 my $hash = {}; |
|
599 my $ln; |
|
600 |
|
601 foreach $ln (@$arr) |
|
602 { |
|
603 my @a = split(/[\t\n]/,$ln); |
|
604 my $m = shift @a; |
|
605 $hash->{$m} = [ @a ]; |
|
606 } |
|
607 |
|
608 $hash; |
|
609 } |
|
610 |
|
611 sub _articlelist |
|
612 { |
|
613 my $nntp = shift; |
|
614 my $arr = $nntp->read_until_dot; |
|
615 |
|
616 chomp(@$arr) |
|
617 if $arr; |
|
618 |
|
619 $arr; |
|
620 } |
|
621 |
|
622 sub _description |
|
623 { |
|
624 my $nntp = shift; |
|
625 my $arr = $nntp->read_until_dot or |
|
626 return undef; |
|
627 |
|
628 my $hash = {}; |
|
629 my $ln; |
|
630 |
|
631 foreach $ln (@$arr) |
|
632 { |
|
633 chomp($ln); |
|
634 |
|
635 $hash->{$1} = $ln |
|
636 if $ln =~ s/^\s*(\S+)\s*//o; |
|
637 } |
|
638 |
|
639 $hash; |
|
640 |
|
641 } |
|
642 |
|
643 ## |
|
644 ## The commands |
|
645 ## |
|
646 |
|
647 sub _ARTICLE { shift->command('ARTICLE',@_)->response == CMD_OK } |
|
648 sub _AUTHINFO { shift->command('AUTHINFO',@_)->response } |
|
649 sub _BODY { shift->command('BODY',@_)->response == CMD_OK } |
|
650 sub _DATE { shift->command('DATE')->response == CMD_INFO } |
|
651 sub _GROUP { shift->command('GROUP',@_)->response == CMD_OK } |
|
652 sub _HEAD { shift->command('HEAD',@_)->response == CMD_OK } |
|
653 sub _HELP { shift->command('HELP',@_)->response == CMD_INFO } |
|
654 sub _IHAVE { shift->command('IHAVE',@_)->response == CMD_MORE } |
|
655 sub _LAST { shift->command('LAST')->response == CMD_OK } |
|
656 sub _LIST { shift->command('LIST',@_)->response == CMD_OK } |
|
657 sub _LISTGROUP { shift->command('LISTGROUP',@_)->response == CMD_OK } |
|
658 sub _NEWGROUPS { shift->command('NEWGROUPS',@_)->response == CMD_OK } |
|
659 sub _NEWNEWS { shift->command('NEWNEWS',@_)->response == CMD_OK } |
|
660 sub _NEXT { shift->command('NEXT')->response == CMD_OK } |
|
661 sub _POST { shift->command('POST',@_)->response == CMD_MORE } |
|
662 sub _QUIT { shift->command('QUIT',@_)->response == CMD_OK } |
|
663 sub _SLAVE { shift->command('SLAVE',@_)->response == CMD_OK } |
|
664 sub _STAT { shift->command('STAT',@_)->response == CMD_OK } |
|
665 sub _MODE { shift->command('MODE',@_)->response == CMD_OK } |
|
666 sub _XGTITLE { shift->command('XGTITLE',@_)->response == CMD_OK } |
|
667 sub _XHDR { shift->command('XHDR',@_)->response == CMD_OK } |
|
668 sub _XPAT { shift->command('XPAT',@_)->response == CMD_OK } |
|
669 sub _XPATH { shift->command('XPATH',@_)->response == CMD_OK } |
|
670 sub _XOVER { shift->command('XOVER',@_)->response == CMD_OK } |
|
671 sub _XROVER { shift->command('XROVER',@_)->response == CMD_OK } |
|
672 sub _XTHREAD { shift->unsupported } |
|
673 sub _XSEARCH { shift->unsupported } |
|
674 sub _XINDEX { shift->unsupported } |
|
675 |
|
676 ## |
|
677 ## IO/perl methods |
|
678 ## |
|
679 |
|
680 sub DESTROY |
|
681 { |
|
682 my $nntp = shift; |
|
683 defined(fileno($nntp)) && $nntp->quit |
|
684 } |
|
685 |
|
686 |
|
687 1; |
|
688 |
|
689 __END__ |
|
690 |
|
691 =head1 NAME |
|
692 |
|
693 Net::NNTP - NNTP Client class |
|
694 |
|
695 =head1 SYNOPSIS |
|
696 |
|
697 use Net::NNTP; |
|
698 |
|
699 $nntp = Net::NNTP->new("some.host.name"); |
|
700 $nntp->quit; |
|
701 |
|
702 =head1 DESCRIPTION |
|
703 |
|
704 C<Net::NNTP> is a class implementing a simple NNTP client in Perl as described |
|
705 in RFC977. C<Net::NNTP> inherits its communication methods from C<Net::Cmd> |
|
706 |
|
707 =head1 CONSTRUCTOR |
|
708 |
|
709 =over 4 |
|
710 |
|
711 =item new ( [ HOST ] [, OPTIONS ]) |
|
712 |
|
713 This is the constructor for a new Net::NNTP object. C<HOST> is the |
|
714 name of the remote host to which a NNTP connection is required. If not |
|
715 given two environment variables are checked, first C<NNTPSERVER> then |
|
716 C<NEWSHOST>, then C<Net::Config> is checked, and if a host is not found |
|
717 then C<news> is used. |
|
718 |
|
719 C<OPTIONS> are passed in a hash like fashion, using key and value pairs. |
|
720 Possible options are: |
|
721 |
|
722 B<Timeout> - Maximum time, in seconds, to wait for a response from the |
|
723 NNTP server, a value of zero will cause all IO operations to block. |
|
724 (default: 120) |
|
725 |
|
726 B<Debug> - Enable the printing of debugging information to STDERR |
|
727 |
|
728 B<Reader> - If the remote server is INN then initially the connection |
|
729 will be to nnrpd, by default C<Net::NNTP> will issue a C<MODE READER> command |
|
730 so that the remote server becomes innd. If the C<Reader> option is given |
|
731 with a value of zero, then this command will not be sent and the |
|
732 connection will be left talking to nnrpd. |
|
733 |
|
734 =back |
|
735 |
|
736 =head1 METHODS |
|
737 |
|
738 Unless otherwise stated all methods return either a I<true> or I<false> |
|
739 value, with I<true> meaning that the operation was a success. When a method |
|
740 states that it returns a value, failure will be returned as I<undef> or an |
|
741 empty list. |
|
742 |
|
743 =over 4 |
|
744 |
|
745 =item article ( [ MSGID|MSGNUM ], [FH] ) |
|
746 |
|
747 Retrieve the header, a blank line, then the body (text) of the |
|
748 specified article. |
|
749 |
|
750 If C<FH> is specified then it is expected to be a valid filehandle |
|
751 and the result will be printed to it, on success a true value will be |
|
752 returned. If C<FH> is not specified then the return value, on success, |
|
753 will be a reference to an array containg the article requested, each |
|
754 entry in the array will contain one line of the article. |
|
755 |
|
756 If no arguments are passed then the current article in the currently |
|
757 selected newsgroup is fetched. |
|
758 |
|
759 C<MSGNUM> is a numeric id of an article in the current newsgroup, and |
|
760 will change the current article pointer. C<MSGID> is the message id of |
|
761 an article as shown in that article's header. It is anticipated that the |
|
762 client will obtain the C<MSGID> from a list provided by the C<newnews> |
|
763 command, from references contained within another article, or from the |
|
764 message-id provided in the response to some other commands. |
|
765 |
|
766 If there is an error then C<undef> will be returned. |
|
767 |
|
768 =item body ( [ MSGID|MSGNUM ], [FH] ) |
|
769 |
|
770 Like C<article> but only fetches the body of the article. |
|
771 |
|
772 =item head ( [ MSGID|MSGNUM ], [FH] ) |
|
773 |
|
774 Like C<article> but only fetches the headers for the article. |
|
775 |
|
776 =item articlefh ( [ MSGID|MSGNUM ] ) |
|
777 |
|
778 =item bodyfh ( [ MSGID|MSGNUM ] ) |
|
779 |
|
780 =item headfh ( [ MSGID|MSGNUM ] ) |
|
781 |
|
782 These are similar to article(), body() and head(), but rather than |
|
783 returning the requested data directly, they return a tied filehandle |
|
784 from which to read the article. |
|
785 |
|
786 =item nntpstat ( [ MSGID|MSGNUM ] ) |
|
787 |
|
788 The C<nntpstat> command is similar to the C<article> command except that no |
|
789 text is returned. When selecting by message number within a group, |
|
790 the C<nntpstat> command serves to set the "current article pointer" without |
|
791 sending text. |
|
792 |
|
793 Using the C<nntpstat> command to |
|
794 select by message-id is valid but of questionable value, since a |
|
795 selection by message-id does B<not> alter the "current article pointer". |
|
796 |
|
797 Returns the message-id of the "current article". |
|
798 |
|
799 =item group ( [ GROUP ] ) |
|
800 |
|
801 Set and/or get the current group. If C<GROUP> is not given then information |
|
802 is returned on the current group. |
|
803 |
|
804 In a scalar context it returns the group name. |
|
805 |
|
806 In an array context the return value is a list containing, the number |
|
807 of articles in the group, the number of the first article, the number |
|
808 of the last article and the group name. |
|
809 |
|
810 =item ihave ( MSGID [, MESSAGE ]) |
|
811 |
|
812 The C<ihave> command informs the server that the client has an article |
|
813 whose id is C<MSGID>. If the server desires a copy of that |
|
814 article, and C<MESSAGE> has been given the it will be sent. |
|
815 |
|
816 Returns I<true> if the server desires the article and C<MESSAGE> was |
|
817 successfully sent,if specified. |
|
818 |
|
819 If C<MESSAGE> is not specified then the message must be sent using the |
|
820 C<datasend> and C<dataend> methods from L<Net::Cmd> |
|
821 |
|
822 C<MESSAGE> can be either an array of lines or a reference to an array. |
|
823 |
|
824 =item last () |
|
825 |
|
826 Set the "current article pointer" to the previous article in the current |
|
827 newsgroup. |
|
828 |
|
829 Returns the message-id of the article. |
|
830 |
|
831 =item date () |
|
832 |
|
833 Returns the date on the remote server. This date will be in a UNIX time |
|
834 format (seconds since 1970) |
|
835 |
|
836 =item postok () |
|
837 |
|
838 C<postok> will return I<true> if the servers initial response indicated |
|
839 that it will allow posting. |
|
840 |
|
841 =item authinfo ( USER, PASS ) |
|
842 |
|
843 =item list () |
|
844 |
|
845 Obtain information about all the active newsgroups. The results is a reference |
|
846 to a hash where the key is a group name and each value is a reference to an |
|
847 array. The elements in this array are:- the last article number in the group, |
|
848 the first article number in the group and any information flags about the group. |
|
849 |
|
850 =item newgroups ( SINCE [, DISTRIBUTIONS ]) |
|
851 |
|
852 C<SINCE> is a time value and C<DISTRIBUTIONS> is either a distribution |
|
853 pattern or a reference to a list of distribution patterns. |
|
854 The result is the same as C<list>, but the |
|
855 groups return will be limited to those created after C<SINCE> and, if |
|
856 specified, in one of the distribution areas in C<DISTRIBUTIONS>. |
|
857 |
|
858 =item newnews ( SINCE [, GROUPS [, DISTRIBUTIONS ]]) |
|
859 |
|
860 C<SINCE> is a time value. C<GROUPS> is either a group pattern or a reference |
|
861 to a list of group patterns. C<DISTRIBUTIONS> is either a distribution |
|
862 pattern or a reference to a list of distribution patterns. |
|
863 |
|
864 Returns a reference to a list which contains the message-ids of all news posted |
|
865 after C<SINCE>, that are in a groups which matched C<GROUPS> and a |
|
866 distribution which matches C<DISTRIBUTIONS>. |
|
867 |
|
868 =item next () |
|
869 |
|
870 Set the "current article pointer" to the next article in the current |
|
871 newsgroup. |
|
872 |
|
873 Returns the message-id of the article. |
|
874 |
|
875 =item post ( [ MESSAGE ] ) |
|
876 |
|
877 Post a new article to the news server. If C<MESSAGE> is specified and posting |
|
878 is allowed then the message will be sent. |
|
879 |
|
880 If C<MESSAGE> is not specified then the message must be sent using the |
|
881 C<datasend> and C<dataend> methods from L<Net::Cmd> |
|
882 |
|
883 C<MESSAGE> can be either an array of lines or a reference to an array. |
|
884 |
|
885 The message, either sent via C<datasend> or as the C<MESSAGE> |
|
886 parameter, must be in the format as described by RFC822 and must |
|
887 contain From:, Newsgroups: and Subject: headers. |
|
888 |
|
889 =item postfh () |
|
890 |
|
891 Post a new article to the news server using a tied filehandle. If |
|
892 posting is allowed, this method will return a tied filehandle that you |
|
893 can print() the contents of the article to be posted. You must |
|
894 explicitly close() the filehandle when you are finished posting the |
|
895 article, and the return value from the close() call will indicate |
|
896 whether the message was successfully posted. |
|
897 |
|
898 =item slave () |
|
899 |
|
900 Tell the remote server that I am not a user client, but probably another |
|
901 news server. |
|
902 |
|
903 =item quit () |
|
904 |
|
905 Quit the remote server and close the socket connection. |
|
906 |
|
907 =back |
|
908 |
|
909 =head2 Extension methods |
|
910 |
|
911 These methods use commands that are not part of the RFC977 documentation. Some |
|
912 servers may not support all of them. |
|
913 |
|
914 =over 4 |
|
915 |
|
916 =item newsgroups ( [ PATTERN ] ) |
|
917 |
|
918 Returns a reference to a hash where the keys are all the group names which |
|
919 match C<PATTERN>, or all of the groups if no pattern is specified, and |
|
920 each value contains the description text for the group. |
|
921 |
|
922 =item distributions () |
|
923 |
|
924 Returns a reference to a hash where the keys are all the possible |
|
925 distribution names and the values are the distribution descriptions. |
|
926 |
|
927 =item subscriptions () |
|
928 |
|
929 Returns a reference to a list which contains a list of groups which |
|
930 are recommended for a new user to subscribe to. |
|
931 |
|
932 =item overview_fmt () |
|
933 |
|
934 Returns a reference to an array which contain the names of the fields returned |
|
935 by C<xover>. |
|
936 |
|
937 =item active_times () |
|
938 |
|
939 Returns a reference to a hash where the keys are the group names and each |
|
940 value is a reference to an array containing the time the groups was created |
|
941 and an identifier, possibly an Email address, of the creator. |
|
942 |
|
943 =item active ( [ PATTERN ] ) |
|
944 |
|
945 Similar to C<list> but only active groups that match the pattern are returned. |
|
946 C<PATTERN> can be a group pattern. |
|
947 |
|
948 =item xgtitle ( PATTERN ) |
|
949 |
|
950 Returns a reference to a hash where the keys are all the group names which |
|
951 match C<PATTERN> and each value is the description text for the group. |
|
952 |
|
953 =item xhdr ( HEADER, MESSAGE-SPEC ) |
|
954 |
|
955 Obtain the header field C<HEADER> for all the messages specified. |
|
956 |
|
957 The return value will be a reference |
|
958 to a hash where the keys are the message numbers and each value contains |
|
959 the text of the requested header for that message. |
|
960 |
|
961 =item xover ( MESSAGE-SPEC ) |
|
962 |
|
963 The return value will be a reference |
|
964 to a hash where the keys are the message numbers and each value contains |
|
965 a reference to an array which contains the overview fields for that |
|
966 message. |
|
967 |
|
968 The names of the fields can be obtained by calling C<overview_fmt>. |
|
969 |
|
970 =item xpath ( MESSAGE-ID ) |
|
971 |
|
972 Returns the path name to the file on the server which contains the specified |
|
973 message. |
|
974 |
|
975 =item xpat ( HEADER, PATTERN, MESSAGE-SPEC) |
|
976 |
|
977 The result is the same as C<xhdr> except the is will be restricted to |
|
978 headers where the text of the header matches C<PATTERN> |
|
979 |
|
980 =item xrover |
|
981 |
|
982 The XROVER command returns reference information for the article(s) |
|
983 specified. |
|
984 |
|
985 Returns a reference to a HASH where the keys are the message numbers and the |
|
986 values are the References: lines from the articles |
|
987 |
|
988 =item listgroup ( [ GROUP ] ) |
|
989 |
|
990 Returns a reference to a list of all the active messages in C<GROUP>, or |
|
991 the current group if C<GROUP> is not specified. |
|
992 |
|
993 =item reader |
|
994 |
|
995 Tell the server that you are a reader and not another server. |
|
996 |
|
997 This is required by some servers. For example if you are connecting to |
|
998 an INN server and you have transfer permission your connection will |
|
999 be connected to the transfer daemon, not the NNTP daemon. Issuing |
|
1000 this command will cause the transfer daemon to hand over control |
|
1001 to the NNTP daemon. |
|
1002 |
|
1003 Some servers do not understand this command, but issuing it and ignoring |
|
1004 the response is harmless. |
|
1005 |
|
1006 =back |
|
1007 |
|
1008 =head1 UNSUPPORTED |
|
1009 |
|
1010 The following NNTP command are unsupported by the package, and there are |
|
1011 no plans to do so. |
|
1012 |
|
1013 AUTHINFO GENERIC |
|
1014 XTHREAD |
|
1015 XSEARCH |
|
1016 XINDEX |
|
1017 |
|
1018 =head1 DEFINITIONS |
|
1019 |
|
1020 =over 4 |
|
1021 |
|
1022 =item MESSAGE-SPEC |
|
1023 |
|
1024 C<MESSAGE-SPEC> is either a single message-id, a single message number, or |
|
1025 a reference to a list of two message numbers. |
|
1026 |
|
1027 If C<MESSAGE-SPEC> is a reference to a list of two message numbers and the |
|
1028 second number in a range is less than or equal to the first then the range |
|
1029 represents all messages in the group after the first message number. |
|
1030 |
|
1031 B<NOTE> For compatibility reasons only with earlier versions of Net::NNTP |
|
1032 a message spec can be passed as a list of two numbers, this is deprecated |
|
1033 and a reference to the list should now be passed |
|
1034 |
|
1035 =item PATTERN |
|
1036 |
|
1037 The C<NNTP> protocol uses the C<WILDMAT> format for patterns. |
|
1038 The WILDMAT format was first developed by Rich Salz based on |
|
1039 the format used in the UNIX "find" command to articulate |
|
1040 file names. It was developed to provide a uniform mechanism |
|
1041 for matching patterns in the same manner that the UNIX shell |
|
1042 matches filenames. |
|
1043 |
|
1044 Patterns are implicitly anchored at the |
|
1045 beginning and end of each string when testing for a match. |
|
1046 |
|
1047 There are five pattern matching operations other than a strict |
|
1048 one-to-one match between the pattern and the source to be |
|
1049 checked for a match. |
|
1050 |
|
1051 The first is an asterisk C<*> to match any sequence of zero or more |
|
1052 characters. |
|
1053 |
|
1054 The second is a question mark C<?> to match any single character. The |
|
1055 third specifies a specific set of characters. |
|
1056 |
|
1057 The set is specified as a list of characters, or as a range of characters |
|
1058 where the beginning and end of the range are separated by a minus (or dash) |
|
1059 character, or as any combination of lists and ranges. The dash can |
|
1060 also be included in the set as a character it if is the beginning |
|
1061 or end of the set. This set is enclosed in square brackets. The |
|
1062 close square bracket C<]> may be used in a set if it is the first |
|
1063 character in the set. |
|
1064 |
|
1065 The fourth operation is the same as the |
|
1066 logical not of the third operation and is specified the same |
|
1067 way as the third with the addition of a caret character C<^> at |
|
1068 the beginning of the test string just inside the open square |
|
1069 bracket. |
|
1070 |
|
1071 The final operation uses the backslash character to |
|
1072 invalidate the special meaning of an open square bracket C<[>, |
|
1073 the asterisk, backslash or the question mark. Two backslashes in |
|
1074 sequence will result in the evaluation of the backslash as a |
|
1075 character with no special meaning. |
|
1076 |
|
1077 =over 4 |
|
1078 |
|
1079 =item Examples |
|
1080 |
|
1081 =item C<[^]-]> |
|
1082 |
|
1083 matches any single character other than a close square |
|
1084 bracket or a minus sign/dash. |
|
1085 |
|
1086 =item C<*bdc> |
|
1087 |
|
1088 matches any string that ends with the string "bdc" |
|
1089 including the string "bdc" (without quotes). |
|
1090 |
|
1091 =item C<[0-9a-zA-Z]> |
|
1092 |
|
1093 matches any single printable alphanumeric ASCII character. |
|
1094 |
|
1095 =item C<a??d> |
|
1096 |
|
1097 matches any four character string which begins |
|
1098 with a and ends with d. |
|
1099 |
|
1100 =back |
|
1101 |
|
1102 =back |
|
1103 |
|
1104 =head1 SEE ALSO |
|
1105 |
|
1106 L<Net::Cmd> |
|
1107 |
|
1108 =head1 AUTHOR |
|
1109 |
|
1110 Graham Barr <gbarr@pobox.com> |
|
1111 |
|
1112 =head1 COPYRIGHT |
|
1113 |
|
1114 Copyright (c) 1995-1997 Graham Barr. All rights reserved. |
|
1115 This program is free software; you can redistribute it and/or modify |
|
1116 it under the same terms as Perl itself. |
|
1117 |
|
1118 =for html <hr> |
|
1119 |
|
1120 I<$Id: //depot/libnet/Net/NNTP.pm#18 $> |
|
1121 |
|
1122 =cut |