Article View: fj.lang.perl
Article #2402incnews: news article incorporator
From: Kenji Nagahashi
Date: Sat, 27 Jun 1992 14:49
Date: Sat, 27 Jun 1992 14:49
342 lines
10841 bytes
10841 bytes
$B$J$,$O$7!wElBg>pJs9)$G$9!#(J
$B8&5f<<$N%m!<%+%k%K%e!<%9$r(J MH $B$GFI$`$?$a$K$3$&$$$&%9%/%j%W%H$r:n(J$B$j$^$7(J
$B$?!#(JNNTP $B%5!<%P$K@\B3$7$F(J .newsrc $B$rFI$s$GL$FI5-;v$r(Jinbox$B%U%)%k%@$K(J
incorporate $B$7$?$"$H(J .newsrc $B$r99?7$7$^$9!#(J
$B0lHLE*$J;H$$J}$O(J
incnews [options] <nntpserver>
$B$G$9$,!"4D6-JQ?t(J NNTPSERVER $B$r8+(J$B$F$$$k$N$GIaDL$OC1$K(J incnews $B$G$9!#<g(J
$B$J%*%W%7%g%s$O(J
-n : $B5-;v$r<h$C$F$/$k%K%e!<%9%0%k!<%W$N%Q%?!<%s(J
-u : .newsrc $B$r99?7$7$J$$(J
-s : $B3F5-;v$NBjL>$rI=<($9$k$@$1$G(J incorporate $B$7$J$$!#(J
+<folder> : incorporate $B$9$k%U%)%k%@(J
$B%K%e!<%9%0%k!<%W$N%Q%?!<%s$O(J .newsrc $B$N(J options $BIw$K=q$-$^$9!#Nc$($P(J
incnews -n !all,fj.sources
$B$N$h$&$K(J($B:G=i$N(J !all $B$O>JN,$G$-$^$9(J) .newsrc $B$N(J options $B$b8+$F$$$k$N(J
$B$G!"F1$8$J$i$P(J$B;XDj$OI,MW$"$j$^$;$s!#%3%^%s%I%i%$%s$K$b(J options $B$K$b;X(J
$BDj$,$J$$>l9g$K$OA4It$N%K%e!<%9%0%k!<%W$+$i5-;v(J$B$r;}$C$F$3$h$&$H$7$^$9!*!*(J
$B$4Cm0U$r!D(J ($B4m$J$$;EMM$+$b$7$l$J$R(J (^^;)
$B$h$m$7$1$l$P;H$C$F$d$C$F2<$5$$!#(J$B$J$K$7$mIaDL$G$J$$%1!<%9$X$NG[N8$J$I$O(J
$B$m$/$K$7$F$$$J$$$N$G(J X-)$B!"%P%0%l%]!<%H$d2~NIE@$J$I$$$?$@$1$k$H(J$B9,$$$G$9!#(J
----------snip-------------snip-----------------snip------------
#! /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: incnews
# Wrapped by nag@emeraldus.mtl.t.u-tokyo.ac.jp on Sat Jun 27 23:23:17 1992
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'incnews' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'incnews'\"
else
echo shar: Extracting \"'incnews'\" \(7126 characters\)
sed "s/^X//" >'incnews' <<'END_OF_FILE'
X#!/usr/local/bin/perl
X#
X# incnews: incorporate news articles from NNTP server
X# Author: Nagahashi Kenji <nag@mtl.t.u-tokyo.ac.jp>
X#
X# $Id: incnews.pl,v 1.2 1992/06/27 14:22:34 nag Exp $
X# $Log: incnews.pl,v $
X# Revision 1.2 1992/06/27 14:22:34 nag
X# *** empty log message ***
X#
X# Revision 1.1 1992/06/27 14:09:11 nag
X# Initial revision
X#
Xdo 'sys/socket.ph' || die "Can't do sys/socket.ph";
X
X# configuration params
X$MHBIN='/usr/local/bin/mh'; # for inc
X$MHLIB='/usr/local/lib/mh'; # for recvstore
X#
X$inctemp = "/tmp/inc$$";
X
X$useinc=1; $truncatetmp='-truncate';
X
Xsub usage {
X print <<___;
XUsage: incnews [options] [nntpserver]
X options:
X -q : be quiet.
X -n : newsgroup pattern to get article from (a la options line in .newsrc)
X -p : NNTP port number
X -u : do not update .newsrc
X -s : just list Subject: lines (implies -u)
X___
X exit(0);
X}
Xwhile($_=$ARGV[0], /^-/){
X /^\+/ && ($folder=$_, shift, next);
X /^-d/ && ($debug=1, $truncatetmp='', $|=1, shift, next);
X /^-q/ && ($quiet=1, shift, next);
X /^-n/ && do{
X $_=$ARGV[1]; $_="!all," . $_ unless /^!all,/;
X $limitng=do compile_ngpattern($_), shift, shift, next;
X };
X /^-p/ && ($port=$ARGV[1], shift, shift, next);
X /^-u/ && ($noupdate=1, shift, next);
X /^-s/ && ($justsubjects=1, $noupdate=1, shift, next);
X /^-help/ && do usage();
X #/^-i/ && ($useinc=1, shift, next);
X die "Unknown option $_\n";
X}
X
X$HOME=$ENV{'HOME'};
X$dotdir=$ENV{'DOTDIR'} || $HOME;
X$nntpserver = $#ARGV == -1 ? $ENV{'NNTPSERVER'} : $ARGV[0];
X$nntpservice = $port || ($#ARGV >= 0 && $ARGV[1]) || 119;
X$newsrc = "$dotdir/.newsrc-$nntpserver";
X
Xdie "Which NNTP server to connect?\n" unless $nntpserver;
Xif(! -f $newsrc){ $newsrc = "$HOME/.newsrc"; }
X
X# open connection to the NNTP server host.
X$struct_sockaddr = 'Sna4x8';
Xsocket(S, &PF_INET, &SOCK_STREAM, 0) || die("socket: $!\n");
X$addr = (gethostbyname($nntpserver))[4];
Xdie("$nntpserver: Unknown host\n") unless $addr;
X$server = pack($struct_sockaddr, &AF_INET, $nntpservice, $addr);
Xprint "Trying to connect to $nntpserver\n" if $debug;
Xconnect(S, $server) || die("connect: $!\n");
Xprint "Connected to $nntpserver\n" if $debug;
Xselect(S); $|=1; select(stdout);
X
X# read newsrc
Xprint "reading $newsrc\n" if $debug;
Xopen(N, $newsrc) || die("$newsrc: $!\n");
Xwhile(<N>){
X chop;
X ?^options\s+? && ($optionsline = $_, do setoptions($'), next);
X push(@newsrc, $_);
X}
Xclose(N);
X
X# get active newsgroup list.
Xprint "reading active list\n" if $debug;
X$_=<S>;
Xprint S "LIST\n";
X$_=<S>; die("$_\n") if ! /^215/;
X
X# for fast matching.
X$loopcode =<<'_';
Xwhile($_=<S>, $_ ne ".\r\n"){
X chop; ($_, $l, $f) = split;
X_
X $loopcode .=<<"_" if $limitng;
X next unless $limitng;
X_
X $loopcode .=<<'_' if $debug;
X printf("%s[%d-%d]\n", $_, $f, $l);
X_
X $loopcode .=<<'_';
X $active{$_}=pack('I2',$f,$l);
X}
X_
X
Xprint $loopcode if $debug;
Xeval $loopcode;
X
Xprint "checking new news\n" if $debug;
X
X# main loop
Xforeach $line (@newsrc){
X $_=$line;
X
X next unless /(\S*)([:!])\s*(\S*)/;
X next if $2 eq '!'; # user unscribes
X next if !$active{$ng = $1}; # not exist or user excluded.
X ($first,$last) = unpack('I2',$active{$ng});
X next if $first > $last; # all news has been expired.
X
X if((@rl = split(/,/,($rl = $3)))){
X $read = $rl[$#rl];
X $read =~ /\d+-(\d+)/ && ($read = $1); $read++;
X }
X else{ $read = 1; } # no article read.
X print "$ng[$first-$last] $read\n" if $debug;
X
X $toread = $read > $first ? $read : $first;
X next if $last < $toread; # no article to get.
X
X if((@_ = do setng($ng))){
X # `first' in active does not always tell the truth.
X next if $_[1] > $toread && ($toread = $_[1]) < $last;
X
X if($justsubjects){
X do showxhdr($toread, $last) unless $cannot_xhdr;
X if($cannot_xhdr){
X foreach $art ($toread..$last){
X do showsubject($art);
X }
X }
X }
X else{
X foreach $art ($toread..$last){
X do getarticle($art);
X }
X }
X print "\n";
X }
X next if $noupdate;
X
X # update rl
X if(@rl && $read == $toread){
X $hyp = ($rl[$#rl] =~ /(\d+)-(\d+)/);
X $hyp ? ($rl[$#rl] = "$1-$last") : ($rl[$#rl] .= "-$last");
X }
X else{
X push(@rl, $toread == $last ? $toread : "$toread-$last");
X }
X $rl=join(',', @rl);
X $line="$ng: $rl"; # replace the line
X}
Xprint S "QUIT\n";
X$_=<S>; warn "$_\n" if ! /^205/;
Xclose(S);
X# incorporate article from saved tempfile.
X# -truncate ha 'inc' no "... not zeroed" toiu message wo osaeru tameni
X# tukete iru.
Xif($useinc && !$justsubjects && -f $inctemp){
X $res = system "$MHBIN/inc $folder -file $inctemp $truncatetmp";
X $res != 0 && do{
X warn "inc failed.\n"; $noupdate = 1;
X };
X}
Xunlink($inctemp) unless $debug;
Xprint "updating $newsrc\n" if $debug && !$noupdate;
Xdo update_newsrc() unless $noupdate;
Xexit(0);
X
X#----------------------------------------------------------------
Xsub setoptions {
X local($opt)=@_;
X
X print "options $opt\n" if $debug;
X @options = split(/\s+/,$opt);
X while(($_=$options[0])){
X /^-n/ && do{
X shift(@options);
X # ignore options line if user gives command line options.
X $limitng = do compile_ngpattern($options[0]) unless $limitng;
X };
X shift(@options);
X }
X next;
X}
X
Xsub setng {
X local($ng)=@_;
X local($res);
X
X print "$ng: ";
X
X print S "GROUP $ng\r\n";
X $res=<S>;
X if($res =~ /^211\s/){ (split(/\s+/, $'))[0,1,2]; }
X else{ print $res; (); }
X}
X
Xsub showxhdr {{
X local($from, $to) = @_;
X local($res);
X
X print S "XHDR subject $from-$to\r\n";
X $res = <S>;
X do { $cannot_xhdr = 1; last; } if $res =~ /^500/;
X do { print $res; last; } if $res !~ /^2/;
X while(<S>){
X last if $_ eq ".\r\n";
X s/\r\n$//;
X print "\n ",$_;
X }
X}}
X
Xsub showsubject {{
X local($art)=@_;
X local($res);
X
X print S "HEAD $art\r\n";
X $res=<S>;
X last if $res =~ /^423/; # calceled
X do { print $res; last; } if $res !~ /^2/;
X while(<S>){
X last if $_ eq ".\r\n";
X /^Subject:\s*/ && do{
X ($_ = $') =~ s/\r\n$//;
X print "\n $art: $_";
X }
X }
X}}
X
Xsub getarticle {{
X local($art)=@_;
X local($res);
X
X print S "ARTICLE $art\r\n";
X $res=<S>;
X last if $res =~ /^423/; # canceled
X do { print $res; last; } if $res !~ /^2/;
X
X print "$art ";
X $rcvstore=$useinc ?
X ">>$inctemp" :
X "|$MHLIB/rcvstore";
X open(INC, $rcvstore) || die "$rcvstore: $!\n";
X print INC "From news\n" if $useinc; # dummy From
X while($res=<S>){
X last if $res eq ".\r\n";
X $res =~ s/\r\n$/\n/;
X print INC $res;
X }
X print INC "\n";
X close(INC);
X}}
X
Xsub compile_ngpattern {
X local($pattern)=@_;
X local($code, @p, $pat, $not);
X $code = '1';
X foreach (split(/,/,$pattern)){
X $not = s/^!//;
X @p = split(/\./);
X foreach (@p){ $_='\S+' if $_ eq 'all'; }
X $pat = '/^' . join('.', @p) . '(\.|$)/';
X if($not){ $code = "($code && !$pat)"; }
X else{ $code = "($code || $pat)"; }
X }
X $code;
X}
X
Xsub update_newsrc {
X do{
X open(N, ">$newsrc") || die("writing $newsrc: $!\n");
X select(N);
X } unless $debug;
X print $optionsline,"\n" if $optionsline;
X foreach (@newsrc){ print $_,"\n"; }
X select(STDOUT);
X}
END_OF_FILE
if test 7126 -ne `wc -c <'incnews'`; then
echo shar: \"'incnews'\" unpacked with wrong size!
fi
chmod +x 'incnews'
# end of 'incnews'
fi
echo shar: End of shell archive.
exit 0
------------snip------------snip--------------snip------------
--
$B""(J $BD966(J $B8-;y(J$B!'El5~Bg3XBg3X1!9)3X7O8&5f2J>pJs9)3X@l96(J $BEDCf1QI'8&5f<<(J $B#M#2(J
$B""(J E-mail: nag@mtl.t.u-tokyo.ac.jp
Technical Details
Message-ID:
<NAG.92Jun27234944@arcadia.mtl.t.u-tokyo.ac.jp>Path:
arc1-ca.pugleaf.net!sparky!uunet!ccut!news.u-tokyo.ac.jp!enterprise!keisu3!nagShow Full Headers
Complete Article Headers
X-Google-Language: Japanese,JIS X-Google-Thread: 1043e7,235e2b58dbc1369b,start X-Google-Attributes: gid1043e7,public X-Google-ArrivalTime: 1992-06-27 04:05:44 PST Path: arc1-ca.pugleaf.net!sparky!uunet!ccut!news.u-tokyo.ac.jp!enterprise!keisu3!nag From: nag@mtl.t.u-tokyo.ac.jp (Kenji Nagahashi) Newsgroups: fj.lang.perl Subject: incnews: news article incorporator Message-ID: <NAG.92Jun27234944@arcadia.mtl.t.u-tokyo.ac.jp> Date: 27 Jun 92 14:49:44 GMT Sender: news@keisu-s.t.u-tokyo.ac.jp Reply-To: nag@mtl.t.u-tokyo.ac.jp Distribution: fj Organization: University of Tokyo, Tokyo, Japan. Lines: 342 Nntp-Posting-Host: arcadia