#!/usr/local/bin/perl
;#
;# newsrc: reorder ~/.newsrc file
;# Copyright (c) 1991-1994 Kazumasa Utashiro <utashiro@sra.co.jp>
;# Software Research Associates, Inc., Japan
;#
;; $rcsid = q$Id: newsrc,v 1.8 1994/04/19 12:55:00 utashiro Exp $;
;#
;# If you have ~/.newsorder file, it is read and reordering is done
;# according to the file.  Wildcard can be used in this file.  Using ! 
;# instead of . means exclusion of groups after !.  E.G., fj!{rec,soc}
;# matches all fj news groups other than fj.rec and fj.soc.
;#
;# Sample .newsorder file:
;#	sra!rec					# sra groups except sra.rec
;#	comp.bugs.4bsd.ucb-fixes
;#	fj!{rec,soc}				# fj groups except fj.{rec,soc}
;#	sra					# same as sra.rec in this case
;#	*mac[.!:]				# macintosh related groups
;#	fj
;#	comp.{sys,os,newprod,protocols,unix}
;#	comp
;#
;# You can put your favorite option in .newsorder file.  If the first
;# word in a comment line is "option", the rest of the line is
;# processed in the same way as command line option.  Next example
;# enables -c and -u option always when the command is invoked.
;#
;#	# option -c -u
;#

require('getopts.pl');
;#require 'usage.pl';
$option='rvshf:xuc'; @arglist=(
    '-:v:',
    'r::replace .newsrc',
    'v::verify only',
    's::show statistics',
    'h::show help message',
    'f:order-file:specify order file (default: ~/.newsorder)',
    'x::show diff',
    'u::move unsubscribed groups at the end',
    'c::compact number of unsubscribed group',
);
sub usage {
    print &Usage($0, $option, "[ newsrc-file ]", @arglist);
    print "$rcsid\n" if $rcsid =~ /:/;
    exit(1);
}

&Getopts($option) || &usage;
&usage if $opt_h;

@default_order = ('local', 'jp', 'iijnet', 'fj', 'comp');

$home=$ENV{'HOME'};
$newsrc = shift || "$home/.newsrc";
if (!-f $newsrc && -f "$home/.newsrc-$newsrc") {
    $newsrc = "$home/.newsrc-$newsrc";
}
$opt_f || (-f ($opt_f = "$newsrc.order")) || ($opt_f = "$home/.newsorder");
open(NEWSRC, $newsrc) || die "$newsrc: $!\n";
if (open(ORDER, $opt_f)) {
    while (<ORDER>) {
	chop;
	if (/^\s*#+\s*option\s+(-.*)/i) {		# option line
	    require 'shellwords.pl';
	    @ARGV = &shellwords($1);
	    &Getopts($option) || &usage;
	    next;
	}
	s/\s*#.*//;
	next if /^$/;
	push(@order, $_);
    }
    close(ORDER);
} else {
    warn "You don't have .newsorder file.\n";
    warn "Default order is used (@default_order)\n";
    @order = @default_order;
}
$uniqname='x000'; sub uniqname { $uniqname++; }
$other = 'others';

