/usr/share/doc/libnews-nntpclient-perl/examples/NNTPHuge.pm is in libnews-nntpclient-perl 0.37-8.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 | #! /usr/bin/perl
# I didn't write this. Someone sent it to me and I've decided to
# include it for your amusement.
#
# -- Rodger Anderson, 1999-06-11
# This module provides replacements for ihave and squirt to handle the
# sending of very large files.
require 5.000;
use Carp;
use News::NNTPClient;
@ISA = qw(News::NNTPClient);
$VERSION = '@(#) $Revision: 0.2 $';
# Transfer an article.
sub ihave {
my $me = shift;
my $firstArgRef = (@_ > 0) ? ref $_[0] : undef;
my $msgid;
unless (defined $firstArgRef) {
# first arg is a scalar (or not there), so assume it's the
# original style call where the message id & article lines
# are all packed into an array
$msgid = shift || "";
$me->command("IHAVE $msgid") or return;
$me->squirt(@_);
} elsif ($firstArgRef eq 'HASH') {
my $header = shift;
my ($msgIdKey) = grep /^message-id$/i, keys %$header;
defined $msgIdKey or return;
$msgid = $header->{$msgIdKey};
$me->command ("IHAVE $msgid") or return;
$me->squirt ($header, @_);
} else {
croak "bad argument to ihave (got a $firstArgRef)\n";
}
}
sub squirt {
my $me = shift;
my $firstArgRef = (@_ >= 0) ? ref $_[0] : undef;
local $\ = ""; # Guarantee that no other EOL is in use
my $SOCK = $me->{SOCK};
1 < $me->{DBUG} and warn "$SOCK sending ${\scalar @_} lines\n";
unless (defined $firstArgRef) {
# everything's in an array
local ($_); # moved out of for loop
foreach (@_) {
# Print each line, possibly prepending a dot for lines
# starting with a dot and trimming any trailing \n.
s/^\./../;
s/\n$//;
print $SOCK "$_\015\012";
}
} elsif ($firstArgRef eq 'HASH') {
my $header = shift;
my $body = shift;
my ($key, $val);
while (($key, $val) = each %$header) {
print $SOCK "$key: $val\015\012";
}
print $SOCK "\015\012";
if (ref $body eq 'ARRAY') {
local $_;
foreach (@$body) {
s/^\./../;
s/\n$//;
print $SOCK "$_\015\012";
}
} elsif (ref $body eq 'SCALAR') {
my ($fh) = $$body;
# This is a complete kludge! How do I fully qualify an indirect
# filehandle properly... This just looks for the caller's
# package
unless ($fh =~ /::/ || $fh =~ /'/) {
my ($depth, $pack);
$depth = 0;
while (($pack) = caller ($depth)) {
last unless $pack eq 'News::NNTPClient';
$depth++;
}
$fh = join '::', $pack, $fh if defined $pack;
}
while (<$fh>) {
s/^\./../;
s/\n$//;
print $SOCK "$_\015\012";
}
} else {
croak "bad second argument to squirt\n";
}
} else {
croak "bad first argument to squirt (got a $firstArgRef)\n";
}
print $SOCK ".\015\012"; # Terminate message.
1 < $me->{DBUG} and warn "$SOCK done sending\n";
$me->response;
}
1;
|