Source Code 1992 March/Source_Code_CD-ROM_Walnut_Creek_March_1992.iso/usenet/altsrcs/3/3476

Internet Message Format | 1991-06-10 | 5KB

From: [e-mail] (Dan Wallach)
Newsgroups: comp.lang.perl,alt.sources
Subject: Yet another newsrc fixer, new and improved.
Message-ID: <[e-mail]>
Date: 11 Jun 91 06:26:54 GMT

Well, I've gotten some interesting feedback about my newsrc fixer.
It appears that you need a fairly recent version of perl to make it
work, as older versions barf on the $ENV{...} stuff.  Well, I don't
have docs for anything before version 4, and I'm fairly happy that
it works under 3, pl.44.  I'll eventually figure out how to make this
thing totally portable, but until then...

Here's version 1.1 of fixnewsrc (try typing "newsrc" really fast...)
which is far more robust in its error detection, and also takes full
Perl regular expressions in your .news.favorite file if you like.

It's not exactly the most stylish perl out there, but I'm happy.

Don't worry, be happy,

Dan Wallach
[e-mail]


-------- cut here ---------
#!/usr/bin/perl

# FixNewsrc V1.1 by Dan Wallach
# [e-mail]

# run "fixnewsrc -help" for documentation

# 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 {
    $counter++;
    if(($counter % 100) == 0) {
    &clear_blurt;
    print STDERR "$counter..." if ($counter % 100) == 0;
    return 1;
    }
    return 0;
}

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

sub clear_counter {
    $counter = 0;
}

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

sub clear_blurt {
    $prev_blurt = 0;
}

sub insert {
    local($group) = split(/[:!]/, @_[0]);
    if(!defined $newsrc{$group}) {
        &blurt("Warning: $group not in .newsrc!\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 = $_;
        foreach (@newsrc) {
        eval <<END_OF_EVAL;
            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;
}

if(@ARGV) {
    print STDERR <<NO_MORE_HELP;
fixnewsrc, V1.1 by Dan Wallach <[e-mail]>
Usage: $0       [-v] [any other argument]
    -v == more verbose
    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;
}

die "No .newsrc file!  Crapped out at" unless -e "$ENV{HOME}/.newsrc";
open(NEWSRC, "$ENV{HOME}/.newsrc") || die "Can't open .newsrc: $!, 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: ";
&clear_counter;
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
&clear_counter;

if (open(FAVORITE, "$ENV{HOME}/.news.favorite")) {
    &print_favorites;
} else {
    print STDERR "No .news.favorite file found.  Just sorting .newsrc\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) {
    if(/:/) {
    &counter;
    push (@output, $_);
    } elsif (/!/) {
    &counter;
    push (@output2, $_);
    }
}
&tally_counter;

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

open(NEWSRC, "> $ENV{HOME}/.newsrc") || die "Can't open .newsrc for writing: $!, crapped out at";

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