| Subject: | @_ corruption in Net::NNTP::article, with a fix |
This happens on Debian(sid) which currently ships Perl 5.8.4 and libnet-1.19 (version 2.22); version 2.23 which is the latest on CPAN still has this problem.
I run leafnode package on my home machine, and one of its support
scripts (touch_newsgroup) runs NNTP->article() command without
any parameter like this:
sub read_article {
my ($groupname) = @_;
my ($narticles, $first, $last, $name) = $server->group($groupname)
or die "Can't select $groupname\n";
if ($narticles > 0) {
my $lines = $server->article() #fetch current/first article
or die "Can't get first article in $name\n";
print "read first article from $name\n" if ($option{v});
} else {
print "no articles in $name\n";
}
}
The above, when calling $server->article(), emits the following
warning:
Use of uninitialized value in pattern match (m//) at /usr/share/perl/5.8/Net/Cmd.pm line 207, <GROUPFILE> line 1.
It turns out that Net::NNTP::article is silently pushing an
undef into @_ before calling $nntp->_ARTICLE(@_) when called
without parameter. The subroutine from libnet-1.19 looks like
this:
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->read_until_dot(@fh)
: undef;
}
The culprit appears to be the line "@fh = (pop)...". Shouldn't
it read like the following patch?
--- NNTP.pm 2004-12-08 13:18:50.000000000 -0800
+++ NNTP.pm+ 2004-12-08 13:19:02.000000000 -0800
@@ -109,7 +109,7 @@ sub article
my $nntp = shift;
my @fh;
- @fh = (pop) if @_ == 2 || (@_ && ref($_[0]) || ref(\$_[0]) eq 'GLOB');
+ @fh = (pop) if @_ == 2 || (@_ && (ref($_[0]) || ref(\$_[0]) eq 'GLOB'));
$nntp->_ARTICLE(@_)
? $nntp->read_until_dot(@fh)
When the last clause "ref(\$_[0]) eq 'GLOB'" gets evaluated (and
it does, due to the missing parentheses when @_ == 0), $_[0]
seems to get autovivified. A small test program confirms that
this is the case. The following program:
#!/usr/bin/perl -w
my $foo = 0;
sub foo
{
print "1. ", scalar(@_), "\n";
$foo |= 1 if (ref($_[0]));
print "2. ", scalar(@_), "\n";
$foo |= 2 if (ref(\$_[0]) eq 'GLOB');
print "3. ", scalar(@_), "\n";
}
foo();
print "$foo\n";
produces:
1. 0
2. 0
3. 1
0
Thanks.