Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!uunet!munnari.oz.au!comp.vuw.ac.nz!ajv
From: Andrew.Vignaux@comp.vuw.ac.nz (Andrew Vignaux)
Newsgroups: comp.lang.perl
Subject: Re: This looks like a job for Perl Man (NNTP)
Message-ID: <1990Sep28.114129.27485@comp.vuw.ac.nz>
Date: 28 Sep 90 11:41:29 GMT
References: <20550@orstcs.CS.ORST.EDU> <18409:Sep2703:08:1290@kramden.acf.nyu.edu>
Sender: news@comp.vuw.ac.nz (News Admin)
Organization: Comp Sci, Victoria University, Wellington, New Zealand.
Lines: 378
Nntp-Posting-Host: downstage.comp.vuw.ac.nz
Originator: ajv@downstage.comp.vuw.ac.nz


> In article <20550@orstcs.CS.ORST.EDU> pvo@sapphire.OCE.ORST.EDU (Paul O'Neill) writes:
> remap_news would read a user's .newsrc file, connect to oldserver and convert
> read articles to message #'s, connect to newserver and convert those
> message #'s to article numbers and then construct a new .newsrc file.

> Uh, I don't suppose anyone's already done this?  Heh, heh.

If you are planning to write something I suggest you don't start with
this quick hack which seems to work but I've forgotten how ;-)  I only
needed it once and it does work although it makes a few mistakes.
When I looked at it just now, I discovered a "next line" with no
"line" label -- as I said, it hasn't been well tested.

Looking back on it I can see how my perl coding has changed (e.g. this
was before I discovered the joy of defined() :-)

read_heuristic seems to try to fix a bug, but I'm not sure what it
was.  I think our new server had a larger expiry time, so it was
marking 2 week old articles which had expired from the old server as
unread on the new server.  The scripts were obviously hacked to fix
this (see %EXISTS, min_num, etc.).  "program archaeology" -- the new
hacker's game.

As Dan mentioned, your min article field better be nearly accurate or
it will construct some large lists.

In my case the read list will almost certainly be smaller than the
unread list :-(

Andrew
-- 
Domain address: Andrew.Vignaux@comp.vuw.ac.nz

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  rc2msgs msgs2rc
# Wrapped by ajv@downstage.comp.vuw.ac.nz on Fri Sep 28 23:26:03 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'rc2msgs' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'rc2msgs'\"
else
echo shar: Extracting \"'rc2msgs'\" \(2476 characters\)
sed "s/^X//" >'rc2msgs' <<'END_OF_FILE'
X#!/usr/bin/perl
X
Xif ($#ARGV < $[) {
X	print STDERR "usage: $0 server\n"; exit (1);
X}
X$server = shift (@ARGV);
X
X$response = do server_init($server);
Xif ($response < 0) {
X	die "Can't get active file from server $server.";
X}
X
Xwhile (<>) {
X	unless (/^(\S+)([:!])\s*(.*)\s*/) {
X		warn "bad newsrc line\t$_\n";
X		next;
X	}
X	($group,$sub,$rest) = ($1,$2,$3);
X
X	do put_server ("GROUP $group");
X	$line = do get_server ();
X	unless ($line =~ /^211/) {
X		warn "can't find $group";
X		next line;
X	}
X		
X	print "$sub\t$group\n";
X
X	foreach $clump (split(/,/, $rest)) {
X		do put_server ("XHDR Message-ID $clump");
X		$line = do get_server();
X
X		unless ($line =~ /^221/) {
X			warn "Can't scan $group $clump\n";
X			next;
X		}
X
X		$last_num = -99;
X		while ($_ = do get_server())
X		{
X			last if (/^\./);
X			($num, $id) = split;
X			next unless ($num > $last_num);
X			print "\t$id\n";
X			$last_num = $num;
X		}
X	}
X}
Xdo close_server();
X
Xsub server_init
X{
X	local($host,$sockaddr,$pinet,$inet,$stream,$name,$aliases,
X	      $proto,$port,$type,$len,$addr,$ok);
X	$host = $_[0];
X	$sockaddr = 'S n a4 x8';
X	$pinet = $inet = 2;
X	$stream = 1;
X
X	($name, $aliases, $proto) = getprotobyname('tcp');
X	($name, $aliases, $port) = getservbyname('nntp', 'tcp');
X	if ((($name, $aliases, $type, $len, $addr) = 
X			gethostbyname($host)) == 0) {
X		$addr = do inet_addr($host);
X	}
X
X	$serv = pack($sockaddr, $inet, $port, $addr);
X	socket(S, $pinet, $stream, $proto) || die "socket: $!";
X	connect(S, $serv) || die "connect: $!";
X
X	$_ = do get_server();
X	$ok = -1;
X	check: {
X		if (/^20[01]/) { $ok = 0; last check; }
X		if (/^502/) {
X			print "This machine does not have permission to use the $host news server.\n";
X			last check;
X		}
X		print "Unexpected response code from $host news server\n";
X	}
X	$ok;
X}
X
Xsub get_server
X{
X	$_ = <S>; chop; chop; $_;
X}
X
Xsub put_server
X{
X	send(S, "$_[0]\r\n", 0);
X}
X
Xsub close_server
X{
X	do put_server('QUIT');
X	do get_server();
X}
X
Xsub inet_addr
X{
X	@parts = split(/\./, $_[0]);
X	bit: {
X		if ($#parts == 0) { 
X			$val = $parts[0]; last bit; }
X		if ($#parts == 1) { 
X			$val = ($parts[0] << 24) | ($parts[1] & 0xffffff);
X			 last bit; }
X		if ($#parts == 2) { 
X               		$val = ($parts[0] << 24) | (($parts[1] & 0xff) << 16) |
X                        	($parts[2] & 0xffff);
X			last bit; }
X		if ($#parts == 3) { 
X                	$val = ($parts[0] << 24) | (($parts[1] & 0xff) << 16) |
X                      		(($parts[2] & 0xff) << 8) | ($parts[3] & 0xff);
X			last bit; }
X	}
X	pack("N", $val);
X}
END_OF_FILE
if test 2476 -ne `wc -c <'rc2msgs'`; then
    echo shar: \"'rc2msgs'\" unpacked with wrong size!
fi
chmod +x 'rc2msgs'
# end of 'rc2msgs'
fi
if test -f 'msgs2rc' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'msgs2rc'\"
else
echo shar: Extracting \"'msgs2rc'\" \(3654 characters\)
sed "s/^X//" >'msgs2rc' <<'END_OF_FILE'
X#!/usr/bin/perl
X
Xif ($#ARGV < $[) {
X	print STDERR "usage: $0 server\n"; exit (1);
X}
X$server = shift (@ARGV);
X
X$response = do server_init($server);
Xif ($response < 0) {
X	die "Can't get active file from server $server.";
X}
X
X$| = 1;
X$group = "";
X$sub = "";
X@NUMS = ();
Xwhile (<>) {
X	chop; ($command,$id) = split ('\t');
X	if ($command ne "") {
X		do read_heuristic ();
X		do emit_newsrc ($group, $sub, @NUMS) if ($group ne "");
X		$group = $id;
X		$sub = $command;
X
X		do put_server ("GROUP $group");
X		$line = do get_server ();
X		unless ($line =~ /^211\s*\d*\s*(\d*)\s*(\d*)/) {
X			warn "can't find $group";
X			next;
X		}
X		($bot,$top) = ($1,$2);
X
X		do put_server ("XHDR Message-ID $bot-$top");
X		$line = do get_server();
X
X		unless ($line =~ /^221/) {
X			warn "Can't scan $group\n";
X			next;
X		}
X
X		undef %ID;
X		undef %EXISTS;
X		$last_num = -99;
X		while ($_ = do get_server())
X		{
X			last if (/^\./);
X			($num, $id) = split;
X			next unless ($num > $last_num);
X			$ID{$id} = $num;
X			$EXISTS{$num} = $id;
X			$last_num = $num;
X		}
X		@NUMS = ();
X		$min_num = 1e20;
X		next;
X	}
X	$num = $ID{$id};
X	if ($num eq "") {
X		warn "Can't find $group:$id\n";
X		next;
X	}
X	$min_num = $num if ($#NUMS < $[ || $num < $min_num);
X	push (@NUMS, $num);
X}
Xdo read_heuristic ();
Xdo emit_newsrc ($group, $sub, @NUMS);
X
Xdo close_server();
X
Xsub read_heuristic {
X	if ($#NUMS >= $[) {
X		if ($top > 0) {
X			foreach $num ($bot .. $top) {
X				push (@NUMS, $num) if ($EXISTS{$num} eq "");
X			}
X			foreach $num ($bot .. ($min_num-1)) {
X				push (@NUMS, $num);
X			}
X		}
X	}
X}
X
Xsub bynum { $a - $b; }
X
Xsub emit_newsrc {
X	local ($group, $sub, @nums) = @_;
X
X	print "$group$sub";
X
X	@sorted = sort bynum @nums;
X	if ($#sorted < $[) {
X		$first = $last = -99;
X	}
X	else {
X		print " 1";
X		$first = 1;
X		$last = $bot-1;
X	}
X
X	foreach $num (@sorted) {
X		next if ($num == $last);
X		if ($num == $last+1) {
X			;
X		}
X		else {
X			if ($last != -99) {
X				print "-$last" if ($first != $last);
X				print ",";
X			}
X			print "$num";
X			$first = $num;
X		}
X		$last = $num;
X	}
X	if ($last != -99) {
X		print "-$last" if ($first != $last);
X	}
X	print "\n";
X}
X
Xsub server_init
X{
X	local($host,$sockaddr,$pinet,$inet,$stream,$name,$aliases,
X	      $proto,$port,$type,$len,$addr,$ok);
X	$host = $_[0];
X	$sockaddr = 'S n a4 x8';
X	$pinet = $inet = 2;
X	$stream = 1;
X
X	($name, $aliases, $proto) = getprotobyname('tcp');
X	($name, $aliases, $port) = getservbyname('nntp', 'tcp');
X	if ((($name, $aliases, $type, $len, $addr) = 
X			gethostbyname($host)) == 0) {
X		$addr = do inet_addr($host);
X	}
X
X	$serv = pack($sockaddr, $inet, $port, $addr);
X	socket(S, $pinet, $stream, $proto) || die "socket: $!";
X	connect(S, $serv) || die "connect: $!";
X
X	$_ = do get_server();
X	$ok = -1;
X	check: {
X		if (/^20[01]/) { $ok = 0; last check; }
X		if (/^502/) {
X			print "This machine does not have permission to use the $host news server.\n";
X			last check;
X		}
X		print "Unexpected response code from $host news server\n";
X	}
X	$ok;
X}
X
Xsub get_server
X{
X	$_ = <S>; chop; chop; $_;
X}
X
Xsub put_server
X{
X	send(S, "$_[0]\r\n", 0);
X}
X
Xsub close_server
X{
X	do put_server('QUIT');
X	do get_server();
X}
X
Xsub inet_addr
X{
X	@parts = split(/\./, $_[0]);
X	bit: {
X		if ($#parts == 0) { 
X			$val = $parts[0]; last bit; }
X		if ($#parts == 1) { 
X			$val = ($parts[0] << 24) | ($parts[1] & 0xffffff);
X			 last bit; }
X		if ($#parts == 2) { 
X               		$val = ($parts[0] << 24) | (($parts[1] & 0xff) << 16) |
X                        	($parts[2] & 0xffff);
X			last bit; }
X		if ($#parts == 3) { 
X                	$val = ($parts[0] << 24) | (($parts[1] & 0xff) << 16) |
X                      		(($parts[2] & 0xff) << 8) | ($parts[3] & 0xff);
X			last bit; }
X	}
X	pack("N", $val);
X}
END_OF_FILE
if test 3654 -ne `wc -c <'msgs2rc'`; then
    echo shar: \"'msgs2rc'\" unpacked with wrong size!
fi
chmod +x 'msgs2rc'
# end of 'msgs2rc'
fi
echo shar: End of shell archive.
exit 0