use Time::Local;
use Net::Config;
-$VERSION = "2.20"; # $Id: //depot/libnet/Net/NNTP.pm#14 $
+$VERSION = "2.24";
@ISA = qw(Net::Cmd IO::Socket::INET);
-sub new
-{
- my $self = shift;
- my $type = ref($self) || $self;
- my $host = shift if @_ % 2;
- my %arg = @_;
- my $obj;
- $host ||= $ENV{NNTPSERVER} || $ENV{NEWSHOST};
+sub new {
+ my $self = shift;
+ my $type = ref($self) || $self;
+ my ($host, %arg);
+ if (@_ % 2) {
+ $host = shift;
+ %arg = @_;
+ }
+ else {
+ %arg = @_;
+ $host = delete $arg{Host};
+ }
+ my $obj;
+
+ $host ||= $ENV{NNTPSERVER} || $ENV{NEWSHOST};
+
+ my $hosts = defined $host ? [$host] : $NetConfig{nntp_hosts};
+
+ @{$hosts} = qw(news)
+ unless @{$hosts};
+
+ 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;
+ }
- my $hosts = defined $host ? [ $host ] : $NetConfig{nntp_hosts};
+ return undef
+ unless defined $obj;
- @{$hosts} = qw(news)
- unless @{$hosts};
+ ${*$obj}{'net_nntp_host'} = $host;
- 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;
+ $obj->autoflush(1);
+ $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
+
+ unless ($obj->response() == CMD_OK) {
+ $obj->close;
+ return undef;
}
- return undef
- unless defined $obj;
+ my $c = $obj->code;
+ my @m = $obj->message;
- ${*$obj}{'net_nntp_host'} = $host;
+ unless (exists $arg{Reader} && $arg{Reader} == 0) {
- $obj->autoflush(1);
- $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);
+ # if server is INN and we have transfer rights the we are currently
+ # talking to innd not nnrpd
+ if ($obj->reader) {
- unless ($obj->response() == CMD_OK)
- {
- $obj->close;
- return undef;
+ # 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);
+ }
}
- my $c = $obj->code;
- my @m = $obj->message;
+ ${*$obj}{'net_nntp_post'} = $c == 200 ? 1 : 0;
- 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;
+}
- ${*$obj}{'net_nntp_post'} = $c == 200 ? 1 : 0;
- $obj;
+sub host {
+ my $me = shift;
+ ${*$me}{'net_nntp_host'};
}
-sub debug_text
-{
- my $nntp = shift;
- my $inout = shift;
- my $text = shift;
- if(($nntp->code == 350 && $text =~ /^(\S+)/)
- || ($text =~ /^(authinfo\s+pass)/io))
+sub debug_text {
+ my $nntp = shift;
+ my $inout = shift;
+ my $text = shift;
+
+ if ( (ref($nntp) and $nntp->code == 350 and $text =~ /^(\S+)/)
+ || ($text =~ /^(authinfo\s+pass)/io))
{
- $text = "$1 ....\n"
+ $text = "$1 ....\n";
}
- $text;
+ $text;
}
-sub postok
-{
- @_ == 1 or croak 'usage: $nntp->postok()';
- my $nntp = shift;
- ${*$nntp}{'net_nntp_post'} || 0;
+
+sub postok {
+ @_ == 1 or croak 'usage: $nntp->postok()';
+ my $nntp = shift;
+ ${*$nntp}{'net_nntp_post'} || 0;
}
-sub article
-{
- @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->article( [ MSGID ], [ FH ] )';
- my $nntp = shift;
- my @fh;
- @fh = (pop) if @_ == 2 || (@_ && ref($_[0]) || ref(\$_[0]) eq 'GLOB');
+sub article {
+ @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->article( [ MSGID ], [ FH ] )';
+ my $nntp = shift;
+ my @fh;
+
+ @fh = (pop) if @_ == 2 || (@_ && (ref($_[0]) || ref(\$_[0]) eq 'GLOB'));
- $nntp->_ARTICLE(@_)
+ $nntp->_ARTICLE(@_)
? $nntp->read_until_dot(@fh)
: undef;
}
-sub authinfo
-{
- @_ == 3 or croak 'usage: $nntp->authinfo( USER, PASS )';
- my($nntp,$user,$pass) = @_;
- $nntp->_AUTHINFO("USER",$user) == CMD_MORE
- && $nntp->_AUTHINFO("PASS",$pass) == CMD_OK;
+sub articlefh {
+ @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->articlefh( [ MSGID ] )';
+ my $nntp = shift;
+
+ return unless $nntp->_ARTICLE(@_);
+ return $nntp->tied_fh;
+}
+
+
+sub authinfo {
+ @_ == 3 or croak 'usage: $nntp->authinfo( USER, PASS )';
+ my ($nntp, $user, $pass) = @_;
+
+ $nntp->_AUTHINFO("USER", $user) == CMD_MORE
+ && $nntp->_AUTHINFO("PASS", $pass) == CMD_OK;
}
-sub authinfo_simple
-{
- @_ == 3 or croak 'usage: $nntp->authinfo( USER, PASS )';
- my($nntp,$user,$pass) = @_;
- $nntp->_AUTHINFO('SIMPLE') == CMD_MORE
- && $nntp->command($user,$pass)->response == CMD_OK;
+sub authinfo_simple {
+ @_ == 3 or croak 'usage: $nntp->authinfo( USER, PASS )';
+ my ($nntp, $user, $pass) = @_;
+
+ $nntp->_AUTHINFO('SIMPLE') == CMD_MORE
+ && $nntp->command($user, $pass)->response == CMD_OK;
}
-sub body
-{
- @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->body( [ MSGID ], [ FH ] )';
- my $nntp = shift;
- my @fh;
- @fh = (pop) if @_ == 2 || (@_ && ref($_[0]) || ref(\$_[0]) eq 'GLOB');
+sub body {
+ @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->body( [ MSGID ], [ FH ] )';
+ my $nntp = shift;
+ my @fh;
- $nntp->_BODY(@_)
+ @fh = (pop) if @_ == 2 || (@_ && ref($_[0]) || ref(\$_[0]) eq 'GLOB');
+
+ $nntp->_BODY(@_)
? $nntp->read_until_dot(@fh)
: undef;
}
-sub head
-{
- @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->head( [ MSGID ], [ FH ] )';
- my $nntp = shift;
- my @fh;
- @fh = (pop) if @_ == 2 || (@_ && ref($_[0]) || ref(\$_[0]) eq 'GLOB');
+sub bodyfh {
+ @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->bodyfh( [ MSGID ] )';
+ my $nntp = shift;
+ return unless $nntp->_BODY(@_);
+ return $nntp->tied_fh;
+}
+
- $nntp->_HEAD(@_)
+sub head {
+ @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->head( [ MSGID ], [ FH ] )';
+ my $nntp = shift;
+ my @fh;
+
+ @fh = (pop) if @_ == 2 || (@_ && ref($_[0]) || ref(\$_[0]) eq 'GLOB');
+
+ $nntp->_HEAD(@_)
? $nntp->read_until_dot(@fh)
: undef;
}
-sub nntpstat
-{
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->nntpstat( [ MSGID ] )';
- my $nntp = shift;
- $nntp->_STAT(@_) && $nntp->message =~ /(<[^>]+>)/o
+sub headfh {
+ @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->headfh( [ MSGID ] )';
+ my $nntp = shift;
+ return unless $nntp->_HEAD(@_);
+ return $nntp->tied_fh;
+}
+
+
+sub nntpstat {
+ @_ == 1 || @_ == 2 or croak 'usage: $nntp->nntpstat( [ MSGID ] )';
+ my $nntp = shift;
+
+ $nntp->_STAT(@_) && $nntp->message =~ /(<[^>]+>)/o
? $1
: undef;
}
-sub group
-{
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->group( [ GROUP ] )';
- my $nntp = shift;
- my $grp = ${*$nntp}{'net_nntp_group'} || undef;
+sub group {
+ @_ == 1 || @_ == 2 or croak 'usage: $nntp->group( [ GROUP ] )';
+ my $nntp = shift;
+ my $grp = ${*$nntp}{'net_nntp_group'} || undef;
- return $grp
- unless(@_ || wantarray);
+ return $grp
+ unless (@_ || wantarray);
- my $newgrp = shift;
+ my $newgrp = shift;
- return wantarray ? () : undef
- unless $nntp->_GROUP($newgrp || $grp || "")
- && $nntp->message =~ /(\d+)\s+(\d+)\s+(\d+)\s+(\S+)/;
+ return wantarray ? () : undef
+ unless $nntp->_GROUP($newgrp || $grp || "")
+ && $nntp->message =~ /(\d+)\s+(\d+)\s+(\d+)\s+(\S+)/;
- my($count,$first,$last,$group) = ($1,$2,$3,$4);
+ my ($count, $first, $last, $group) = ($1, $2, $3, $4);
- # group may be replied as '(current group)'
- $group = ${*$nntp}{'net_nntp_group'}
+ # group may be replied as '(current group)'
+ $group = ${*$nntp}{'net_nntp_group'}
if $group =~ /\(/;
- ${*$nntp}{'net_nntp_group'} = $group;
+ ${*$nntp}{'net_nntp_group'} = $group;
- wantarray
- ? ($count,$first,$last,$group)
+ wantarray
+ ? ($count, $first, $last, $group)
: $group;
}
-sub help
-{
- @_ == 1 or croak 'usage: $nntp->help()';
- my $nntp = shift;
- $nntp->_HELP
+sub help {
+ @_ == 1 or croak 'usage: $nntp->help()';
+ my $nntp = shift;
+
+ $nntp->_HELP
? $nntp->read_until_dot
: undef;
}
-sub ihave
-{
- @_ >= 2 or croak 'usage: $nntp->ihave( MESSAGE-ID [, MESSAGE ])';
- my $nntp = shift;
- my $mid = shift;
- $nntp->_IHAVE($mid) && $nntp->datasend(@_)
+sub ihave {
+ @_ >= 2 or croak 'usage: $nntp->ihave( MESSAGE-ID [, MESSAGE ])';
+ my $nntp = shift;
+ my $mid = shift;
+
+ $nntp->_IHAVE($mid) && $nntp->datasend(@_)
? @_ == 0 || $nntp->dataend
: undef;
}
-sub last
-{
- @_ == 1 or croak 'usage: $nntp->last()';
- my $nntp = shift;
- $nntp->_LAST && $nntp->message =~ /(<[^>]+>)/o
+sub last {
+ @_ == 1 or croak 'usage: $nntp->last()';
+ my $nntp = shift;
+
+ $nntp->_LAST && $nntp->message =~ /(<[^>]+>)/o
? $1
: undef;
}
-sub list
-{
- @_ == 1 or croak 'usage: $nntp->list()';
- my $nntp = shift;
- $nntp->_LIST
+sub list {
+ @_ == 1 or croak 'usage: $nntp->list()';
+ my $nntp = shift;
+
+ $nntp->_LIST
? $nntp->_grouplist
: undef;
}
-sub newgroups
-{
- @_ >= 2 or croak 'usage: $nntp->newgroups( SINCE [, DISTRIBUTIONS ])';
- my $nntp = shift;
- my $time = _timestr(shift);
- my $dist = shift || "";
- $dist = join(",", @{$dist})
+sub newgroups {
+ @_ >= 2 or croak 'usage: $nntp->newgroups( SINCE [, DISTRIBUTIONS ])';
+ my $nntp = shift;
+ my $time = _timestr(shift);
+ my $dist = shift || "";
+
+ $dist = join(",", @{$dist})
if ref($dist);
- $nntp->_NEWGROUPS($time,$dist)
+ $nntp->_NEWGROUPS($time, $dist)
? $nntp->_grouplist
: undef;
}
-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 || "";
-
- $grp ||= "*";
- $grp = join(",", @{$grp})
+
+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 || "";
+
+ $grp ||= "*";
+ $grp = join(",", @{$grp})
if ref($grp);
- $dist = join(",", @{$dist})
+ $dist = join(",", @{$dist})
if ref($dist);
- $nntp->_NEWNEWS($grp,$time,$dist)
+ $nntp->_NEWNEWS($grp, $time, $dist)
? $nntp->_articlelist
: undef;
}
-sub next
-{
- @_ == 1 or croak 'usage: $nntp->next()';
- my $nntp = shift;
- $nntp->_NEXT && $nntp->message =~ /(<[^>]+>)/o
+sub next {
+ @_ == 1 or croak 'usage: $nntp->next()';
+ my $nntp = shift;
+
+ $nntp->_NEXT && $nntp->message =~ /(<[^>]+>)/o
? $1
: undef;
}
-sub post
-{
- @_ >= 1 or croak 'usage: $nntp->post( [ MESSAGE ] )';
- my $nntp = shift;
- $nntp->_POST() && $nntp->datasend(@_)
+sub post {
+ @_ >= 1 or croak 'usage: $nntp->post( [ MESSAGE ] )';
+ my $nntp = shift;
+
+ $nntp->_POST() && $nntp->datasend(@_)
? @_ == 0 || $nntp->dataend
: undef;
}
-sub quit
-{
- @_ == 1 or croak 'usage: $nntp->quit()';
- my $nntp = shift;
- $nntp->_QUIT;
- $nntp->close;
+sub postfh {
+ my $nntp = shift;
+ return unless $nntp->_POST();
+ return $nntp->tied_fh;
+}
+
+
+sub quit {
+ @_ == 1 or croak 'usage: $nntp->quit()';
+ my $nntp = shift;
+
+ $nntp->_QUIT;
+ $nntp->close;
}
-sub slave
-{
- @_ == 1 or croak 'usage: $nntp->slave()';
- my $nntp = shift;
- $nntp->_SLAVE;
+sub slave {
+ @_ == 1 or croak 'usage: $nntp->slave()';
+ my $nntp = shift;
+
+ $nntp->_SLAVE;
}
##
## The following methods are not implemented by all servers
##
-sub active
-{
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->active( [ PATTERN ] )';
- my $nntp = shift;
- $nntp->_LIST('ACTIVE',@_)
+sub active {
+ @_ == 1 || @_ == 2 or croak 'usage: $nntp->active( [ PATTERN ] )';
+ my $nntp = shift;
+
+ $nntp->_LIST('ACTIVE', @_)
? $nntp->_grouplist
: undef;
}
-sub active_times
-{
- @_ == 1 or croak 'usage: $nntp->active_times()';
- my $nntp = shift;
- $nntp->_LIST('ACTIVE.TIMES')
+sub active_times {
+ @_ == 1 or croak 'usage: $nntp->active_times()';
+ my $nntp = shift;
+
+ $nntp->_LIST('ACTIVE.TIMES')
? $nntp->_grouplist
: undef;
}
-sub distributions
-{
- @_ == 1 or croak 'usage: $nntp->distributions()';
- my $nntp = shift;
- $nntp->_LIST('DISTRIBUTIONS')
+sub distributions {
+ @_ == 1 or croak 'usage: $nntp->distributions()';
+ my $nntp = shift;
+
+ $nntp->_LIST('DISTRIBUTIONS')
? $nntp->_description
: undef;
}
-sub distribution_patterns
-{
- @_ == 1 or croak 'usage: $nntp->distributions()';
- my $nntp = shift;
- my $arr;
- local $_;
+sub distribution_patterns {
+ @_ == 1 or croak 'usage: $nntp->distributions()';
+ my $nntp = shift;
+
+ my $arr;
+ local $_;
- $nntp->_LIST('DISTRIB.PATS') && ($arr = $nntp->read_until_dot)
- ? [grep { /^\d/ && (chomp, $_ = [ split /:/ ]) } @$arr]
+ $nntp->_LIST('DISTRIB.PATS')
+ && ($arr = $nntp->read_until_dot)
+ ? [grep { /^\d/ && (chomp, $_ = [split /:/]) } @$arr]
: undef;
}
-sub newsgroups
-{
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->newsgroups( [ PATTERN ] )';
- my $nntp = shift;
- $nntp->_LIST('NEWSGROUPS',@_)
+sub newsgroups {
+ @_ == 1 || @_ == 2 or croak 'usage: $nntp->newsgroups( [ PATTERN ] )';
+ my $nntp = shift;
+
+ $nntp->_LIST('NEWSGROUPS', @_)
? $nntp->_description
: undef;
}
-sub overview_fmt
-{
- @_ == 1 or croak 'usage: $nntp->overview_fmt()';
- my $nntp = shift;
- $nntp->_LIST('OVERVIEW.FMT')
- ? $nntp->_articlelist
- : undef;
+sub overview_fmt {
+ @_ == 1 or croak 'usage: $nntp->overview_fmt()';
+ my $nntp = shift;
+
+ $nntp->_LIST('OVERVIEW.FMT')
+ ? $nntp->_articlelist
+ : undef;
}
-sub subscriptions
-{
- @_ == 1 or croak 'usage: $nntp->subscriptions()';
- my $nntp = shift;
- $nntp->_LIST('SUBSCRIPTIONS')
+sub subscriptions {
+ @_ == 1 or croak 'usage: $nntp->subscriptions()';
+ my $nntp = shift;
+
+ $nntp->_LIST('SUBSCRIPTIONS')
? $nntp->_articlelist
: undef;
}
-sub listgroup
-{
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->listgroup( [ GROUP ] )';
- my $nntp = shift;
- $nntp->_LISTGROUP(@_)
+sub listgroup {
+ @_ == 1 || @_ == 2 or croak 'usage: $nntp->listgroup( [ GROUP ] )';
+ my $nntp = shift;
+
+ $nntp->_LISTGROUP(@_)
? $nntp->_articlelist
: undef;
}
-sub reader
-{
- @_ == 1 or croak 'usage: $nntp->reader()';
- my $nntp = shift;
- $nntp->_MODE('READER');
+sub reader {
+ @_ == 1 or croak 'usage: $nntp->reader()';
+ my $nntp = shift;
+
+ $nntp->_MODE('READER');
}
-sub xgtitle
-{
- @_ == 1 || @_ == 2 or croak 'usage: $nntp->xgtitle( [ PATTERN ] )';
- my $nntp = shift;
- $nntp->_XGTITLE(@_)
+sub xgtitle {
+ @_ == 1 || @_ == 2 or croak 'usage: $nntp->xgtitle( [ PATTERN ] )';
+ my $nntp = shift;
+
+ $nntp->_XGTITLE(@_)
? $nntp->_description
: undef;
}
-sub xhdr
-{
- @_ >= 2 && @_ <= 4 or croak 'usage: $nntp->xhdr( HEADER, [ MESSAGE-SPEC ] )';
- my $nntp = shift;
- my $hdr = shift;
- my $arg = _msg_arg(@_);
- $nntp->_XHDR($hdr, $arg)
- ? $nntp->_description
- : undef;
+sub xhdr {
+ @_ >= 2 && @_ <= 4 or croak 'usage: $nntp->xhdr( HEADER, [ MESSAGE-SPEC ] )';
+ my $nntp = shift;
+ my $hdr = shift;
+ my $arg = _msg_arg(@_);
+
+ $nntp->_XHDR($hdr, $arg)
+ ? $nntp->_description
+ : undef;
}
-sub xover
-{
- @_ == 2 || @_ == 3 or croak 'usage: $nntp->xover( MESSAGE-SPEC )';
- my $nntp = shift;
- my $arg = _msg_arg(@_);
- $nntp->_XOVER($arg)
- ? $nntp->_fieldlist
- : undef;
+sub xover {
+ @_ == 2 || @_ == 3 or croak 'usage: $nntp->xover( MESSAGE-SPEC )';
+ my $nntp = shift;
+ my $arg = _msg_arg(@_);
+
+ $nntp->_XOVER($arg)
+ ? $nntp->_fieldlist
+ : undef;
}
-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(@_);
- $pat = join(" ", @$pat)
+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(@_);
+
+ $pat = join(" ", @$pat)
if ref($pat);
- $nntp->_XPAT($hdr,$arg,$pat)
- ? $nntp->_description
- : undef;
+ $nntp->_XPAT($hdr, $arg, $pat)
+ ? $nntp->_description
+ : undef;
}
-sub xpath
-{
- @_ == 2 or croak 'usage: $nntp->xpath( MESSAGE-ID )';
- my($nntp,$mid) = @_;
- return undef
- unless $nntp->_XPATH($mid);
+sub xpath {
+ @_ == 2 or croak 'usage: $nntp->xpath( MESSAGE-ID )';
+ my ($nntp, $mid) = @_;
+
+ return undef
+ unless $nntp->_XPATH($mid);
- my $m; ($m = $nntp->message) =~ s/^\d+\s+//o;
- my @p = split /\s+/, $m;
+ my $m;
+ ($m = $nntp->message) =~ s/^\d+\s+//o;
+ my @p = split /\s+/, $m;
- wantarray ? @p : $p[0];
+ wantarray ? @p : $p[0];
}
-sub xrover
-{
- @_ == 2 || @_ == 3 or croak 'usage: $nntp->xrover( MESSAGE-SPEC )';
- my $nntp = shift;
- my $arg = _msg_arg(@_);
- $nntp->_XROVER($arg)
- ? $nntp->_description
- : undef;
+sub xrover {
+ @_ == 2 || @_ == 3 or croak 'usage: $nntp->xrover( MESSAGE-SPEC )';
+ my $nntp = shift;
+ my $arg = _msg_arg(@_);
+
+ $nntp->_XROVER($arg)
+ ? $nntp->_description
+ : undef;
}
-sub date
-{
- @_ == 1 or croak 'usage: $nntp->date()';
- my $nntp = shift;
- $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)
+sub date {
+ @_ == 1 or croak 'usage: $nntp->date()';
+ my $nntp = shift;
+
+ $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;
}
## Private subroutines
##
-sub _msg_arg
-{
- my $spec = shift;
- my $arg = "";
- if(@_)
- {
- carp "Depriciated passing of two message numbers, "
- . "pass a reference"
- if $^W;
- $spec = [ $spec, $_[0] ];
+sub _msg_arg {
+ my $spec = shift;
+ my $arg = "";
+
+ if (@_) {
+ carp "Depriciated passing of two message numbers, " . "pass a reference"
+ if $^W;
+ $spec = [$spec, $_[0]];
}
- 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];
+ 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;
+ else {
+ $arg = $spec;
}
}
- $arg;
+ $arg;
}
-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;
+
+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;
}
-sub _grouplist
-{
- my $nntp = shift;
- my $arr = $nntp->read_until_dot or
- return undef;
- my $hash = {};
- my $ln;
+sub _grouplist {
+ my $nntp = shift;
+ my $arr = $nntp->read_until_dot
+ or return undef;
- foreach $ln (@$arr)
- {
- my @a = split(/[\s\n]+/,$ln);
- $hash->{$a[0]} = [ @a[1,2,3] ];
+ my $hash = {};
+ my $ln;
+
+ foreach $ln (@$arr) {
+ my @a = split(/[\s\n]+/, $ln);
+ $hash->{$a[0]} = [@a[1, 2, 3]];
}
- $hash;
+ $hash;
}
-sub _fieldlist
-{
- my $nntp = shift;
- my $arr = $nntp->read_until_dot or
- return undef;
- my $hash = {};
- my $ln;
+sub _fieldlist {
+ my $nntp = shift;
+ my $arr = $nntp->read_until_dot
+ or return undef;
- foreach $ln (@$arr)
- {
- my @a = split(/[\t\n]/,$ln);
- my $m = shift @a;
- $hash->{$m} = [ @a ];
+ my $hash = {};
+ my $ln;
+
+ foreach $ln (@$arr) {
+ my @a = split(/[\t\n]/, $ln);
+ my $m = shift @a;
+ $hash->{$m} = [@a];
}
- $hash;
+ $hash;
}
-sub _articlelist
-{
- my $nntp = shift;
- my $arr = $nntp->read_until_dot;
- chomp(@$arr)
+sub _articlelist {
+ my $nntp = shift;
+ my $arr = $nntp->read_until_dot;
+
+ chomp(@$arr)
if $arr;
- $arr;
+ $arr;
}
-sub _description
-{
- my $nntp = shift;
- my $arr = $nntp->read_until_dot or
- return undef;
- my $hash = {};
- my $ln;
+sub _description {
+ my $nntp = shift;
+ my $arr = $nntp->read_until_dot
+ or return undef;
- foreach $ln (@$arr)
- {
- chomp($ln);
+ my $hash = {};
+ my $ln;
+
+ foreach $ln (@$arr) {
+ chomp($ln);
- $hash->{$1} = $ln
- if $ln =~ s/^\s*(\S+)\s*//o;
+ $hash->{$1} = $ln
+ if $ln =~ s/^\s*(\S+)\s*//o;
}
- $hash;
+ $hash;
}
## The commands
##
-sub _ARTICLE { shift->command('ARTICLE',@_)->response == CMD_OK }
-sub _AUTHINFO { shift->command('AUTHINFO',@_)->response }
-sub _BODY { shift->command('BODY',@_)->response == CMD_OK }
+
+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 _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 _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 _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 }
## IO/perl methods
##
-sub DESTROY
-{
- my $nntp = shift;
- defined(fileno($nntp)) && $nntp->quit
+
+sub DESTROY {
+ my $nntp = shift;
+ defined(fileno($nntp)) && $nntp->quit;
}
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
+given then it may be passed as the C<Host> option described below. If no host is passed
+then 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.
C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
Possible options are:
+B<Host> - NNTP host to connect to. It may be a single scalar, as defined for
+the C<PeerAddr> option in L<IO::Socket::INET>, or a reference to
+an array with hosts to try in turn. The L</host> method will return the value
+which was used to connect to the host.
+
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)
specified article.
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
+and the result will be printed to it, on success a true value will be
+returned. If C<FH> is not specified then the return value, on success,
+will be a reference to an array containing the article requested, each
entry in the array will contain one line of the article.
If no arguments are passed then the current article in the currently
Like C<article> but only fetches the headers for the article.
+=item articlefh ( [ MSGID|MSGNUM ] )
+
+=item bodyfh ( [ MSGID|MSGNUM ] )
+
+=item headfh ( [ MSGID|MSGNUM ] )
+
+These are similar to article(), body() and head(), but rather than
+returning the requested data directly, they return a tied filehandle
+from which to read the article.
+
=item nntpstat ( [ MSGID|MSGNUM ] )
The C<nntpstat> command is similar to the C<article> command except that no
=item authinfo ( USER, PASS )
+Authenticates to the server (using AUTHINFO USER / AUTHINFO PASS)
+using the supplied username and password. Please note that the
+password is sent in clear text to the server. This command should not
+be used with valuable passwords unless the connection to the server is
+somehow protected.
+
=item list ()
Obtain information about all the active newsgroups. The results is a reference
C<MESSAGE> can be either an array of lines or a reference to an array.
+The message, either sent via C<datasend> or as the C<MESSAGE>
+parameter, must be in the format as described by RFC822 and must
+contain From:, Newsgroups: and Subject: headers.
+
+=item postfh ()
+
+Post a new article to the news server using a tied filehandle. If
+posting is allowed, this method will return a tied filehandle that you
+can print() the contents of the article to be posted. You must
+explicitly close() the filehandle when you are finished posting the
+article, and the return value from the close() call will indicate
+whether the message was successfully posted.
+
=item slave ()
Tell the remote server that I am not a user client, but probably another
This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
-=for html <hr>
-
-I<$Id: //depot/libnet/Net/NNTP.pm#14 $>
-
=cut
projects / p5sagit/p5-mst-13.2.git / blobdiff