X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FNet%2FNNTP.pm;h=0078cf4830b64e4040bf455fd4f5df4ae172c649;hb=860599f1563eb187b3ec0b74653ad9a88d0147d0;hp=a23b9bb589bcd2e072f967b3a1e19a08e2d44fd7;hpb=7e1af8bca57f405a8444b575a870918a6d88fc5c;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/Net/NNTP.pm b/lib/Net/NNTP.pm index a23b9bb..0078cf4 100644 --- a/lib/Net/NNTP.pm +++ b/lib/Net/NNTP.pm @@ -1,996 +1,1069 @@ # Net::NNTP.pm # -# Copyright (c) 1995 Graham Barr . All rights -# reserved. This program is free software; you can redistribute it and/or +# 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. 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 is a class implementing a simple NNTP client in Perl as described -in RFC977. C inherits its communication methods from C + 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 is the -name of the remote host to which a NNTP connection is required. If not -given two environment variables are checked, first C then -C, if neither are set C is used. + ${*$obj}{'net_nntp_host'} = $host; -C 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 - 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 - 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 or I -value, with I meaning that the operation was a success. When a method -states that it returns a value, falure will be returned as I 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 is a numeric id of an article in the -current newsgroup, and will change the current article pointer. -C is the message id of an article as -shown in that article's header. It is anticipated that the client -will obtain the C from a list provided by the C -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
+ $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
+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 command is similar to the C
command except that no -text is returned. When selecting by message number within a group, -the C 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 command to -select by message-id is valid but of questionable value, since a -selection by message-id does B 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 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 command informs the server that the client has an article -whose id is C. If the server desires a copy of that -article, and C has been given the it will be sent. + # group may be replied as '(current group)' + $group = ${*$nntp}{'net_nntp_group'} + if $group =~ /\(/; -Returns I if the server desires the article and C was -successfully sent,if specified. + ${*$nntp}{'net_nntp_group'} = $group; -If C is not specified then the message must be sent using the -C and C methods from L + wantarray + ? ($count,$first,$last,$group) + : $group; +} -C 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 will return I 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 is a time value and C is either a distribution -pattern or a reference to a list of distribution patterns. -The result is the same as C, but the -groups return will be limited to those created after C and, if -specified, in one of the distribution areas in C. + $grp ||= "*"; + $grp = join(",", @{$grp}) + if ref($grp); -=item newnews ( SINCE [, GROUPS [, DISTRIBUTIONS ]]) + $dist = join(",", @{$dist}) + if ref($dist); -C is a time value. C is either a group pattern or a reference -to a list of group patterns. C 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, that are in a groups which matched C and a -distribution which matches C. +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 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 is not specified then the message must be sent using the -C and C methods from L + $nntp->_QUIT; + $nntp->close; +} -C 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, 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. +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 but only active groups that match the pattern are returned. -C 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 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
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. + $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 except the is will be restricted to -headers that match C +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 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 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 protocol uses the C 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 + $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 +sub DESTROY +{ + my $nntp = shift; + defined(fileno($nntp)) && $nntp->quit +} -=head1 AUTHOR -Graham Barr +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 is a class implementing a simple NNTP client in Perl as described +in RFC977. C inherits its communication methods from C - $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 is the +name of the remote host to which a NNTP connection is required. If not +given two environment variables are checked, first C then +C, then C is checked, and if a host is not found +then C is used. - unless ($obj->response() == CMD_OK) - { - $obj->close(); - return undef; - } +C 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 - 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 - Enable the printing of debugging information to STDERR -sub debug_text -{ - my $nntp = shift; - my $inout = shift; - my $text = shift; +B - If the remote server is INN then initially the connection +will be to nnrpd, by default C will issue a C command +so that the remote server becomes innd. If the C 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 or I +value, with I meaning that the operation was a success. When a method +states that it returns a value, failure will be returned as I 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 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 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 is a numeric id of an article in the current newsgroup, and +will change the current article pointer. C is the message id of +an article as shown in that article's header. It is anticipated that the +client will obtain the C from a list provided by the C +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 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
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
but only fetches the headers for the article. - $nntp->_STAT(@_) && $nntp->message =~ /(<[^>]+>)/o - ? $1 - : undef; -} +=item nntpstat ( [ MSGID|MSGNUM ] ) +The C command is similar to the C
command except that no +text is returned. When selecting by message number within a group, +the C 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 command to +select by message-id is valid but of questionable value, since a +selection by message-id does B 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 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 command informs the server that the client has an article +whose id is C. If the server desires a copy of that +article, and C has been given the it will be sent. -sub help -{ - @_ == 1 or croak 'usage: $nntp->help()'; - my $nntp = shift; +Returns I if the server desires the article and C was +successfully sent,if specified. - $nntp->_HELP - ? $nntp->read_until_dot - : undef; -} +If C is not specified then the message must be sent using the +C and C methods from L -sub ihave -{ - @_ >= 2 or croak 'usage: $nntp->ihave( MESSAGE-ID [, MESSAGE ])'; - my $nntp = shift; - my $mid = shift; +C 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 will return I 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 is a time value and C is either a distribution +pattern or a reference to a list of distribution patterns. +The result is the same as C, but the +groups return will be limited to those created after C and, if +specified, in one of the distribution areas in C. -sub next -{ - @_ == 1 or croak 'usage: $nntp->next()'; - my $nntp = shift; +=item newnews ( SINCE [, GROUPS [, DISTRIBUTIONS ]]) - $nntp->_NEXT && $nntp->message =~ /(<[^>]+>)/o - ? $1 - : undef; -} +C is a time value. C is either a group pattern or a reference +to a list of group patterns. C 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, that are in a groups which matched C and a +distribution which matches C. - $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 is specified and posting +is allowed then the message will be sent. -## -## The following methods are not implemented by all servers -## +If C is not specified then the message must be sent using the +C and C methods from L -sub active -{ - @_ == 1 || @_ == 2 or croak 'usage: $nntp->active( [ PATTERN ] )'; - my $nntp = shift; +C 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, 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. + +=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 but only active groups that match the pattern are returned. +C 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 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
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. -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 except the is will be restricted to +headers where the text of the header matches C - $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, or +the current group if C 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 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 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 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 protocol uses the C 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 - 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 -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 -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
+I<$Id: //depot/libnet/Net/NNTP.pm#14 $> -1; +=cut