summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/site/lib/LWP/Protocol/nntp.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/site/lib/LWP/Protocol/nntp.pm')
-rw-r--r--Master/tlpkg/tlperl/site/lib/LWP/Protocol/nntp.pm129
1 files changed, 66 insertions, 63 deletions
diff --git a/Master/tlpkg/tlperl/site/lib/LWP/Protocol/nntp.pm b/Master/tlpkg/tlperl/site/lib/LWP/Protocol/nntp.pm
index 788477d488a..9727a247a51 100644
--- a/Master/tlpkg/tlperl/site/lib/LWP/Protocol/nntp.pm
+++ b/Master/tlpkg/tlperl/site/lib/LWP/Protocol/nntp.pm
@@ -1,9 +1,8 @@
package LWP::Protocol::nntp;
-
+$LWP::Protocol::nntp::VERSION = '6.25';
# Implementation of the Network News Transfer Protocol (RFC 977)
-require LWP::Protocol;
-@ISA = qw(LWP::Protocol);
+use base qw(LWP::Protocol);
require HTTP::Response;
require HTTP::Status;
@@ -12,56 +11,57 @@ require Net::NNTP;
use strict;
-sub request
-{
- my($self, $request, $proxy, $arg, $size, $timeout) = @_;
+sub request {
+ my ($self, $request, $proxy, $arg, $size, $timeout) = @_;
$size = 4096 unless $size;
# Check for proxy
if (defined $proxy) {
- return HTTP::Response->new(&HTTP::Status::RC_BAD_REQUEST,
- 'You can not proxy through NNTP');
+ return HTTP::Response->new(HTTP::Status::RC_BAD_REQUEST,
+ 'You can not proxy through NNTP');
}
# Check that the scheme is as expected
- my $url = $request->uri;
+ my $url = $request->uri;
my $scheme = $url->scheme;
unless ($scheme eq 'news' || $scheme eq 'nntp') {
- return HTTP::Response->new(&HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "LWP::Protocol::nntp::request called for '$scheme'");
+ return HTTP::Response->new(HTTP::Status::RC_INTERNAL_SERVER_ERROR,
+ "LWP::Protocol::nntp::request called for '$scheme'");
}
# check for a valid method
my $method = $request->method;
unless ($method eq 'GET' || $method eq 'HEAD' || $method eq 'POST') {
- return HTTP::Response->new(&HTTP::Status::RC_BAD_REQUEST,
- 'Library does not allow method ' .
- "$method for '$scheme:' URLs");
+ return HTTP::Response->new(HTTP::Status::RC_BAD_REQUEST,
+ 'Library does not allow method ' . "$method for '$scheme:' URLs");
}
# extract the identifier and check against posting to an article
my $groupart = $url->_group;
- my $is_art = $groupart =~ /@/;
+ my $is_art = $groupart =~ /@/;
if ($is_art && $method eq 'POST') {
- return HTTP::Response->new(&HTTP::Status::RC_BAD_REQUEST,
- "Can't post to an article <$groupart>");
+ return HTTP::Response->new(HTTP::Status::RC_BAD_REQUEST,
+ "Can't post to an article <$groupart>");
}
- my $nntp = Net::NNTP->new($url->host,
- #Port => 18574,
- Timeout => $timeout,
- #Debug => 1,
- );
+ my $nntp = Net::NNTP->new(
+ $url->host,
+
+ #Port => 18574,
+ Timeout => $timeout,
+
+ #Debug => 1,
+ );
die "Can't connect to nntp server" unless $nntp;
# Check the initial welcome message from the NNTP server
if ($nntp->status != 2) {
- return HTTP::Response->new(&HTTP::Status::RC_SERVICE_UNAVAILABLE,
- $nntp->message);
+ return HTTP::Response->new(HTTP::Status::RC_SERVICE_UNAVAILABLE,
+ $nntp->message);
}
- my $response = HTTP::Response->new(&HTTP::Status::RC_OK, "OK");
+ my $response = HTTP::Response->new(HTTP::Status::RC_OK, "OK");
my $mess = $nntp->message;
@@ -74,66 +74,69 @@ sub request
# First we handle posting of articles
if ($method eq 'POST') {
- $nntp->quit; $nntp = undef;
- $response->code(&HTTP::Status::RC_NOT_IMPLEMENTED);
- $response->message("POST not implemented yet");
- return $response;
+ $nntp->quit;
+ $nntp = undef;
+ $response->code(HTTP::Status::RC_NOT_IMPLEMENTED);
+ $response->message("POST not implemented yet");
+ return $response;
}
# The method must be "GET" or "HEAD" by now
if (!$is_art) {
- if (!$nntp->group($groupart)) {
- $response->code(&HTTP::Status::RC_NOT_FOUND);
- $response->message($nntp->message);
- }
- $nntp->quit; $nntp = undef;
- # HEAD: just check if the group exists
- if ($method eq 'GET' && $response->is_success) {
- $response->code(&HTTP::Status::RC_NOT_IMPLEMENTED);
- $response->message("GET newsgroup not implemented yet");
- }
- return $response;
+ if (!$nntp->group($groupart)) {
+ $response->code(HTTP::Status::RC_NOT_FOUND);
+ $response->message($nntp->message);
+ }
+ $nntp->quit;
+ $nntp = undef;
+
+ # HEAD: just check if the group exists
+ if ($method eq 'GET' && $response->is_success) {
+ $response->code(HTTP::Status::RC_NOT_IMPLEMENTED);
+ $response->message("GET newsgroup not implemented yet");
+ }
+ return $response;
}
# Send command to server to retrieve an article (or just the headers)
my $get = $method eq 'HEAD' ? "head" : "article";
my $art = $nntp->$get("<$groupart>");
unless ($art) {
- $nntp->quit; $nntp = undef;
- $response->code(&HTTP::Status::RC_NOT_FOUND);
- $response->message($nntp->message);
- return $response;
+ $nntp->quit;
+ $response->code(HTTP::Status::RC_NOT_FOUND);
+ $response->message($nntp->message);
+ $nntp = undef;
+ return $response;
}
# Parse headers
- my($key, $val);
+ my ($key, $val);
local $_;
while ($_ = shift @$art) {
- if (/^\s+$/) {
- last; # end of headers
- }
- elsif (/^(\S+):\s*(.*)/) {
- $response->push_header($key, $val) if $key;
- ($key, $val) = ($1, $2);
- }
- elsif (/^\s+(.*)/) {
- next unless $key;
- $val .= $1;
- }
- else {
- unshift(@$art, $_);
- last;
- }
+ if (/^\s+$/) {
+ last; # end of headers
+ }
+ elsif (/^(\S+):\s*(.*)/) {
+ $response->push_header($key, $val) if $key;
+ ($key, $val) = ($1, $2);
+ }
+ elsif (/^\s+(.*)/) {
+ next unless $key;
+ $val .= $1;
+ }
+ else {
+ unshift(@$art, $_);
+ last;
+ }
}
$response->push_header($key, $val) if $key;
# Ensure that there is a Content-Type header
$response->header("Content-Type", "text/plain")
- unless $response->header("Content-Type");
+ unless $response->header("Content-Type");
# Collect the body
- $response = $self->collect_once($arg, $response, join("", @$art))
- if @$art;
+ $response = $self->collect_once($arg, $response, join("", @$art)) if @$art;
# Say goodbye to the server
$nntp->quit;