#!/usr/local/bin/perl -w

use strict;

my $id = '$Id: news.pl,v 1.10 2003/10/03 01:54:08 kono Exp $';
$id =~ s/[^\s]*://; $id =~ s/kono.*$//;

my $refile_folder="src";
my $msgid_org = "3987979news.pl\@";
my $from_len = 20;
my $sub_len = 40;
my $current= "$ENV{'HOME'}/.current-newsgroup";
my $newsgroup;
my $range;
my $all = 0;
my $mhlib = "/usr/local/mh/lib";
my $repl = 0;

use News::NNTPClient;
use NKF;

&current();

my $from_match; 
my $sub_match; 
my $nntp_server;

my @buf;
my @range;
my %head;
my %key;
my $references;
my $quote;
my $next;
my $next_num;
my $subject;
my $fsubject;
my $msgid;

my @monthname = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec");


if (! $ARGV[0]) {
} elsif ($ARGV[0]=~/^\+news\/(.*)/) {
    $newsgroup = $1;
    $newsgroup =~ s/\//./g;
    shift;
} elsif ($ARGV[0]!~/\./) {
} elsif ($ARGV[0]) {
    $newsgroup = $ARGV[0];
    shift;
}

while(defined($ARGV[0]) && $ARGV[0]=~/^[-+]/) {
    if ($ARGV[0]=~/-from/) {
	$from_match = $ARGV[1]; shift; shift;
    } elsif ($ARGV[0]=~/-sub/) {
	$sub_match = $ARGV[1]; shift; shift;
    } elsif ($ARGV[0]=~/-a/) {
	$all = 1; shift;
    } elsif ($ARGV[0]=~/-D/) {
	$nntp_server = $ARGV[1]; shift; shift;
    } elsif ($ARGV[0]=~/\+(.*)/) {
	$refile_folder = $1; shift;
    } else {
	die("unkown optionn $ARGV[0]");
    }
}

# print "$0\n";

my $c;

if ($nntp_server) {
    $c = new News::NNTPClient($nntp_server);
    $ENV{'NNTPSERVER'} = $nntp_server;
} else {
    $c = new News::NNTPClient;
}
$c->debug(0);

if ($0=~/flup/||$0=~/repl/) {
    &flup_open;
} elsif ($0=~/pnews/) {
    @buf = ();
    &new_draft();
    &post('','','');
    exit 0;
} elsif ($0=~/news/||$0=~/show/||$0=~/fuma/) {
    &show_open;
}

my ($first,$last) = $c->group($newsgroup) ;
$first or $last  or die("can't find newsgroup $newsgroup\n");

# print "$newsgroup $first-$last\n";

if(! @ARGV) {
    if ($0 =~ /sn/|| $0=~/scan/) {
	unshift(@ARGV,"last:20");
    } else {
	unshift(@ARGV,"cur");
    }
}

my ($from,$to,$now);

while(@ARGV) {
    $range=shift;
    @range = ();
    if ($range) {
	if (&term) {
	    if($range=~s/^-//) {
		$from = $to; &term;
		@range = $from .. $to;
	    } elsif ($range=~s/^:(\d+)//) {
		my $count = $1;
		$from = $to;
		for(;$from<=$last&&$count-->0;$from++) {
		    push(@range,$from) if ($c->stat($from));
		}
		for($from = $to-1;$from>=$first&&$count-->0;$from--) {
		    unshift(@range,$from) if ($c->stat($from));
		}
	    } elsif ($range=~s/^:-(\d+)//) {
		my $count = $1;
		$from = $to;
		for(;$from>=$first&&$count-->0;$from--) {
		    unshift(@range,$from) if ($c->stat($from));
		}
		for($from = $to+1;$from<=$last&&$count-->0;$from++) {
		    push(@range,$from) if ($c->stat($from));
		}
	    } else {
		@range = $to;
	    }
	}
    } else {
	@range = $now; # this can't happen
    }
    foreach my $from (@range) {
	if ($c->stat($from) ){ 
	    if ($0=~/sn/||$0=~/scan/) {
		&scan($from)
	    } elsif ($0=~/news/||$0=~/show/) {
		&show($from)
	    } elsif ($0=~/fuma/) {
		&fuma($from)
	    } elsif ($0=~/flup/) {
		&flup($from)
	    } elsif ($0=~/repl/) {
		$repl=1; &flup($from)
	    } elsif ($0=~/refile/) {
		&refile($from)
	    }
	}
    }
}

