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.
10 use vars qw(@ISA $VERSION $debug);
17 $VERSION = "2.21"; # $Id: //depot/libnet/Net/NNTP.pm#15 $
18 @ISA = qw(Net::Cmd IO::Socket::INET);
23 my $type = ref($self) || $self;
24 my $host = shift if @_ % 2;
28 $host ||= $ENV{NNTPSERVER} || $ENV{NEWSHOST};
30 my $hosts = defined $host ? [ $host ] : $NetConfig{nntp_hosts};
36 foreach $h (@{$hosts})
38 $obj = $type->SUPER::new(PeerAddr => ($host = $h),
39 PeerPort => $arg{Port} || 'nntp(119)',
41 Timeout => defined $arg{Timeout}
50 ${*$obj}{'net_nntp_host'} = $host;
53 $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
55 unless ($obj->response() == CMD_OK)
62 my @m = $obj->message;
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
69 # If reader suceeds the we need to consider this code to determine postok
74 # I want to ignore this failure, so restore the previous status.
75 $obj->set_status($c,\@m);
79 ${*$obj}{'net_nntp_post'} = $c == 200 ? 1 : 0;
90 if(($nntp->code == 350 && $text =~ /^(\S+)/)
91 || ($text =~ /^(authinfo\s+pass)/io))
101 @_ == 1 or croak 'usage: $nntp->postok()';
103 ${*$nntp}{'net_nntp_post'} || 0;
108 @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->article( [ MSGID ], [ FH ] )';
112 @fh = (pop) if @_ == 2 || (@_ && ref($_[0]) || ref(\$_[0]) eq 'GLOB');
115 ? $nntp->read_until_dot(@fh)
120 @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->articlefh( [ MSGID ] )';
123 return unless $nntp->_ARTICLE(@_);
124 return $nntp->tied_fh;
129 @_ == 3 or croak 'usage: $nntp->authinfo( USER, PASS )';
130 my($nntp,$user,$pass) = @_;
132 $nntp->_AUTHINFO("USER",$user) == CMD_MORE
133 && $nntp->_AUTHINFO("PASS",$pass) == CMD_OK;
138 @_ == 3 or croak 'usage: $nntp->authinfo( USER, PASS )';
139 my($nntp,$user,$pass) = @_;
141 $nntp->_AUTHINFO('SIMPLE') == CMD_MORE
142 && $nntp->command($user,$pass)->response == CMD_OK;
147 @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->body( [ MSGID ], [ FH ] )';
151 @fh = (pop) if @_ == 2 || (@_ && ref($_[0]) || ref(\$_[0]) eq 'GLOB');
154 ? $nntp->read_until_dot(@fh)
160 @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->bodyfh( [ MSGID ] )';
162 return unless $nntp->_BODY(@_);
163 return $nntp->tied_fh;
168 @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->head( [ MSGID ], [ FH ] )';
172 @fh = (pop) if @_ == 2 || (@_ && ref($_[0]) || ref(\$_[0]) eq 'GLOB');
175 ? $nntp->read_until_dot(@fh)
181 @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->headfh( [ MSGID ] )';
183 return unless $nntp->_HEAD(@_);
184 return $nntp->tied_fh;
189 @_ == 1 || @_ == 2 or croak 'usage: $nntp->nntpstat( [ MSGID ] )';
192 $nntp->_STAT(@_) && $nntp->message =~ /(<[^>]+>)/o
200 @_ == 1 || @_ == 2 or croak 'usage: $nntp->group( [ GROUP ] )';
202 my $grp = ${*$nntp}{'net_nntp_group'} || undef;
205 unless(@_ || wantarray);
209 return wantarray ? () : undef
210 unless $nntp->_GROUP($newgrp || $grp || "")
211 && $nntp->message =~ /(\d+)\s+(\d+)\s+(\d+)\s+(\S+)/;
213 my($count,$first,$last,$group) = ($1,$2,$3,$4);
215 # group may be replied as '(current group)'
216 $group = ${*$nntp}{'net_nntp_group'}
219 ${*$nntp}{'net_nntp_group'} = $group;
222 ? ($count,$first,$last,$group)
228 @_ == 1 or croak 'usage: $nntp->help()';
232 ? $nntp->read_until_dot
238 @_ >= 2 or croak 'usage: $nntp->ihave( MESSAGE-ID [, MESSAGE ])';
242 $nntp->_IHAVE($mid) && $nntp->datasend(@_)
243 ? @_ == 0 || $nntp->dataend
249 @_ == 1 or croak 'usage: $nntp->last()';
252 $nntp->_LAST && $nntp->message =~ /(<[^>]+>)/o
259 @_ == 1 or croak 'usage: $nntp->list()';
269 @_ >= 2 or croak 'usage: $nntp->newgroups( SINCE [, DISTRIBUTIONS ])';
271 my $time = _timestr(shift);
272 my $dist = shift || "";
274 $dist = join(",", @{$dist})
277 $nntp->_NEWGROUPS($time,$dist)
284 @_ >= 2 && @_ <= 4 or
285 croak 'usage: $nntp->newnews( SINCE [, GROUPS [, DISTRIBUTIONS ]])';
287 my $time = _timestr(shift);
288 my $grp = @_ ? shift : $nntp->group;
289 my $dist = shift || "";
292 $grp = join(",", @{$grp})
295 $dist = join(",", @{$dist})
298 $nntp->_NEWNEWS($grp,$time,$dist)
299 ? $nntp->_articlelist
305 @_ == 1 or croak 'usage: $nntp->next()';
308 $nntp->_NEXT && $nntp->message =~ /(<[^>]+>)/o
315 @_ >= 1 or croak 'usage: $nntp->post( [ MESSAGE ] )';
318 $nntp->_POST() && $nntp->datasend(@_)
319 ? @_ == 0 || $nntp->dataend
325 return unless $nntp->_POST();
326 return $nntp->tied_fh;
331 @_ == 1 or croak 'usage: $nntp->quit()';
340 @_ == 1 or croak 'usage: $nntp->slave()';
347 ## The following methods are not implemented by all servers
352 @_ == 1 || @_ == 2 or croak 'usage: $nntp->active( [ PATTERN ] )';
355 $nntp->_LIST('ACTIVE',@_)
362 @_ == 1 or croak 'usage: $nntp->active_times()';
365 $nntp->_LIST('ACTIVE.TIMES')
372 @_ == 1 or croak 'usage: $nntp->distributions()';
375 $nntp->_LIST('DISTRIBUTIONS')
376 ? $nntp->_description
380 sub distribution_patterns
382 @_ == 1 or croak 'usage: $nntp->distributions()';
388 $nntp->_LIST('DISTRIB.PATS') && ($arr = $nntp->read_until_dot)
389 ? [grep { /^\d/ && (chomp, $_ = [ split /:/ ]) } @$arr]
395 @_ == 1 || @_ == 2 or croak 'usage: $nntp->newsgroups( [ PATTERN ] )';
398 $nntp->_LIST('NEWSGROUPS',@_)
399 ? $nntp->_description
405 @_ == 1 or croak 'usage: $nntp->overview_fmt()';
408 $nntp->_LIST('OVERVIEW.FMT')
409 ? $nntp->_articlelist
415 @_ == 1 or croak 'usage: $nntp->subscriptions()';
418 $nntp->_LIST('SUBSCRIPTIONS')
419 ? $nntp->_articlelist
425 @_ == 1 || @_ == 2 or croak 'usage: $nntp->listgroup( [ GROUP ] )';
428 $nntp->_LISTGROUP(@_)
429 ? $nntp->_articlelist
435 @_ == 1 or croak 'usage: $nntp->reader()';
438 $nntp->_MODE('READER');
443 @_ == 1 || @_ == 2 or croak 'usage: $nntp->xgtitle( [ PATTERN ] )';
447 ? $nntp->_description
453 @_ >= 2 && @_ <= 4 or croak 'usage: $nntp->xhdr( HEADER, [ MESSAGE-SPEC ] )';
456 my $arg = _msg_arg(@_);
458 $nntp->_XHDR($hdr, $arg)
459 ? $nntp->_description
465 @_ == 2 || @_ == 3 or croak 'usage: $nntp->xover( MESSAGE-SPEC )';
467 my $arg = _msg_arg(@_);
476 @_ == 4 || @_ == 5 or croak '$nntp->xpat( HEADER, PATTERN, MESSAGE-SPEC )';
480 my $arg = _msg_arg(@_);
482 $pat = join(" ", @$pat)
485 $nntp->_XPAT($hdr,$arg,$pat)
486 ? $nntp->_description
492 @_ == 2 or croak 'usage: $nntp->xpath( MESSAGE-ID )';
496 unless $nntp->_XPATH($mid);
498 my $m; ($m = $nntp->message) =~ s/^\d+\s+//o;
499 my @p = split /\s+/, $m;
501 wantarray ? @p : $p[0];
506 @_ == 2 || @_ == 3 or croak 'usage: $nntp->xrover( MESSAGE-SPEC )';
508 my $arg = _msg_arg(@_);
511 ? $nntp->_description
517 @_ == 1 or croak 'usage: $nntp->date()';
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)
527 ## Private subroutines
537 carp "Depriciated passing of two message numbers, "
540 $spec = [ $spec, $_[0] ];
548 if(defined $spec->[1])
551 if $spec->[1] != $spec->[0];
553 if $spec->[1] > $spec->[0];
568 my @g = reverse((gmtime($time))[0..5]);
571 sprintf "%02d%02d%02d %02d%02d%02d GMT", @g;
577 my $arr = $nntp->read_until_dot or
585 my @a = split(/[\s\n]+/,$ln);
586 $hash->{$a[0]} = [ @a[1,2,3] ];
595 my $arr = $nntp->read_until_dot or
603 my @a = split(/[\t\n]/,$ln);
605 $hash->{$m} = [ @a ];
614 my $arr = $nntp->read_until_dot;
625 my $arr = $nntp->read_until_dot or
636 if $ln =~ s/^\s*(\S+)\s*//o;
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 }
683 defined(fileno($nntp)) && $nntp->quit
693 Net::NNTP - NNTP Client class
699 $nntp = Net::NNTP->new("some.host.name");
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>
711 =item new ( [ HOST ] [, OPTIONS ])
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.
719 C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
720 Possible options are:
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.
726 B<Debug> - Enable the printing of debugging information to STDERR
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.
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
745 =item article ( [ MSGID|MSGNUM ], [FH] )
747 Retrieve the header, a blank line, then the body (text) of the
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 sucess a true value will be
752 returned. If C<FH> is not specified then the return value, on sucess,
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.
756 If no arguments are passed then the current article in the currently
757 selected newsgroup is fetched.
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.
766 If there is an error then C<undef> will be returned.
768 =item body ( [ MSGID|MSGNUM ], [FH] )
770 Like C<article> but only fetches the body of the article.
772 =item head ( [ MSGID|MSGNUM ], [FH] )
774 Like C<article> but only fetches the headers for the article.
776 =item articlefh ( [ MSGID|MSGNUM ] )
778 =item bodyfh ( [ MSGID|MSGNUM ] )
780 =item headfh ( [ MSGID|MSGNUM ] )
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.
786 =item nntpstat ( [ MSGID|MSGNUM ] )
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
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".
797 Returns the message-id of the "current article".
799 =item group ( [ GROUP ] )
801 Set and/or get the current group. If C<GROUP> is not given then information
802 is returned on the current group.
804 In a scalar context it returns the group name.
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.
810 =item ihave ( MSGID [, MESSAGE ])
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.
816 Returns I<true> if the server desires the article and C<MESSAGE> was
817 successfully sent,if specified.
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>
822 C<MESSAGE> can be either an array of lines or a reference to an array.
826 Set the "current article pointer" to the previous article in the current
829 Returns the message-id of the article.
833 Returns the date on the remote server. This date will be in a UNIX time
834 format (seconds since 1970)
838 C<postok> will return I<true> if the servers initial response indicated
839 that it will allow posting.
841 =item authinfo ( USER, PASS )
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.
850 =item newgroups ( SINCE [, DISTRIBUTIONS ])
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>.
858 =item newnews ( SINCE [, GROUPS [, DISTRIBUTIONS ]])
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.
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>.
870 Set the "current article pointer" to the next article in the current
873 Returns the message-id of the article.
875 =item post ( [ MESSAGE ] )
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.
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>
883 C<MESSAGE> can be either an array of lines or a reference to an array.
887 Post a new article to the news server using a tied filehandle. If
888 posting is allowed, this method will return a tied filehandle that you
889 can print() the contents of the article to be posted. You must
890 explicitly close() the filehandle when you are finished posting the
891 article, and the return value from the close() call will indicate
892 whether the message was successfully posted.
896 Tell the remote server that I am not a user client, but probably another
901 Quit the remote server and close the socket connection.
905 =head2 Extension methods
907 These methods use commands that are not part of the RFC977 documentation. Some
908 servers may not support all of them.
912 =item newsgroups ( [ PATTERN ] )
914 Returns a reference to a hash where the keys are all the group names which
915 match C<PATTERN>, or all of the groups if no pattern is specified, and
916 each value contains the description text for the group.
918 =item distributions ()
920 Returns a reference to a hash where the keys are all the possible
921 distribution names and the values are the distribution descriptions.
923 =item subscriptions ()
925 Returns a reference to a list which contains a list of groups which
926 are recommended for a new user to subscribe to.
928 =item overview_fmt ()
930 Returns a reference to an array which contain the names of the fields returned
933 =item active_times ()
935 Returns a reference to a hash where the keys are the group names and each
936 value is a reference to an array containing the time the groups was created
937 and an identifier, possibly an Email address, of the creator.
939 =item active ( [ PATTERN ] )
941 Similar to C<list> but only active groups that match the pattern are returned.
942 C<PATTERN> can be a group pattern.
944 =item xgtitle ( PATTERN )
946 Returns a reference to a hash where the keys are all the group names which
947 match C<PATTERN> and each value is the description text for the group.
949 =item xhdr ( HEADER, MESSAGE-SPEC )
951 Obtain the header field C<HEADER> for all the messages specified.
953 The return value will be a reference
954 to a hash where the keys are the message numbers and each value contains
955 the text of the requested header for that message.
957 =item xover ( MESSAGE-SPEC )
959 The return value will be a reference
960 to a hash where the keys are the message numbers and each value contains
961 a reference to an array which contains the overview fields for that
964 The names of the fields can be obtained by calling C<overview_fmt>.
966 =item xpath ( MESSAGE-ID )
968 Returns the path name to the file on the server which contains the specified
971 =item xpat ( HEADER, PATTERN, MESSAGE-SPEC)
973 The result is the same as C<xhdr> except the is will be restricted to
974 headers where the text of the header matches C<PATTERN>
978 The XROVER command returns reference information for the article(s)
981 Returns a reference to a HASH where the keys are the message numbers and the
982 values are the References: lines from the articles
984 =item listgroup ( [ GROUP ] )
986 Returns a reference to a list of all the active messages in C<GROUP>, or
987 the current group if C<GROUP> is not specified.
991 Tell the server that you are a reader and not another server.
993 This is required by some servers. For example if you are connecting to
994 an INN server and you have transfer permission your connection will
995 be connected to the transfer daemon, not the NNTP daemon. Issuing
996 this command will cause the transfer daemon to hand over control
999 Some servers do not understand this command, but issuing it and ignoring
1000 the response is harmless.
1006 The following NNTP command are unsupported by the package, and there are
1020 C<MESSAGE-SPEC> is either a single message-id, a single message number, or
1021 a reference to a list of two message numbers.
1023 If C<MESSAGE-SPEC> is a reference to a list of two message numbers and the
1024 second number in a range is less than or equal to the first then the range
1025 represents all messages in the group after the first message number.
1027 B<NOTE> For compatibility reasons only with earlier versions of Net::NNTP
1028 a message spec can be passed as a list of two numbers, this is deprecated
1029 and a reference to the list should now be passed
1033 The C<NNTP> protocol uses the C<WILDMAT> format for patterns.
1034 The WILDMAT format was first developed by Rich Salz based on
1035 the format used in the UNIX "find" command to articulate
1036 file names. It was developed to provide a uniform mechanism
1037 for matching patterns in the same manner that the UNIX shell
1040 Patterns are implicitly anchored at the
1041 beginning and end of each string when testing for a match.
1043 There are five pattern matching operations other than a strict
1044 one-to-one match between the pattern and the source to be
1045 checked for a match.
1047 The first is an asterisk C<*> to match any sequence of zero or more
1050 The second is a question mark C<?> to match any single character. The
1051 third specifies a specific set of characters.
1053 The set is specified as a list of characters, or as a range of characters
1054 where the beginning and end of the range are separated by a minus (or dash)
1055 character, or as any combination of lists and ranges. The dash can
1056 also be included in the set as a character it if is the beginning
1057 or end of the set. This set is enclosed in square brackets. The
1058 close square bracket C<]> may be used in a set if it is the first
1059 character in the set.
1061 The fourth operation is the same as the
1062 logical not of the third operation and is specified the same
1063 way as the third with the addition of a caret character C<^> at
1064 the beginning of the test string just inside the open square
1067 The final operation uses the backslash character to
1068 invalidate the special meaning of an open square bracket C<[>,
1069 the asterisk, backslash or the question mark. Two backslashes in
1070 sequence will result in the evaluation of the backslash as a
1071 character with no special meaning.
1079 matches any single character other than a close square
1080 bracket or a minus sign/dash.
1084 matches any string that ends with the string "bdc"
1085 including the string "bdc" (without quotes).
1087 =item C<[0-9a-zA-Z]>
1089 matches any single printable alphanumeric ASCII character.
1093 matches any four character string which begins
1094 with a and ends with d.
1106 Graham Barr <gbarr@pobox.com>
1110 Copyright (c) 1995-1997 Graham Barr. All rights reserved.
1111 This program is free software; you can redistribute it and/or modify
1112 it under the same terms as Perl itself.
1116 I<$Id: //depot/libnet/Net/NNTP.pm#15 $>