# Net::NNTP.pm
#
-# Copyright (c) 1995 Graham Barr <Graham.Barr@tiuk.ti.com>. All rights
-# reserved. This program is free software; you can redistribute it and/or
+# Copyright (c) 1995-1997 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
package Net::NNTP;
-=head1 NAME
-
-Net::NNTP - NNTP Client class
+use strict;
+use vars qw(@ISA $VERSION $debug);
+use IO::Socket;
+use Net::Cmd;
+use Carp;
+use Time::Local;
+use Net::Config;
-=head1 SYNOPSIS
+$VERSION = "2.20"; # $Id: //depot/libnet/Net/NNTP.pm#14 $
+@ISA = qw(Net::Cmd IO::Socket::INET);
- use Net::NNTP;
-
- $nntp = Net::NNTP->new("some.host.name");
- $nntp->quit;
+sub new
+{
+ my $self = shift;
+ my $type = ref($self) || $self;
+ my $host = shift if @_ % 2;
+ my %arg = @_;
+ my $obj;
-=head1 DESCRIPTION
+ $host ||= $ENV{NNTPSERVER} || $ENV{NEWSHOST};
-C<Net::NNTP> is a class implementing a simple NNTP client in Perl as described
-in RFC977. C<Net::NNTP> inherits its communication methods from C<Net::Cmd>
+ my $hosts = defined $host ? [ $host ] : $NetConfig{nntp_hosts};
-=head1 CONSTRUCTOR
+ @{$hosts} = qw(news)
+ unless @{$hosts};
-=over 4
+ my $h;
+ foreach $h (@{$hosts})
+ {
+ $obj = $type->SUPER::new(PeerAddr => ($host = $h),
+ PeerPort => $arg{Port} || 'nntp(119)',
+ Proto => 'tcp',
+ Timeout => defined $arg{Timeout}
+ ? $arg{Timeout}
+ : 120
+ ) and last;
+ }
-=item new ( [ HOST ] [, OPTIONS ])
+ return undef
+ unless defined $obj;
-This is the constructor for a new Net::NNTP object. C<HOST> is the
-name of the remote host to which a NNTP connection is required. If not
-given two environment variables are checked, first C<NNTPSERVER> then
-C<NEWSHOST>, if neither are set C<news> is used.
+ ${*$obj}{'net_nntp_host'} = $host;
-C<OPTIONS> are passed in a hash like fasion, using key and value pairs.
-Possible options are:
+ $obj->autoflush(1);
+ $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
-B<Timeout> - Maximum time, in seconds, to wait for a response from the
-NNTP server, a value of zero will cause all IO operations to block.
-(default: 120)
+ unless ($obj->response() == CMD_OK)
+ {
+ $obj->close;
+ return undef;
+ }
-B<Debug> - Enable the printing of debugging information to STDERR
+ my $c = $obj->code;
+ my @m = $obj->message;
+
+ unless(exists $arg{Reader} && $arg{Reader} == 0) {
+ # if server is INN and we have transfer rights the we are currently
+ # talking to innd not nnrpd
+ if($obj->reader)
+ {
+ # If reader suceeds the we need to consider this code to determine postok
+ $c = $obj->code;
+ }
+ else
+ {
+ # I want to ignore this failure, so restore the previous status.
+ $obj->set_status($c,\@m);
+ }
+ }
+
+ ${*$obj}{'net_nntp_post'} = $c == 200 ? 1 : 0;
-=back
+ $obj;
+}
-=head1 METHODS
+sub debug_text
+{
+ my $nntp = shift;
+ my $inout = shift;
+ my $text = shift;
-Unless otherwise stated all methods return either a I<true> or I<false>
-value, with I<true> meaning that the operation was a success. When a method
-states that it returns a value, falure will be returned as I<undef> or an
-empty list.
+ if(($nntp->code == 350 && $text =~ /^(\S+)/)
+ || ($text =~ /^(authinfo\s+pass)/io))
+ {
+ $text = "$1 ....\n"
+ }
-=over 4
+ $text;
+}
-=item article ( [ MSGID|MSGNUM ] )
+sub postok
+{
+ @_ == 1 or croak 'usage: $nntp->postok()';
+ my $nntp = shift;
+ ${*$nntp}{'net_nntp_post'} || 0;
+}
-Retreive the header, a blank line, then the body (text) of the
-specified article.
+sub article
+{
+ @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->article( [ MSGID ], [ FH ] )';
+ my $nntp = shift;
+ my @fh;
-If no arguments are passed then the current aricle in the current
-newsgroup is returned.
+ @fh = (pop) if @_ == 2 || (@_ && ref($_[0]) || ref(\$_[0]) eq 'GLOB');
-C<MSGNUM> is a numeric id of an article in the
-current newsgroup, and will change the current article pointer.
-C<MSGID> is the message id of an article as
-shown in that article's header. It is anticipated that the client
-will obtain the C<MSGID> from a list provided by the C<newnews>
-command, from references contained within another article, or from
-the message-id provided in the response to some other commands.
+ $nntp->_ARTICLE(@_)
+ ? $nntp->read_until_dot(@fh)
+ : undef;
+}
-Returns a reference to an array containing the article.
+sub authinfo
+{
+ @_ == 3 or croak 'usage: $nntp->authinfo( USER, PASS )';
+ my($nntp,$user,$pass) = @_;
-=item body ( [ MSGID|MSGNUM ] )
+ $nntp->_AUTHINFO("USER",$user) == CMD_MORE
+ && $nntp->_AUTHINFO("PASS",$pass) == CMD_OK;
+}
-Retreive the body (text) of the specified article.
+sub authinfo_simple
+{
+ @_ == 3 or croak 'usage: $nntp->authinfo( USER, PASS )';
+ my($nntp,$user,$pass) = @_;
-Takes the same arguments as C<article>
+ $nntp->_AUTHINFO('SIMPLE') == CMD_MORE
+ && $nntp->command($user,$pass)->response == CMD_OK;
+}
-Returns a reference to an array containing the body of the article.
+sub body
+{
+ @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->body( [ MSGID ], [ FH ] )';
+ my $nntp = shift;
+ my @fh;
-=item head ( [ MSGID|MSGNUM ] )
+ @fh = (pop) if @_ == 2 || (@_ && ref($_[0]) || ref(\$_[0]) eq 'GLOB');
-Retreive the header of the specified article.
+ $nntp->_BODY(@_)
+ ? $nntp->read_until_dot(@fh)
+ : undef;
+}
-Takes the same arguments as C<article>
+sub head
+{
+ @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->head( [ MSGID ], [ FH ] )';
+ my $nntp = shift;
+ my @fh;
-Returns a reference to an array containing the header of the article.
+ @fh = (pop) if @_ == 2 || (@_ && ref($_[0]) || ref(\$_[0]) eq 'GLOB');
-=item nntpstat ( [ MSGID|MSGNUM ] )
+ $nntp->_HEAD(@_)
+ ? $nntp->read_until_dot(@fh)
+ : undef;
+}
-The C<nntpstat> command is similar to the C<article> command except that no
-text is returned. When selecting by message number within a group,
-the C<nntpstat> command serves to set the "current article pointer" without
-sending text.
+sub nntpstat
+{
+ @_ == 1 || @_ == 2 or croak 'usage: $nntp->nntpstat( [ MSGID ] )';
+ my $nntp = shift;
-Using the C<nntpstat> command to
-select by message-id is valid but of questionable value, since a
-selection by message-id does B<not> alter the "current article pointer".
+ $nntp->_STAT(@_) && $nntp->message =~ /(<[^>]+>)/o
+ ? $1
+ : undef;
+}
-Returns the message-id of the "current article".
-=item group ( [ GROUP ] )
+sub group
+{
+ @_ == 1 || @_ == 2 or croak 'usage: $nntp->group( [ GROUP ] )';
+ my $nntp = shift;
+ my $grp = ${*$nntp}{'net_nntp_group'} || undef;
-Set and/or get the current group. If C<GROUP> is not given then information
-is returned on the current group.
+ return $grp
+ unless(@_ || wantarray);
-In a scalar context it returns the group name.
+ my $newgrp = shift;
-In an array context the return value is a list containing, the number
-of articles in the group, the number of the first article, the number
-of the last article and the group name.
+ return wantarray ? () : undef
+ unless $nntp->_GROUP($newgrp || $grp || "")
+ && $nntp->message =~ /(\d+)\s+(\d+)\s+(\d+)\s+(\S+)/;
-=item ihave ( MSGID [, MESSAGE ])
+ my($count,$first,$last,$group) = ($1,$2,$3,$4);
-The C<ihave> command informs the server that the client has an article
-whose id is C<MSGID>. If the server desires a copy of that
-article, and C<MESSAGE> has been given the it will be sent.
+ # group may be replied as '(current group)'
+ $group = ${*$nntp}{'net_nntp_group'}
+ if $group =~ /\(/;
-Returns I<true> if the server desires the article and C<MESSAGE> was
-successfully sent,if specified.
+ ${*$nntp}{'net_nntp_group'} = $group;
-If C<MESSAGE> is not specified then the message must be sent using the
-C<datasend> and C<dataend> methods from L<Net::Cmd>
+ wantarray
+ ? ($count,$first,$last,$group)
+ : $group;
+}
-C<MESSAGE> can be either an array of lines or a reference to an array.
+sub help
+{
+ @_ == 1 or croak 'usage: $nntp->help()';
+ my $nntp = shift;
-=item last ()
+ $nntp->_HELP
+ ? $nntp->read_until_dot
+ : undef;
+}
-Set the "current article pointer" to the previous article in the current
-newsgroup.
+sub ihave
+{
+ @_ >= 2 or croak 'usage: $nntp->ihave( MESSAGE-ID [, MESSAGE ])';
+ my $nntp = shift;
+ my $mid = shift;
-Returns the message-id of the article.
+ $nntp->_IHAVE($mid) && $nntp->datasend(@_)
+ ? @_ == 0 || $nntp->dataend
+ : undef;
+}
-=item date ()
+sub last
+{
+ @_ == 1 or croak 'usage: $nntp->last()';
+ my $nntp = shift;
-Returns the date on the remote server. This date will be in a UNIX time
-format (seconds since 1970)
+ $nntp->_LAST && $nntp->message =~ /(<[^>]+>)/o
+ ? $1
+ : undef;
+}
-=item postok ()
+sub list
+{
+ @_ == 1 or croak 'usage: $nntp->list()';
+ my $nntp = shift;
-C<postok> will return I<true> if the servers initial response indicated
-that it will allow posting.
+ $nntp->_LIST
+ ? $nntp->_grouplist
+ : undef;
+}
-=item authinfo ( USER, PASS )
+sub newgroups
+{
+ @_ >= 2 or croak 'usage: $nntp->newgroups( SINCE [, DISTRIBUTIONS ])';
+ my $nntp = shift;
+ my $time = _timestr(shift);
+ my $dist = shift || "";
-=item list ()
+ $dist = join(",", @{$dist})
+ if ref($dist);
-Obtain information about all the active newsgroups. The results is a reference
-to a hash where the key is a group name and each value is a reference to an
-array. The elements in this array are:- the first article number in the group,
-the last article number in the group and any information flags about the group.
+ $nntp->_NEWGROUPS($time,$dist)
+ ? $nntp->_grouplist
+ : undef;
+}
-=item newgroups ( SINCE [, DISTRIBUTIONS ])
+sub newnews
+{
+ @_ >= 2 && @_ <= 4 or
+ croak 'usage: $nntp->newnews( SINCE [, GROUPS [, DISTRIBUTIONS ]])';
+ my $nntp = shift;
+ my $time = _timestr(shift);
+ my $grp = @_ ? shift : $nntp->group;
+ my $dist = shift || "";
-C<SINCE> is a time value and C<DISTRIBUTIONS> is either a distribution
-pattern or a reference to a list of distribution patterns.
-The result is the same as C<list>, but the
-groups return will be limited to those created after C<SINCE> and, if
-specified, in one of the distribution areas in C<DISTRIBUTIONS>.
+ $grp ||= "*";
+ $grp = join(",", @{$grp})
+ if ref($grp);
-=item newnews ( SINCE [, GROUPS [, DISTRIBUTIONS ]])
+ $dist = join(",", @{$dist})
+ if ref($dist);
-C<SINCE> is a time value. C<GROUPS> is either a group pattern or a reference
-to a list of group patterns. C<DISTRIBUTIONS> is either a distribution
-pattern or a reference to a list of distribution patterns.
+ $nntp->_NEWNEWS($grp,$time,$dist)
+ ? $nntp->_articlelist
+ : undef;
+}
-Returns a reference to a list which contains the message-ids of all news posted
-after C<SINCE>, that are in a groups which matched C<GROUPS> and a
-distribution which matches C<DISTRIBUTIONS>.
+sub next
+{
+ @_ == 1 or croak 'usage: $nntp->next()';
+ my $nntp = shift;
-=item next ()
+ $nntp->_NEXT && $nntp->message =~ /(<[^>]+>)/o
+ ? $1
+ : undef;
+}
-Set the "current article pointer" to the next article in the current
-newsgroup.
-
-Returns the message-id of the article.
+sub post
+{
+ @_ >= 1 or croak 'usage: $nntp->post( [ MESSAGE ] )';
+ my $nntp = shift;
-=item post ( [ MESSAGE ] )
+ $nntp->_POST() && $nntp->datasend(@_)
+ ? @_ == 0 || $nntp->dataend
+ : undef;
+}
-Post a new article to the news server. If C<MESSAGE> is specified and posting
-is allowed then the message will be sent.
+sub quit
+{
+ @_ == 1 or croak 'usage: $nntp->quit()';
+ my $nntp = shift;
-If C<MESSAGE> is not specified then the message must be sent using the
-C<datasend> and C<dataend> methods from L<Net::Cmd>
+ $nntp->_QUIT;
+ $nntp->close;
+}
-C<MESSAGE> can be either an array of lines or a reference to an array.
+sub slave
+{
+ @_ == 1 or croak 'usage: $nntp->slave()';
+ my $nntp = shift;
-=item slave ()
+ $nntp->_SLAVE;
+}
-Tell the remote server that I am not a user client, but probably another
-news server.
+##
+## The following methods are not implemented by all servers
+##
-=item quit ()
+sub active
+{
+ @_ == 1 || @_ == 2 or croak 'usage: $nntp->active( [ PATTERN ] )';
+ my $nntp = shift;
-Quit the remote server and close the socket connection.
+ $nntp->_LIST('ACTIVE',@_)
+ ? $nntp->_grouplist
+ : undef;
+}
-=back
+sub active_times
+{
+ @_ == 1 or croak 'usage: $nntp->active_times()';
+ my $nntp = shift;
-=head2 Extension methods
+ $nntp->_LIST('ACTIVE.TIMES')
+ ? $nntp->_grouplist
+ : undef;
+}
-These methods use commands that are not part of the RFC977 documentation. Some
-servers may not support all of them.
+sub distributions
+{
+ @_ == 1 or croak 'usage: $nntp->distributions()';
+ my $nntp = shift;
-=over 4
+ $nntp->_LIST('DISTRIBUTIONS')
+ ? $nntp->_description
+ : undef;
+}
-=item newsgroups ( [ PATTERN ] )
+sub distribution_patterns
+{
+ @_ == 1 or croak 'usage: $nntp->distributions()';
+ my $nntp = shift;
-Returns a reference to a hash where the keys are all the group names which
-match C<PATTERN>, or all of the groups if no pattern is specified, and
-each value contains the description text for the group.
+ my $arr;
+ local $_;
-=item distributions ()
+ $nntp->_LIST('DISTRIB.PATS') && ($arr = $nntp->read_until_dot)
+ ? [grep { /^\d/ && (chomp, $_ = [ split /:/ ]) } @$arr]
+ : undef;
+}
-Returns a reference to a hash where the keys are all the possible
-distribution names and the values are the distribution descriptions.
+sub newsgroups
+{
+ @_ == 1 || @_ == 2 or croak 'usage: $nntp->newsgroups( [ PATTERN ] )';
+ my $nntp = shift;
-=item subscriptions ()
+ $nntp->_LIST('NEWSGROUPS',@_)
+ ? $nntp->_description
+ : undef;
+}
-Returns a reference to a list which contains a list of groups which
-are reccomended for a new user to subscribe to.
+sub overview_fmt
+{
+ @_ == 1 or croak 'usage: $nntp->overview_fmt()';
+ my $nntp = shift;
-=item overview_fmt ()
+ $nntp->_LIST('OVERVIEW.FMT')
+ ? $nntp->_articlelist
+ : undef;
+}
-Returns a reference to an array which contain the names of the fields returnd
-by C<xover>.
+sub subscriptions
+{
+ @_ == 1 or croak 'usage: $nntp->subscriptions()';
+ my $nntp = shift;
-=item active_times ()
+ $nntp->_LIST('SUBSCRIPTIONS')
+ ? $nntp->_articlelist
+ : undef;
+}
-Returns a reference to a hash where the keys are the group names and each
-value is a reference to an array containg the time the groups was created
-and an identifier, possibly an Email address, of the creator.
+sub listgroup
+{
+ @_ == 1 || @_ == 2 or croak 'usage: $nntp->listgroup( [ GROUP ] )';
+ my $nntp = shift;
-=item active ( [ PATTERN ] )
+ $nntp->_LISTGROUP(@_)
+ ? $nntp->_articlelist
+ : undef;
+}
-Similar to C<list> but only active groups that match the pattern are returned.
-C<PATTERN> can be a group pattern.
+sub reader
+{
+ @_ == 1 or croak 'usage: $nntp->reader()';
+ my $nntp = shift;
-=item xgtitle ( PATTERN )
+ $nntp->_MODE('READER');
+}
-Returns a reference to a hash where the keys are all the group names which
-match C<PATTERN> and each value is the description text for the group.
+sub xgtitle
+{
+ @_ == 1 || @_ == 2 or croak 'usage: $nntp->xgtitle( [ PATTERN ] )';
+ my $nntp = shift;
-=item xhdr ( HEADER, MESSAGE-RANGE )
+ $nntp->_XGTITLE(@_)
+ ? $nntp->_description
+ : undef;
+}
-Obtain the header field C<HEADER> for all the messages specified.
+sub xhdr
+{
+ @_ >= 2 && @_ <= 4 or croak 'usage: $nntp->xhdr( HEADER, [ MESSAGE-SPEC ] )';
+ my $nntp = shift;
+ my $hdr = shift;
+ my $arg = _msg_arg(@_);
-Returns a reference to a hash where the keys are the message numbers and
-each value contains the header for that message.
+ $nntp->_XHDR($hdr, $arg)
+ ? $nntp->_description
+ : undef;
+}
-=item xover ( MESSAGE-RANGE )
+sub xover
+{
+ @_ == 2 || @_ == 3 or croak 'usage: $nntp->xover( MESSAGE-SPEC )';
+ my $nntp = shift;
+ my $arg = _msg_arg(@_);
-Returns a reference to a hash where the keys are the message numbers and each
-value is a reference to an array which contains the overview fields for that
-message. The names of these fields can be obtained by calling C<overview_fmt>.
+ $nntp->_XOVER($arg)
+ ? $nntp->_fieldlist
+ : undef;
+}
-=item xpath ( MESSAGE-ID )
+sub xpat
+{
+ @_ == 4 || @_ == 5 or croak '$nntp->xpat( HEADER, PATTERN, MESSAGE-SPEC )';
+ my $nntp = shift;
+ my $hdr = shift;
+ my $pat = shift;
+ my $arg = _msg_arg(@_);
-Returns the path name to the file on the server which contains the specified
-message.
+ $pat = join(" ", @$pat)
+ if ref($pat);
-=item xpat ( HEADER, PATTERN, MESSAGE-RANGE)
+ $nntp->_XPAT($hdr,$arg,$pat)
+ ? $nntp->_description
+ : undef;
+}
-The result is the same as C<xhdr> except the is will be restricted to
-headers that match C<PATTERN>
+sub xpath
+{
+ @_ == 2 or croak 'usage: $nntp->xpath( MESSAGE-ID )';
+ my($nntp,$mid) = @_;
-=item xrover
+ return undef
+ unless $nntp->_XPATH($mid);
-=item listgroup
+ my $m; ($m = $nntp->message) =~ s/^\d+\s+//o;
+ my @p = split /\s+/, $m;
-=item reader
+ wantarray ? @p : $p[0];
+}
-=back
+sub xrover
+{
+ @_ == 2 || @_ == 3 or croak 'usage: $nntp->xrover( MESSAGE-SPEC )';
+ my $nntp = shift;
+ my $arg = _msg_arg(@_);
-=head1 UNSUPPORTED
+ $nntp->_XROVER($arg)
+ ? $nntp->_description
+ : undef;
+}
-The following NNTP command are unsupported by the package, and there are
-no plans to do so.
+sub date
+{
+ @_ == 1 or croak 'usage: $nntp->date()';
+ my $nntp = shift;
- AUTHINFO GENERIC
- XTHREAD
- XSEARCH
- XINDEX
+ $nntp->_DATE && $nntp->message =~ /(\d{4})(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/
+ ? timegm($6,$5,$4,$3,$2-1,$1 - 1900)
+ : undef;
+}
-=head1 DEFINITIONS
-=over 4
+##
+## Private subroutines
+##
-=item MESSAGE-RANGE
+sub _msg_arg
+{
+ my $spec = shift;
+ my $arg = "";
-C<MESSAGE-RANGE> is either a single message-id, a single mesage number, or
-two message numbers.
+ if(@_)
+ {
+ carp "Depriciated passing of two message numbers, "
+ . "pass a reference"
+ if $^W;
+ $spec = [ $spec, $_[0] ];
+ }
-If C<MESSAGE-RANGE> is two message numbers and the second number in a
-range is less than or equal to the first then the range represents all
-messages in the group after the first message number.
+ if(defined $spec)
+ {
+ if(ref($spec))
+ {
+ $arg = $spec->[0];
+ if(defined $spec->[1])
+ {
+ $arg .= "-"
+ if $spec->[1] != $spec->[0];
+ $arg .= $spec->[1]
+ if $spec->[1] > $spec->[0];
+ }
+ }
+ else
+ {
+ $arg = $spec;
+ }
+ }
-=item PATTERN
+ $arg;
+}
-The C<NNTP> protocol uses the C<WILDMAT> format for patterns.
-The WILDMAT format was first developed by Rich Salz based on
-the format used in the UNIX "find" command to articulate
-file names. It was developed to provide a uniform mechanism
-for matching patterns in the same manner that the UNIX shell
-matches filenames.
+sub _timestr
+{
+ my $time = shift;
+ my @g = reverse((gmtime($time))[0..5]);
+ $g[1] += 1;
+ $g[0] %= 100;
+ sprintf "%02d%02d%02d %02d%02d%02d GMT", @g;
+}
-Patterns are implicitly anchored at the
-beginning and end of each string when testing for a match.
+sub _grouplist
+{
+ my $nntp = shift;
+ my $arr = $nntp->read_until_dot or
+ return undef;
-There are five pattern matching operations other than a strict
-one-to-one match between the pattern and the source to be
-checked for a match.
+ my $hash = {};
+ my $ln;
-The first is an asterisk C<*> to match any sequence of zero or more
-characters.
+ foreach $ln (@$arr)
+ {
+ my @a = split(/[\s\n]+/,$ln);
+ $hash->{$a[0]} = [ @a[1,2,3] ];
+ }
-The second is a question mark C<?> to match any single character. The
-third specifies a specific set of characters.
+ $hash;
+}
-The set is specified as a list of characters, or as a range of characters
-where the beginning and end of the range are separated by a minus (or dash)
-character, or as any combination of lists and ranges. The dash can
-also be included in the set as a character it if is the beginning
-or end of the set. This set is enclosed in square brackets. The
-close square bracket C<]> may be used in a set if it is the first
-character in the set.
+sub _fieldlist
+{
+ my $nntp = shift;
+ my $arr = $nntp->read_until_dot or
+ return undef;
-The fourth operation is the same as the
-logical not of the third operation and is specified the same
-way as the third with the addition of a caret character C<^> at
-the beginning of the test string just inside the open square
-bracket.
+ my $hash = {};
+ my $ln;
-The final operation uses the backslash character to
-invalidate the special meaning of the a open square bracket C<[>,
-the asterisk, backslash or the question mark. Two backslashes in
-sequence will result in the evaluation of the backslash as a
-character with no special meaning.
+ foreach $ln (@$arr)
+ {
+ my @a = split(/[\t\n]/,$ln);
+ my $m = shift @a;
+ $hash->{$m} = [ @a ];
+ }
-=over 4
+ $hash;
+}
-=item Examples
+sub _articlelist
+{
+ my $nntp = shift;
+ my $arr = $nntp->read_until_dot;
-=item C<[^]-]>
+ chomp(@$arr)
+ if $arr;
-matches any single character other than a close square
-bracket or a minus sign/dash.
+ $arr;
+}
-=item C<*bdc>
+sub _description
+{
+ my $nntp = shift;
+ my $arr = $nntp->read_until_dot or
+ return undef;
-matches any string that ends with the string "bdc"
-including the string "bdc" (without quotes).
+ my $hash = {};
+ my $ln;
-=item C<[0-9a-zA-Z]>
+ foreach $ln (@$arr)
+ {
+ chomp($ln);
-matches any single printable alphanumeric ASCII character.
+ $hash->{$1} = $ln
+ if $ln =~ s/^\s*(\S+)\s*//o;
+ }
-=item C<a??d>
+ $hash;
-matches any four character string which begins
-with a and ends with d.
+}
-=back
+##
+## The commands
+##
-=back
+sub _ARTICLE { shift->command('ARTICLE',@_)->response == CMD_OK }
+sub _AUTHINFO { shift->command('AUTHINFO',@_)->response }
+sub _BODY { shift->command('BODY',@_)->response == CMD_OK }
+sub _DATE { shift->command('DATE')->response == CMD_INFO }
+sub _GROUP { shift->command('GROUP',@_)->response == CMD_OK }
+sub _HEAD { shift->command('HEAD',@_)->response == CMD_OK }
+sub _HELP { shift->command('HELP',@_)->response == CMD_INFO }
+sub _IHAVE { shift->command('IHAVE',@_)->response == CMD_MORE }
+sub _LAST { shift->command('LAST')->response == CMD_OK }
+sub _LIST { shift->command('LIST',@_)->response == CMD_OK }
+sub _LISTGROUP { shift->command('LISTGROUP',@_)->response == CMD_OK }
+sub _NEWGROUPS { shift->command('NEWGROUPS',@_)->response == CMD_OK }
+sub _NEWNEWS { shift->command('NEWNEWS',@_)->response == CMD_OK }
+sub _NEXT { shift->command('NEXT')->response == CMD_OK }
+sub _POST { shift->command('POST',@_)->response == CMD_MORE }
+sub _QUIT { shift->command('QUIT',@_)->response == CMD_OK }
+sub _SLAVE { shift->command('SLAVE',@_)->response == CMD_OK }
+sub _STAT { shift->command('STAT',@_)->response == CMD_OK }
+sub _MODE { shift->command('MODE',@_)->response == CMD_OK }
+sub _XGTITLE { shift->command('XGTITLE',@_)->response == CMD_OK }
+sub _XHDR { shift->command('XHDR',@_)->response == CMD_OK }
+sub _XPAT { shift->command('XPAT',@_)->response == CMD_OK }
+sub _XPATH { shift->command('XPATH',@_)->response == CMD_OK }
+sub _XOVER { shift->command('XOVER',@_)->response == CMD_OK }
+sub _XROVER { shift->command('XROVER',@_)->response == CMD_OK }
+sub _XTHREAD { shift->unsupported }
+sub _XSEARCH { shift->unsupported }
+sub _XINDEX { shift->unsupported }
-=head1 SEE ALSO
+##
+## IO/perl methods
+##
-L<Net::Cmd>
+sub DESTROY
+{
+ my $nntp = shift;
+ defined(fileno($nntp)) && $nntp->quit
+}
-=head1 AUTHOR
-Graham Barr <Graham.Barr@tiuk.ti.com>
+1;
-=head1 REVISION
+__END__
-$Revision: 2.5 $
+=head1 NAME
-=head1 COPYRIGHT
+Net::NNTP - NNTP Client class
-Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
-software; you can redistribute it and/or modify it under the same terms
-as Perl itself.
+=head1 SYNOPSIS
-=cut
+ use Net::NNTP;
-use strict;
-use vars qw(@ISA $VERSION $debug);
-use IO::Socket;
-use Net::Cmd;
-use Carp;
+ $nntp = Net::NNTP->new("some.host.name");
+ $nntp->quit;
-$VERSION = sprintf("%d.%02d", q$Revision: 2.5 $ =~ /(\d+)\.(\d+)/);
-@ISA = qw(Net::Cmd IO::Socket::INET);
+=head1 DESCRIPTION
-sub new
-{
- my $self = shift;
- my $type = ref($self) || $self;
- my $host = shift if @_ % 2;
- my %arg = @_;
+C<Net::NNTP> is a class implementing a simple NNTP client in Perl as described
+in RFC977. C<Net::NNTP> inherits its communication methods from C<Net::Cmd>
- $host ||= $ENV{NNTPSERVER} || $ENV{NEWSHOST} || "news";
+=head1 CONSTRUCTOR
- my $obj = $type->SUPER::new(PeerAddr => $host,
- PeerPort => $arg{Port} || 'nntp(119)',
- Proto => 'tcp',
- Timeout => defined $arg{Timeout}
- ? $arg{Timeout}
- : 120
- ) or return undef;
+=over 4
- ${*$obj}{'net_nntp_host'} = $host;
+=item new ( [ HOST ] [, OPTIONS ])
- $obj->autoflush(1);
- $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
+This is the constructor for a new Net::NNTP object. C<HOST> is the
+name of the remote host to which a NNTP connection is required. If not
+given two environment variables are checked, first C<NNTPSERVER> then
+C<NEWSHOST>, then C<Net::Config> is checked, and if a host is not found
+then C<news> is used.
- unless ($obj->response() == CMD_OK)
- {
- $obj->close();
- return undef;
- }
+C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
+Possible options are:
- my $c = $obj->code;
- ${*$obj}{'net_nntp_post'} = $c >= 200 && $c <= 209 ? 1 : 0;
+B<Timeout> - Maximum time, in seconds, to wait for a response from the
+NNTP server, a value of zero will cause all IO operations to block.
+(default: 120)
- $obj;
-}
+B<Debug> - Enable the printing of debugging information to STDERR
-sub debug_text
-{
- my $nntp = shift;
- my $inout = shift;
- my $text = shift;
+B<Reader> - If the remote server is INN then initially the connection
+will be to nnrpd, by default C<Net::NNTP> will issue a C<MODE READER> command
+so that the remote server becomes innd. If the C<Reader> option is given
+with a value of zero, then this command will not be sent and the
+connection will be left talking to nnrpd.
- if(($nntp->code == 350 && $text =~ /^(\S+)/)
- || ($text =~ /^(authinfo\s+pass)/io))
- {
- $text = "$1 ....\n"
- }
+=back
- $text;
-}
+=head1 METHODS
-sub postok
-{
- @_ == 1 or croak 'usage: $nntp->postok()';
- my $nntp = shift;
- ${*$nntp}{'net_nntp_post'} || 0;
-}
+Unless otherwise stated all methods return either a I<true> or I<false>
+value, with I<true> meaning that the operation was a success. When a method
+states that it returns a value, failure will be returned as I<undef> or an
+empty list.
-sub article
-{
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->article( MSGID )';
- my $nntp = shift;
+=over 4
- $nntp->_ARTICLE(@_)
- ? $nntp->read_until_dot()
- : undef;
-}
+=item article ( [ MSGID|MSGNUM ], [FH] )
-sub authinfo
-{
- @_ == 3 or croak 'usage: $nntp->authinfo( USER, PASS )';
- my($nntp,$user,$pass) = @_;
+Retrieve the header, a blank line, then the body (text) of the
+specified article.
- $nntp->_AUTHINFO("USER",$user) == CMD_MORE
- && $nntp->_AUTHINFO("PASS",$pass) == CMD_OK;
-}
+If C<FH> is specified then it is expected to be a valid filehandle
+and the result will be printed to it, on sucess a true value will be
+returned. If C<FH> is not specified then the return value, on sucess,
+will be a reference to an array containg the article requested, each
+entry in the array will contain one line of the article.
-sub authinfo_simple
-{
- @_ == 3 or croak 'usage: $nntp->authinfo( USER, PASS )';
- my($nntp,$user,$pass) = @_;
+If no arguments are passed then the current article in the currently
+selected newsgroup is fetched.
- $nntp->_AUTHINFO('SIMPLE') == CMD_MORE
- && $nntp->command($user,$pass)->response == CMD_OK;
-}
+C<MSGNUM> is a numeric id of an article in the current newsgroup, and
+will change the current article pointer. C<MSGID> is the message id of
+an article as shown in that article's header. It is anticipated that the
+client will obtain the C<MSGID> from a list provided by the C<newnews>
+command, from references contained within another article, or from the
+message-id provided in the response to some other commands.
-sub body
-{
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->body( [ MSGID ] )';
- my $nntp = shift;
+If there is an error then C<undef> will be returned.
- $nntp->_BODY(@_)
- ? $nntp->read_until_dot()
- : undef;
-}
+=item body ( [ MSGID|MSGNUM ], [FH] )
-sub head
-{
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->head( [ MSGID ] )';
- my $nntp = shift;
+Like C<article> but only fetches the body of the article.
- $nntp->_HEAD(@_)
- ? $nntp->read_until_dot()
- : undef;
-}
+=item head ( [ MSGID|MSGNUM ], [FH] )
-sub nntpstat
-{
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->nntpstat( [ MSGID ] )';
- my $nntp = shift;
+Like C<article> but only fetches the headers for the article.
- $nntp->_STAT(@_) && $nntp->message =~ /(<[^>]+>)/o
- ? $1
- : undef;
-}
+=item nntpstat ( [ MSGID|MSGNUM ] )
+The C<nntpstat> command is similar to the C<article> command except that no
+text is returned. When selecting by message number within a group,
+the C<nntpstat> command serves to set the "current article pointer" without
+sending text.
-sub group
-{
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->group( [ GROUP ] )';
- my $nntp = shift;
- my $grp = ${*$nntp}{'net_nntp_group'} || undef;
+Using the C<nntpstat> command to
+select by message-id is valid but of questionable value, since a
+selection by message-id does B<not> alter the "current article pointer".
- return $grp
- unless(@_ || wantarray);
+Returns the message-id of the "current article".
- my $newgrp = shift;
+=item group ( [ GROUP ] )
- return wantarray ? () : undef
- unless $nntp->_GROUP($newgrp || $grp || "")
- && $nntp->message =~ /(\d+)\s+(\d+)\s+(\d+)\s+(\S+)/;
+Set and/or get the current group. If C<GROUP> is not given then information
+is returned on the current group.
- my($count,$first,$last,$group) = ($1,$2,$3,$4);
+In a scalar context it returns the group name.
- # group may be replied as '(current group)'
- $group = ${*$nntp}{'net_nntp_group'}
- if $group =~ /\(/;
+In an array context the return value is a list containing, the number
+of articles in the group, the number of the first article, the number
+of the last article and the group name.
- ${*$nntp}{'net_nntp_group'} = $group;
+=item ihave ( MSGID [, MESSAGE ])
- wantarray
- ? ($count,$first,$last,$group)
- : $group;
-}
+The C<ihave> command informs the server that the client has an article
+whose id is C<MSGID>. If the server desires a copy of that
+article, and C<MESSAGE> has been given the it will be sent.
-sub help
-{
- @_ == 1 or croak 'usage: $nntp->help()';
- my $nntp = shift;
+Returns I<true> if the server desires the article and C<MESSAGE> was
+successfully sent,if specified.
- $nntp->_HELP
- ? $nntp->read_until_dot
- : undef;
-}
+If C<MESSAGE> is not specified then the message must be sent using the
+C<datasend> and C<dataend> methods from L<Net::Cmd>
-sub ihave
-{
- @_ >= 2 or croak 'usage: $nntp->ihave( MESSAGE-ID [, MESSAGE ])';
- my $nntp = shift;
- my $mid = shift;
+C<MESSAGE> can be either an array of lines or a reference to an array.
- $nntp->_IHAVE($mid) && $nntp->datasend(@_)
- ? @_ == 0 || $nntp->dataend
- : undef;
-}
+=item last ()
-sub last
-{
- @_ == 1 or croak 'usage: $nntp->last()';
- my $nntp = shift;
+Set the "current article pointer" to the previous article in the current
+newsgroup.
- $nntp->_LAST && $nntp->message =~ /(<[^>]+>)/o
- ? $1
- : undef;
-}
+Returns the message-id of the article.
-sub list
-{
- @_ == 1 or croak 'usage: $nntp->list()';
- my $nntp = shift;
+=item date ()
- $nntp->_LIST
- ? $nntp->_grouplist
- : undef;
-}
+Returns the date on the remote server. This date will be in a UNIX time
+format (seconds since 1970)
-sub newgroups
-{
- @_ >= 2 or croak 'usage: $nntp->newgroups( SINCE [, DISTRIBUTIONS ])';
- my $nntp = shift;
- my $time = _timestr(shift);
- my $dist = shift || "";
+=item postok ()
- $dist = join(",", @{$dist})
- if ref($dist);
+C<postok> will return I<true> if the servers initial response indicated
+that it will allow posting.
- $nntp->_NEWGROUPS($time,$dist)
- ? $nntp->_grouplist
- : undef;
-}
+=item authinfo ( USER, PASS )
-sub newnews
-{
- @_ >= 3 or croak 'usage: $nntp->newnews( SINCE [, GROUPS [, DISTRIBUTIONS ]])';
- my $nntp = shift;
- my $time = _timestr(shift);
- my $grp = @_ ? shift : $nntp->group;
- my $dist = shift || "";
+=item list ()
- $grp ||= "*";
- $grp = join(",", @{$grp})
- if ref($grp);
+Obtain information about all the active newsgroups. The results is a reference
+to a hash where the key is a group name and each value is a reference to an
+array. The elements in this array are:- the last article number in the group,
+the first article number in the group and any information flags about the group.
- $dist = join(",", @{$dist})
- if ref($dist);
+=item newgroups ( SINCE [, DISTRIBUTIONS ])
- $nntp->_NEWNEWS($grp,$time,$dist)
- ? $nntp->_articlelist
- : undef;
-}
+C<SINCE> is a time value and C<DISTRIBUTIONS> is either a distribution
+pattern or a reference to a list of distribution patterns.
+The result is the same as C<list>, but the
+groups return will be limited to those created after C<SINCE> and, if
+specified, in one of the distribution areas in C<DISTRIBUTIONS>.
-sub next
-{
- @_ == 1 or croak 'usage: $nntp->next()';
- my $nntp = shift;
+=item newnews ( SINCE [, GROUPS [, DISTRIBUTIONS ]])
- $nntp->_NEXT && $nntp->message =~ /(<[^>]+>)/o
- ? $1
- : undef;
-}
+C<SINCE> is a time value. C<GROUPS> is either a group pattern or a reference
+to a list of group patterns. C<DISTRIBUTIONS> is either a distribution
+pattern or a reference to a list of distribution patterns.
-sub post
-{
- @_ >= 1 or croak 'usage: $nntp->post( [ MESSAGE ] )';
- my $nntp = shift;
+Returns a reference to a list which contains the message-ids of all news posted
+after C<SINCE>, that are in a groups which matched C<GROUPS> and a
+distribution which matches C<DISTRIBUTIONS>.
- $nntp->_POST() && $nntp->datasend(@_)
- ? @_ == 0 || $nntp->dataend
- : undef;
-}
+=item next ()
-sub quit
-{
- @_ == 1 or croak 'usage: $nntp->quit()';
- my $nntp = shift;
+Set the "current article pointer" to the next article in the current
+newsgroup.
- $nntp->_QUIT && $nntp->SUPER::close;
-}
+Returns the message-id of the article.
-sub slave
-{
- @_ == 1 or croak 'usage: $nntp->slave()';
- my $nntp = shift;
+=item post ( [ MESSAGE ] )
- $nntp->_SLAVE;
-}
+Post a new article to the news server. If C<MESSAGE> is specified and posting
+is allowed then the message will be sent.
-##
-## The following methods are not implemented by all servers
-##
+If C<MESSAGE> is not specified then the message must be sent using the
+C<datasend> and C<dataend> methods from L<Net::Cmd>
-sub active
-{
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->active( [ PATTERN ] )';
- my $nntp = shift;
+C<MESSAGE> can be either an array of lines or a reference to an array.
- $nntp->_LIST('ACTIVE',@_)
- ? $nntp->_grouplist
- : undef;
-}
+=item slave ()
-sub active_times
-{
- @_ == 1 or croak 'usage: $nntp->active_times()';
- my $nntp = shift;
+Tell the remote server that I am not a user client, but probably another
+news server.
- $nntp->_LIST('ACTIVE.TIMES')
- ? $nntp->_grouplist
- : undef;
-}
+=item quit ()
-sub distributions
-{
- @_ == 1 or croak 'usage: $nntp->distributions()';
- my $nntp = shift;
+Quit the remote server and close the socket connection.
- $nntp->_LIST('DISTRIBUTIONS')
- ? $nntp->_description
- : undef;
-}
+=back
-sub distribution_patterns
-{
- @_ == 1 or croak 'usage: $nntp->distributions()';
- my $nntp = shift;
+=head2 Extension methods
- my $arr;
- local $_;
+These methods use commands that are not part of the RFC977 documentation. Some
+servers may not support all of them.
- $nntp->_LIST('DISTRIB.PATS') && ($arr = $nntp->read_until_dot)
- ? [grep { /^\d/ && (chomp, $_ = [ split /:/ ]) } @$arr]
- : undef;
-}
+=over 4
-sub newsgroups
-{
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->newsgroups( [ PATTERN ] )';
- my $nntp = shift;
+=item newsgroups ( [ PATTERN ] )
- $nntp->_LIST('NEWSGROUPS',@_)
- ? $nntp->_description
- : undef;
-}
+Returns a reference to a hash where the keys are all the group names which
+match C<PATTERN>, or all of the groups if no pattern is specified, and
+each value contains the description text for the group.
-sub overview_fmt
-{
- @_ == 1 or croak 'usage: $nntp->overview_fmt()';
- my $nntp = shift;
+=item distributions ()
- $nntp->_LIST('OVERVIEW.FMT')
- ? $nntp->_articlelist
- : undef;
-}
+Returns a reference to a hash where the keys are all the possible
+distribution names and the values are the distribution descriptions.
+
+=item subscriptions ()
+
+Returns a reference to a list which contains a list of groups which
+are recommended for a new user to subscribe to.
+
+=item overview_fmt ()
+
+Returns a reference to an array which contain the names of the fields returned
+by C<xover>.
+
+=item active_times ()
+
+Returns a reference to a hash where the keys are the group names and each
+value is a reference to an array containing the time the groups was created
+and an identifier, possibly an Email address, of the creator.
+
+=item active ( [ PATTERN ] )
+
+Similar to C<list> but only active groups that match the pattern are returned.
+C<PATTERN> can be a group pattern.
-sub subscriptions
-{
- @_ == 1 or croak 'usage: $nntp->subscriptions()';
- my $nntp = shift;
+=item xgtitle ( PATTERN )
- $nntp->_LIST('SUBSCRIPTIONS')
- ? $nntp->_articlelist
- : undef;
-}
+Returns a reference to a hash where the keys are all the group names which
+match C<PATTERN> and each value is the description text for the group.
-sub listgroup
-{
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->listgroup( [ GROUP ] )';
- my $nntp = shift;
+=item xhdr ( HEADER, MESSAGE-SPEC )
- $nntp->_LISTGROUP(@_)
- ? $nntp->_articlelist
- : undef;
-}
+Obtain the header field C<HEADER> for all the messages specified.
-sub reader
-{
- @_ == 1 or croak 'usage: $nntp->reader()';
- my $nntp = shift;
+The return value will be a reference
+to a hash where the keys are the message numbers and each value contains
+the text of the requested header for that message.
- $nntp->_MODE('READER');
-}
+=item xover ( MESSAGE-SPEC )
-sub xgtitle
-{
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->xgtitle( [ PATTERN ] )';
- my $nntp = shift;
+The return value will be a reference
+to a hash where the keys are the message numbers and each value contains
+a reference to an array which contains the overview fields for that
+message.
- $nntp->_XGTITLE(@_)
- ? $nntp->_description
- : undef;
-}
+The names of the fields can be obtained by calling C<overview_fmt>.
-sub xhdr
-{
- @_ >= 2 && @_ <= 4 or croak 'usage: $nntp->xhdr( HEADER, [ MESSAGE-ID | MESSAGE_NUM [, MESSAGE-NUM ]] )';
- my($nntp,$hdr,$first) = splice(@_,0,3);
+=item xpath ( MESSAGE-ID )
- my $arg = "$first";
+Returns the path name to the file on the server which contains the specified
+message.
- if(@_)
- {
- my $last = shift;
+=item xpat ( HEADER, PATTERN, MESSAGE-SPEC)
- $arg .= "-";
- $arg .= "$last"
- if(defined $last && $last > $first);
- }
+The result is the same as C<xhdr> except the is will be restricted to
+headers where the text of the header matches C<PATTERN>
- $nntp->_XHDR($hdr, $arg)
- ? $nntp->_description
- : undef;
-}
+=item xrover
-sub xover
-{
- @_ == 2 || @_ == 3 or croak 'usage: $nntp->xover( RANGE )';
- my($nntp,$first) = splice(@_,0,2);
+The XROVER command returns reference information for the article(s)
+specified.
- my $arg = "$first";
+Returns a reference to a HASH where the keys are the message numbers and the
+values are the References: lines from the articles
- if(@_)
- {
- my $last = shift;
- $arg .= "-";
- $arg .= "$last"
- if(defined $last && $last > $first);
- }
+=item listgroup ( [ GROUP ] )
- $nntp->_XOVER($arg)
- ? $nntp->_fieldlist
- : undef;
-}
+Returns a reference to a list of all the active messages in C<GROUP>, or
+the current group if C<GROUP> is not specified.
-sub xpat
-{
- @_ == 4 || @_ == 5 or croak '$nntp->xpat( HEADER, PATTERN, RANGE )';
- my($nntp,$hdr,$pat,$first) = splice(@_,0,4);
+=item reader
- my $arg = "$first";
+Tell the server that you are a reader and not another server.
- if(@_)
- {
- my $last = shift;
- $arg .= "-";
- $arg .= "$last"
- if(defined $last && $last > $first);
- }
+This is required by some servers. For example if you are connecting to
+an INN server and you have transfer permission your connection will
+be connected to the transfer daemon, not the NNTP daemon. Issuing
+this command will cause the transfer daemon to hand over control
+to the NNTP daemon.
- $pat = join(" ", @$pat)
- if ref($pat);
+Some servers do not understand this command, but issuing it and ignoring
+the response is harmless.
- $nntp->_XPAT($hdr,$arg,$pat)
- ? $nntp->_description
- : undef;
-}
+=back
-sub xpath
-{
- @_ == 2 or croak 'usage: $nntp->xpath( MESSAGE-ID )';
- my($nntp,$mid) = @_;
+=head1 UNSUPPORTED
- return undef
- unless $nntp->_XPATH($mid);
+The following NNTP command are unsupported by the package, and there are
+no plans to do so.
- my $m; ($m = $nntp->message) =~ s/^\d+\s+//o;
- my @p = split /\s+/, $m;
+ AUTHINFO GENERIC
+ XTHREAD
+ XSEARCH
+ XINDEX
- wantarray ? @p : $p[0];
-}
+=head1 DEFINITIONS
-sub xrover
-{
- @_ == 2 || @_ == 3 or croak 'usage: $nntp->xrover( RANGE )';
- my($nntp,$first) = splice(@_,0,2);
+=over 4
- my $arg = "$first";
+=item MESSAGE-SPEC
- if(@_)
- {
- my $last = shift;
+C<MESSAGE-SPEC> is either a single message-id, a single message number, or
+a reference to a list of two message numbers.
- $arg .= "-";
- $arg .= "$last"
- if(defined $last && $last > $first);
- }
+If C<MESSAGE-SPEC> is a reference to a list of two message numbers and the
+second number in a range is less than or equal to the first then the range
+represents all messages in the group after the first message number.
- $nntp->_XROVER($arg)
- ? $nntp->_fieldlist
- : undef;
-}
+B<NOTE> For compatibility reasons only with earlier versions of Net::NNTP
+a message spec can be passed as a list of two numbers, this is deprecated
+and a reference to the list should now be passed
-sub date
-{
- @_ == 1 or croak 'usage: $nntp->date()';
- my $nntp = shift;
+=item PATTERN
- $nntp->_DATE && $nntp->message =~ /(\d{4})(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/
- ? timegm($6,$5,$4,$3,$2-1,$1)
- : undef;
-}
+The C<NNTP> protocol uses the C<WILDMAT> format for patterns.
+The WILDMAT format was first developed by Rich Salz based on
+the format used in the UNIX "find" command to articulate
+file names. It was developed to provide a uniform mechanism
+for matching patterns in the same manner that the UNIX shell
+matches filenames.
+Patterns are implicitly anchored at the
+beginning and end of each string when testing for a match.
-##
-## Private subroutines
-##
+There are five pattern matching operations other than a strict
+one-to-one match between the pattern and the source to be
+checked for a match.
-sub _timestr
-{
- my $time = shift;
- my @g = reverse((gmtime($time))[0..5]);
- $g[1] += 1;
- $g[0] %= 100;
- sprintf "%02d%02d%02d %02d%02d%02d GMT", @g;
-}
+The first is an asterisk C<*> to match any sequence of zero or more
+characters.
-sub _grouplist
-{
- my $nntp = shift;
- my $arr = $nntp->read_until_dot or
- return undef;
+The second is a question mark C<?> to match any single character. The
+third specifies a specific set of characters.
- my $hash = {};
- my $ln;
+The set is specified as a list of characters, or as a range of characters
+where the beginning and end of the range are separated by a minus (or dash)
+character, or as any combination of lists and ranges. The dash can
+also be included in the set as a character it if is the beginning
+or end of the set. This set is enclosed in square brackets. The
+close square bracket C<]> may be used in a set if it is the first
+character in the set.
- foreach $ln (@$arr)
- {
- my @a = split(/[\s\n]+/,$ln);
- $hash->{$a[0]} = [ @a[1,2,3] ];
- }
+The fourth operation is the same as the
+logical not of the third operation and is specified the same
+way as the third with the addition of a caret character C<^> at
+the beginning of the test string just inside the open square
+bracket.
- $hash;
-}
+The final operation uses the backslash character to
+invalidate the special meaning of an open square bracket C<[>,
+the asterisk, backslash or the question mark. Two backslashes in
+sequence will result in the evaluation of the backslash as a
+character with no special meaning.
-sub _fieldlist
-{
- my $nntp = shift;
- my $arr = $nntp->read_until_dot or
- return undef;
+=over 4
- my $hash = {};
- my $ln;
+=item Examples
- foreach $ln (@$arr)
- {
- my @a = split(/[\t\n]/,$ln);
- $hash->{$a[0]} = @a[1,2,3];
- }
+=item C<[^]-]>
- $hash;
-}
+matches any single character other than a close square
+bracket or a minus sign/dash.
-sub _articlelist
-{
- my $nntp = shift;
- my $arr = $nntp->read_until_dot;
+=item C<*bdc>
- chomp(@$arr)
- if $arr;
+matches any string that ends with the string "bdc"
+including the string "bdc" (without quotes).
- $arr;
-}
+=item C<[0-9a-zA-Z]>
-sub _description
-{
- my $nntp = shift;
- my $arr = $nntp->read_until_dot or
- return undef;
+matches any single printable alphanumeric ASCII character.
- my $hash = {};
- my $ln;
+=item C<a??d>
- foreach $ln (@$arr)
- {
- chomp($ln);
+matches any four character string which begins
+with a and ends with d.
- $hash->{$1} = $ln
- if $ln =~ s/^\s*(\S+)\s*//o;
- }
+=back
- $hash;
+=back
-}
+=head1 SEE ALSO
-##
-## The commands
-##
+L<Net::Cmd>
-sub _ARTICLE { shift->command('ARTICLE',@_)->response == CMD_OK }
-sub _AUTHINFO { shift->command('AUTHINFO',@_)->response }
-sub _BODY { shift->command('BODY',@_)->response == CMD_OK }
-sub _DATE { shift->command('DATE')->response == CMD_INFO }
-sub _GROUP { shift->command('GROUP',@_)->response == CMD_OK }
-sub _HEAD { shift->command('HEAD',@_)->response == CMD_OK }
-sub _HELP { shift->command('HELP',@_)->response == CMD_INFO }
-sub _IHAVE { shift->command('IHAVE',@_)->response == CMD_MORE }
-sub _LAST { shift->command('LAST')->response == CMD_OK }
-sub _LIST { shift->command('LIST',@_)->response == CMD_OK }
-sub _LISTGROUP { shift->command('LISTGROUP',@_)->response == CMD_OK }
-sub _NEWGROUPS { shift->command('NEWGROUPS',@_)->response == CMD_OK }
-sub _NEWNEWS { shift->command('NEWNEWS',@_)->response == CMD_OK }
-sub _NEXT { shift->command('NEXT')->response == CMD_OK }
-sub _POST { shift->command('POST',@_)->response == CMD_OK }
-sub _QUIT { shift->command('QUIT',@_)->response == CMD_OK }
-sub _SLAVE { shift->command('SLAVE',@_)->response == CMD_OK }
-sub _STAT { shift->command('STAT',@_)->response == CMD_OK }
-sub _MODE { shift->command('MODE',@_)->response == CMD_OK }
-sub _XGTITLE { shift->command('XGTITLE',@_)->response == CMD_OK }
-sub _XHDR { shift->command('XHDR',@_)->response == CMD_OK }
-sub _XPAT { shift->command('XPAT',@_)->response == CMD_OK }
-sub _XPATH { shift->command('XPATH',@_)->response == CMD_OK }
-sub _XOVER { shift->command('XOVER',@_)->response == CMD_OK }
-sub _XROVER { shift->command('XROVER',@_)->response == CMD_OK }
-sub _XTHREAD { shift->unsupported }
-sub _XSEARCH { shift->unsupported }
-sub _XINDEX { shift->unsupported }
+=head1 AUTHOR
-##
-## IO/perl methods
-##
+Graham Barr <gbarr@pobox.com>
-sub close
-{
- my $nntp = shift;
+=head1 COPYRIGHT
- ref($nntp)
- && defined fileno($nntp)
- && $nntp->quit;
-}
+Copyright (c) 1995-1997 Graham Barr. All rights reserved.
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
-sub DESTROY { shift->close }
+=for html <hr>
+I<$Id: //depot/libnet/Net/NNTP.pm#14 $>
-1;
+=cut
projects / p5sagit/p5-mst-13.2.git / blobdiff