&save_current();

if ($0=~/news/||$0=~/show/) {
    &show_close;
} elsif ($0=~/flup/||$0=~/repl/) {
    &flup_close;
} elsif ($0=~/fuma/) {
    &fuma_close;
}

sub term {
    if ($range=~s/^last//) {
	$now = $to = $last;
	return 1;
    } elsif ($range=~s/^(\d+)//) {
	$now = $to = $1;
	return 1;
    } elsif ($range=~s/^all//) {
	@range = $first..$last;
	return 0;
    } elsif ($range=~s/^first//) {
	$now = $to =  $first;
	return 1;
    } elsif ($range=~s/^cur//) {
	$to = $now;
	return 1;
    } elsif ($range=~s/^next//) {
	while($now<$last && ! $c->stat(++$now) ){};
	$to = $now;
	return 1;
    } elsif ($range=~s/^prev//) {
	while($now>$first+1 && ! $c->stat(--$now) ){};
	$to = $now;
	return 1;
    }
    @range = $now;
    return 0;
}

sub scan {
    my ($first) = @_;
    my ($from,$subject,$froms,$subs);
    return if (!&header($first));

    my ($weekday,$mday,$monthname,$year,$time,$time_zone) = 
	&parse_date($head{'date'});
    my ($month) = &name_month($monthname);

    $from=$head{'from'};
    $subject=$head{'subject'};
    $froms = " "x$from_len; $subs = " "x$sub_len;
    substr($froms,0,$from_len) = substr(nkf('-e',$from),0,$from_len)." ";
    # substr($subs,0,$sub_len) = substr(nkf('-e',$subject),0,$sub_len)." ";
    $subs = nkf('-e',substr($subject,0,$sub_len))." ";
    printf "% 7d %04d/%02d/%02d %s %s\n",$first,$year,$month,$mday,$froms,$subs;
}

my $no_tty;

my $tmpfile;

sub show_open {
    $references = '';
    if (! -t STDOUT) { $no_tty = 1; }
    else {
	use Fcntl;
	use POSIX qw(tmpnam);
	$tmpfile = tmpnam();
	open(LESS,">$tmpfile") or die("can't open $tmpfile\n"); 
	select(LESS);
    }
}

sub show2 {
    my ($first) = @_;
    open(OUT,"|$mhlib/mhl -form mhl.news") or die("can't mhl");
    print OUT $c->article($first);
    close(OUT);
}

sub show {
    my ($first) = @_;

    my %printable = (
	'subject'=>1,
	'from'=>1,
	'message-id'=>1,
	'newsgroups'=>1,
    );

    print  ">>> $first\n";
    if ($all) {
	print  $c->article($first);
	print  "\n";
	return;
    }
    return if (!&header($first));
    foreach my $key (keys %printable) {
	print  "$key{$key}: ",$head{$key},"\n";
    }
    print  "--\n";
    foreach ($c->body($first)) {
	print  nkf('-em',$_);
    }
    print  "\n";
}

sub fuma {
    my ($first) = @_;

    return if (!&header($first));
    print  "In article $head{'message-id'},",
            nkf('-me',$head{'from'}),
           " writes\n";
    foreach ($c->body($first)) {
	print  "> ",nkf('-em',$_);
    }
    print  "\n";
    # $references .= $head{'references'} if ($head{'references'});
    $references =  $references." ".$head{'message-id'};
}

sub fuma_close {
    print &references;
    &show_close;
}

sub references {
    my $buf;
    if ($references) {
	$buf = "References:".&fold($references)."\n" ;
	$buf =~ s/[\s\n]+$/\n/g;
    } else {
	$buf = '';
    }
    return $buf;
}

sub show_close {
    if (! $no_tty) {
	close(LESS);
	system("less $tmpfile");
	unlink($tmpfile);
    }
}

sub flup_open {
    $references = '';
    $quote = "> ";
    @buf = ();
    &new_draft();
}