$scan="while (<NEWSRC>) {\n";
if ($opt_c) {
    $scan .= 's/(!\s+)(\d+)[^\d].*[^\d](\d+)$/$1$2-$3/;' . "\n";
}
$scan .= "push(\@unsubscribed, \$_), next if /!/;\n" if $opt_u;
for $pattern (@order, $other) {
    $_ = $pattern;
    $ary = '@' . &uniqname;
    $negex = '';
    if (index($_, '!') >= $[) {
	split(/!/, $_);
	$_ = $_[$[];
	$neg = &wildcard(join('.', grep(length, @_)));
	$negex = " && !/^${neg}[.:!]/";
    }
    $_ = &wildcard($_);
    $suffix = length($_) ? '[.:!]' : '';
    $scan .= "push($ary, \$_)";
    $scan .= ($_ ne $other) ? ", next if /^${_}$suffix/$negex;\n" : ";\n";
    $prnt .= "print sort $ary;\n";
    $stat .= "printf(\$statformat, \"$pattern\", 0+$ary, &uns($ary));\n"
	if $opt_s;
}
$scan .= "}\n";
$prnt .= "print sort \@unsubscribed;\n" if $opt_u;
$stat .= "printf(\$statformat, 'unsubscribed', 0+\@unsubscribed, &uns(\@unsubscribed));\n"
    if $opt_s && $opt_u;

if ($opt_v) {
    print $scan, $prnt, $stat;
    exit;
}

eval $scan;

if ($opt_s) {
    $statformat =
	$opt_u ? sprintf("%%-%ds: %%4d\n", &maxlen(@order))
	       : sprintf("%%-%ds: %%4d (%%3d +%%4d)\n", &maxlen(@order));
    eval $stat;
    exit;
}

if ($opt_r) {
    rename($newsrc, "$newsrc.BAK") || die "$newsrc: $!\n";
    unless (open(NEWSRC, ">$newsrc")) {
	rename("$newsrc.BAK", $newsrc) && die "$newsrc is recoverd\n";
	die "$!\n";
    }
    print STDERR "Attention: replacing $newsrc\n";
    print STDERR "Old file is remained as $newsrc.BAK\n";
    select(NEWSRC);
} elsif ($opt_x) {
    open(DIFF, "| diff $newsrc -");
    select(DIFF);
}
eval $prnt;
if ($@) {
    select(STDOUT);
    print "$@\n";
    if ($opt_r) {
	rename("$newsrc.BAK", $newsrc) && die "$newsrc is recoverd\n";
    }
    exit 1;
}

$opt_x && close DIFF;

######################################################################

sub uns {
    ($subscribed = grep(!/!/, @_), @_ - $subscribed);
}

sub maxlen {
    local($max);
    grep($max<length && ($max=length), @_);
    $max;
}

sub wildcard {
    local($_) = @_;
    s#\\?.#$_ = $&; s/\\?([_0-9A-Za-z])/$1/ || /\\./ || s/[*]/.*/ ||
	s/[|]/\$|^/ || tr/?{,}[]/.(|)[]/ || s/./\\$&/; $_;#ge;
    $_;
}

;#------------------------------------------------------------
;# usage.pl: make a string for usage line.
;#	by K. Utashiro <utashiro@sra.co.jp> on Sep 7 1990
;#	Revised by utashiro on Mar 16 1991
;#	Revised by utashiro on Mar 20 1991
;#
;# Syntax: &Usage($command, $option, $trailer, @arglist);
;#	$command: command name (maybe $0)
;#	$option:  option string same as &Getopt
;#	$trailer: trailer string (optional)
;#	@arglist: description for options which takes argument (optional)
;#		  format is "option character : argument : description"
;#		  where argument and description are optional.
;#		  special form '-:xyz' hides options -x, -y, -z.
;#
;# &Usage returns list of two strings where 1st string is for usage
;# line and 2nd is for description.
;#
;# Example:
;#	$opts = 'deg:u:s:x'; @arglist = (
;#		'-:x',			# means -x is secret option
;#		'd::debug',
;#		'g:group',
;#		'u:user:user name',
;#	);
;#	unless (&Getopts($opts)) {
;#		print &Usage($0, $opts, 'file ...', @arglist);
;#		exit(1);
;#	}
;#
;# Result:
;#	usage: sample [ -d ] [ -e ] [ -g group ] [ -u user ] [ -s : ] file ...
;#		-d       debug
;#		-u user  user name
;#
sub Usage {
    package usage; reset('a-z');
    local($cmd, $opt, $trailer, @arglist) = @_;
    for (@arglist) {
	($name, $arg, $desc) = split(/:/, $_, 3);
	if ($name eq '-') {
	    grep($hide{$_}++, split('', $arg)); next;
	}
	next if $hide{$name};
	$arg{$name} = $arg;
	$desc{$name} = $desc;
	$w = length($arg) if ($desc && $w < length($arg));
    }
    $cmd =~ s#.*/##;
    push(@usage, 'usage:', $cmd);
    while ($opt =~ /^\s*(.)(:?)/) {
	$opt = $';
	next if $hide{$1};
	push(@opts, $1);
	push(@usage, '[', "-$1");
	push(@usage, $arg{$1} || $2) if $2;
	push(@usage, ']');
    }
    push(@usage, $trailer) if $trailer;
    for (grep($desc{$_}, @opts)) {
	push(@desc, sprintf("\t-%s %-${w}s  %s\n", $_, $arg{$_}, $desc{$_}));
    }
    (join(' ', @usage)."\n", join('', @desc));
}
1;
;#------------------------------------------------------------