#!/usr/local/bin/perl -- # -*- Perl -*-

# FixNewsrc
# V1.4HdG by Hans de Graaff <J.J.deGraaff@is.twi.tudelft.nl>
# This version strips all article numbers from unsubscribed groups

# v1.4 by Chris Davis <ckd@eff.org>
# based on V1.1 by Dan Wallach <dwallach@soda.berkeley.edu>

# run "fixnewsrc -help" for documentation and usage notes,
# see the sample files, look at README, or Use the Source, Luke.

# New feature in 1.4
#
# cleaned up the eval in sub insert, it's now evaling the loop instead
# of being within it.  This optimizes (/pat/) perl patterns; it now runs in
# much less time on my sample .news.favorite (with a 2500+ group .newsrc!)
#
#old: 44.0u 15.9s 1:10.66 84.9% 0+1080k 5+15io 0pf+0w
#new: 12.4u  9.7s 0:27.94 79.7% 0+1012k 3+15io 0pf+0w
# --ckd 91 Aug 09

# New features in 1.3
#
# Cleaned up some messages to print the true filename.
# added -s sortfile option (from Ed Vielmetti <emv@msen.com>)
# Fixed an array-slice masquerading as a scalar...
#
# --ckd 91 Aug 08

# New features in 1.2:
#
# Uses getopts.pl to allow the following new feature (so the help parsing
#  also changed)
#
# has -f file to allow using something other than $HOME/.newsrc.
#  (good for those GNUS users using .newsrc-nntpserver style files)
# --ckd 91 Jul 16

# New features in 1.1:
#
# handles arbitrary Perl patterns via eval (idea from Liam Quin's awk script)
# handles stranger and more obscure error cases (happy, Tom? :-)

# return true if it actually printed anything
sub counter {
    return 0 unless ((++$counter % 100) == 0);
    $prev_blurt = 0;
    print STDERR "$counter...";
    1;
}

sub tally_counter {
    print STDERR "$counter",(defined $verbosity)?" total\n\n":"\n";
}

sub blurt {
    return unless $verbosity;
    print STDERR "\n" unless $prev_blurt;
    print STDERR @_;
    $prev_blurt = 1;
}

sub insert {
	local($group) = split(/[:!]/, $_[0], 2);
	if(!defined $newsrc{$group}) {
	    &blurt("Warning: $group not in $newsrc_file!\n")
		if !defined($inserted{$group});
	    next;
	}

	&blurt(">> $_\n");
	&counter;
	push (@output, $newsrc{$group});
	$inserted{$group} = 1;
	delete $newsrc{$group};
}

sub print_favorites {
    print STDERR "Parsing favorites: ";
    favorite: foreach(<FAVORITE>) {
	chop;
	s/\s*\#.*$//;
	next if /^$/;

	if(/\(/) {
	    &blurt("Matching: $_\n");
	    $pattern = $_;
	    eval <<END_OF_EVAL;
	    foreach (\@newsrc) {
		    if ($pattern) {
			&insert(\$_);
		    }
	    }
END_OF_EVAL
	    &blurt("Match complete\n");
	    next favorite;
	}
	&insert($_);
    }
    &tally_counter;
}

#if(@ARGV == 1 && $ARGV[0] eq "-v") {
#    # verbose mode on
#    $verbosity = 1;
#    shift;
#}
require 'getopts.pl';		# and unfortunately require 3.0.44 or later
&Getopts("h:s:f:v");		# help, sortlist (favorites), file, verbose

if (@ARGV || $opt_h) {
    print STDERR <<NO_MORE_HELP;
fixnewsrc 1.4HdG by Hans de Graaff <J.J.deGraaff@IS.TWI.TUDelft.NL>
fixnewsrc 1.4 by Chris Davis <ckd@eff.org>
    based on fixnewsrc 1.1 by Dan Wallach <dwallach@soda.berkeley.edu>
             and patches by Ed Vielmetti<emv@msen.com>

Usage: $0       [-v] [-f file] [-s favoritefile] [any other argument]
    -v == more verbose
    -f == use file instead of .newsrc
    -s == sort by this file instead of .news.favorite
    anything else == this help message

This program sorts your .newsrc, putting groups you read on top.  In addition,
if you have a file in your home directory called .news.favorite, then the
list of newsgroups in this file appear at the top of your .newsrc, so you
can still read groups in your favorite order.

Put any Perl expression you want to describe your group in parenthesis, and
that's good, too.  If it's not in parenthesis, it's considered to be exact.
Remember: you're matching on :'s and !'s, too.

# Example:
rec.humor.funny                        # comments, and blank lines are cool
alt.fan.warlord
ucb.computing.announce
comp.lang.perl
(/comp\\.text\\..*/ && (!/comp\\.text\\.tex/))  # comp.text everything but tex
# Here's a more complicated one which matches "nas" and "nas.msgs"
# but not "nasa.nudge" or "arc.nasamail.arc"
(/^nas\\..*/ || /^nas[:!]/)
NO_MORE_HELP
    exit 0;
}

$verbosity = $opt_v;
$newsrc_file = $opt_f || "$ENV{HOME}/.newsrc";
$favorite_file = $opt_s || "$ENV{HOME}/.news.favorite";
die "No .newsrc file!  Crapped out at" unless -e "$newsrc_file";
open(NEWSRC, "<$newsrc_file") ||
    die "Can't open $newsrc_file: $!, crapped out at";

# we want to keep this associative array around for printing favorites
# so if we've already printed something, we just delete it from the
# associative array, and go on.

print STDERR "Reading groups: ";
$counter = 0;
foreach(<NEWSRC>) {
    chop;
    next if /^$/;
    &counter;
    $fullentry = $_;
    s/[:!].*$//;
    &blurt("Warning: $_ appears more than once!\n") if defined($newsrc{$_});
    $newsrc{$_} = $fullentry;
}
&tally_counter;

print STDERR "Sorting..." if $verbosity;
@newsrc = sort values %newsrc;
print STDERR "Done\n" if $verbosity;
# output time... clear the counter and let's deal with the favorites file
$counter = 0;

if (open(FAVORITE, $favorite_file)) {
    &print_favorites;
} else {
    print STDERR "Couldn't find $favorite_file.  Just sorting $newsrc_file.\n";
}

# yeah, we have to do it twice... It's good enough...
undef @newsrc;
print STDERR "Sorting again..." if $verbosity;
@newsrc = sort values %newsrc;
print STDERR "Done\n" if $verbosity;
print STDERR "Generating output: ";

#
# I could just grep through the array for :'s then !'s, but that requies
# making two passes.  This works in one pass.
#
foreach(@newsrc) {
    &counter;
    if(/:/) {
	push (@output, $_);
    } elsif (/!/) {
        # This is an unsubscribed line, so I might just as well
        # clean it up a bit. Amazing how that shrinks the .newsrc
        # file. Especially with much-crossposted groups, like news.groups
        ($first_part) = split(/ /);
	push (@output2, $first_part);
    }
}
&tally_counter;

close(NEWSRC);
rename($newsrc_file,"${newsrc_file}.bak") ||
    die "Can't rename ${newsrc_file}: $!, crapped out at";

open(NEWSRC, ">$newsrc_file") || die "Can't open $newsrc_file for writing: $!, crapped out at";

$\ = $, = "\n";
print NEWSRC @output, @output2;