sub new_draft {
    $next=`mhpath +drafts new`;
    $next =~ /(\d+)$/;
    $next_num = $1;
}

sub header {
    my ($first) = @_;
    my ($data,$from,$key,$okey,$value);
    my @head = $c->head($first);
    %head = ();
    foreach (@head) {
	if (/^[ \t]/) {
	    $data = nkf('-me',$_); 
	    $data =~ s/\n//g;
	    $data =~ s/^\s*/ /;
	    $data =~ s/\s*$//;
	    $head{$key} .= $data;  next;
	} 
	if (/([^:]*):\s*(.*)/) {
	    $okey = $key = $1; $value=$2;
	    $key =~ tr/A-Z/a-z/;
	    $head{$key} = nkf('-me',$value);
	    $key{$key} = $okey;
	}
	if (/^From:\s*(.*)/i) { $from = $1 ; 
	    return 0 if ($from_match && $from!~/$from_match/);
	} elsif (/^Subject:\s*(.*)/i) { $subject = nkf('-me',$1);
	    return 0 if ($sub_match && $subject!~/$sub_match/);
	}
    }
    $fsubject = &re_subject($head{'subject'});
    $subject = $head{'subject'};
    return 1;
}

sub re_subject {
    my ($sub) = @_;
    $sub = nkf('-me',$sub);
    1 while($sub =~ s/^Re:\s*//);
    "Re: $sub";
}

sub flup {
    my ($first) = @_;
    my ($from,$subject,$key,$value);
    return if (!&header($first));
# foreach $key (keys %head) { print "$key=>$head{$key}\n"; }
    return if (!$head{'message-id'} ||!$head{'from'});
    $references .= $head{'references'} if ($head{'references'});
    $references =  $references." ".$head{'message-id'};
    push(@buf,<<"EOF");
In article $head{'message-id'}, $head{'from'} writes
EOF
    foreach ($c->body($first)) {
	push(@buf,$quote.nkf('-e',$_));
    }
    push(@buf,"\n");
}

sub flup_close {
    $fsubject ='' if (!$fsubject);
    $newsgroup ='local.test' if (!$newsgroup);
    &post($newsgroup,$fsubject,$references);
}

my %myhead;

sub fold
{
    my ($length,@field,$output);
    @field = split(/ /,$_[0]);
    for($length = 0;@field; $output .= " ".shift(@field)) {
	$length += length($field[0]);
	if($length>120) {
	    $length = 0;
	    $output .= "\n   ";
	}
    }
    return $output;
}

sub news_header_replace {
    if (/^Newsgroups:/i) {
	if ($head{'followup-to'}) {
	    $_ = "Newsgroups: $head{'followup-to'}\n";
	} else {
	    $_ = "Newsgroups: $newsgroup\n";
	}
	$myhead{'Newsgroups'} = 0;
    } elsif (/^Subject:/i) {
	$_ = "Subject: $fsubject\n";
	$myhead{'Subject'} = 0;
    } elsif (/^References:/i) {
	$_ = &references;
	$myhead{'References'} = 0;
    } elsif (/^Message-ID:/i) {
	if ($repl) {
	    $_='';
	    $myhead{'Message-ID'} = 0;
	} else {
	    $_ = "Message-ID: <$msgid>\n";
	    $myhead{'Message-ID'} = 0;
	}
    } elsif (/^X-Newsreader:/i) {
	$_ = "X-Newsreader: $id\n";
	$myhead{'X-Newsreader'} = 0;
    } elsif (/^Date:/i) {
	next if ($repl);
	$_ = "Date: " . &my_localtime(time);
    } elsif (/^To:/i) {
	$_ = '';
    }
    $_;
}

sub my_localtime {
# Tue, 22 Jul 2003 23:26:39 +0900
	my ($time) = @_;
        my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
                                                               localtime($time);
        my ($wday0) = ("Sun","Mon","Tue","Wed","Thu","Fri","Sat")[$wday];
        my ($mon0) = $monthname[$mon];
        my $offset = "+0900";
	return "$wday0, $mday $mon0 ".($year+1900).
          sprintf(" %02d:%02d:%02d",$hour,$min,$sec)." $offset\n";
}

sub name_month {
    my ($mname) = @_;
    my $i;
    for($i=0;$i<12 && $monthname[$i] ne $mname;$i++) {
    }
    return $i+1;
}

sub post {
    my($newsgroup,$subject,$references) = @_;

    %myhead = (
	    'Newsgroups'=>1,
	    'Subject'=>1,
	    'References'=>1,
	    'Message-ID'=>1,
	    'X-Newsreader'=>1,
	    'Date'=>1,
    );

    $references =~ s/[\n ]*$/ /;
    $msgid = &messageid();

    my $components = `mhpath +`;
    chop($components);$components .= "/components";

    open(DRAFT,">$next") or die("can't open $next");
    open(COMP,"<$components") or die("can't open $components");
    my $head=1;
    while(<COMP>) {
	if ($head==1) {
	    if (/^-/) {
		my $sep = $_;
		foreach my $key (keys %myhead) {
		    next if (! $myhead{$key} );
		    $_ = $key.":";
		    &news_header_replace();
		    print DRAFT;
		}
		if ($repl) {
		    my $replto=$head{'reply-to'}?$head{'reply-to'}:
			    $head{'from'};
		    print DRAFT "To: $replto\n" if ($replto);
		}
		$_ = $sep;
		$head = 2;
	    } else {
		next if (!&news_header_replace());
	    }
	} elsif ($head==2) {
	    # first empty line is replaced by referenced text
	    if (/^$/) {
		$head = 3 ;
		print DRAFT;
		foreach (@buf) {
		    print DRAFT nkf('-me',$_);
		}
	    } 
	}
	print DRAFT;
    }
    close DRAFT;
    if ($repl) {
	system("comp -use $next_num"); 
    } else {
	system("comp -use $next_num -whatnowproc postnews"); 
    }
}

sub refile  {
    my ($first) = @_;
    $next=`mhpath +$refile_folder new`;
    open(OUT,">$next") or die("can't open $next $!");
    print OUT $c->article($first);
    close(OUT);
}

sub messageid {
    $msgid =~ s/^(\d+)/$1+1/e;
    &save_current();
    $msgid;
}

sub current {
    if (open(CURRENT,"<$current")) {
	while(<CURRENT>) {
	    chop;
	    $newsgroup = $1 if(/Newsgroups: (.*)/); 
	    $now = $1 if(/Current: (.*)/); 
	    $msgid = $1 if(/Message-ID: (.*)/); 
	}
    }
    if (!$newsgroup) {
        $newsgroup = 'fj.test';
    }
    if (!$now) {
        $now = 1;
    }
    if (!$msgid || length($msgid) < 10) {
        $msgid = $msgid_org.`hostname`;
	chop($msgid);
    }
}

sub save_current {
    open(CURRENT,">$current") or die("cannot write current $!");
    print CURRENT "Newsgroups: $newsgroup\n"; 
    print CURRENT "Current: $now\n"; 
    print CURRENT "Message-ID: $msgid\n"; 
    close(CURRENT);
}

sub parse_date {
#    time zone はどうするんだ?
    my ($date) = @_;
    my ($weekday,$mday,$monthname,$year,$time,$time_zone);
    my (@date);
# Tue, 22 Jul 2003 23:26:39 +0900
    if (@date= ($date =~ /([A-Za-z]+),\s+(\d+)\s+([A-Za-z]+)\s+(\d+)\s+([:\d]+)\s+([-+0-9a-z]+)/i)) {
	($weekday,$mday,$monthname,$year,$time,$time_zone) = @date;
# 26 Mar 2003 05:14:20 +0900
    } elsif (@date= ($date =~ /(\d+)\s+([A-Za-z]+)\s+(\d\d\d\d)\s+([:\d]+)\s+([-+0-9A_Za-z]+)/i)) {
	($weekday,$mday,$monthname,$year,$time,$time_zone) = 
	    ('',@date);
    } else {
	print STDERR "date field parse error: $date\n";
    }
    if ($time_zone=~/GMT/) {
	$time_zone = "+000";
    }

    if (0) {
    print STDERR "$date=>\nweekday= $weekday,
mday= $mday,
monthname= $monthname,
year= $year,
time= $time,
time_zone= $time_zone\n";
    }
    return ($weekday,$mday,$monthname,$year,$time,$time_zone);
}