Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much

by le (Friar)
on Sep 02, 2000 at 02:29 UTC ( #30823=sourcecode: print w/replies, xml ) Need Help??
Category: Utility Scripts
Author/Contact Info Lukas Ertl
Description: I use the slrn newsreader and my scorefile got to big (it was over 2 MB), with a lot of old scores, because I didn't set expiration times for the scores, so I hacked this script, that reads in the scorefile and lets me expire scores (based on Time::ParseDate features like older than "5 days", "3 months", "2 years"), and writes back the scorefile.

Currently, it only runs interactive, but maybe I (or you) will add the needed features to run without user interaction (e.g. for cron scripting).

#!/usr/bin/perl -w

# File:
# Version: 0.01
# Purpose: modify the score file generated from the slrn newsreader 
#          and expire scores based on date.

use Time::ParseDate;
use strict;

# Put your scorefile here
my $scorefile = "/where/ever/.slrnscore";

# This is the hash containing the data structure.
my %scores;

# Read in the score file and generate the data structure.

# Endless loop.
while (1) {

    # Print out the list of newsgroups.

    print "[E]xpire scores, [D]elete whole group score, [W]rite scoref
+ile " .
            "or [Q]uit? ";
    chomp(my $input = <STDIN>);

    # Quit the program.
    if (lc $input eq "q") {
        print "Allright, I'll quit.\n";

    # Expire scores in a specific newsgroup.
    } elsif (lc $input eq "e") {
        print "Which newsgroup? ";
        chomp(my $newsgroup = <STDIN>);
        print "Expire messages older than (e.g. \"2 months\", \"1 year
+\"): ";
        chomp(my $date = <STDIN>);

        my $epochtime = parsedate("-$date");
        die "Error parsing date: $!" unless $epochtime;

        &expire($newsgroup, $epochtime);

    # Delete the scores for a whole newsgroup.
    } elsif (lc $input eq "d") {
        print "Which newsgroup? ";
        chomp(my $newsgroup = <STDIN>);

        delete $scores{$newsgroup};

    # Write out the scorefile.
    } elsif (lc $input eq "w") {

        print "Score file $scorefile written.\n";



# This sub reads in the scorefile and generates our data 
# structure, based on hash of hashes.
sub read_score_struct {
    my ($current_group, $epochtime);

    open (SCORES, $scorefile) or die $!;

    while (my $line = <SCORES>) {
        # Skip commented lines that we don't need.
        next if $line =~ /^%(?!Score created)/;

        # Extract the creation date.
        if ($line =~ /^%Score created by slrn on (.*)$/) {
            $epochtime = parsedate($1);
            die "Parsing date: $!\n" unless defined $epochtime;

        # Extract the newsgroup that the score is responsible for and 
        # a temporary variable we can work with.
        } elsif ($line =~ /^\[(.*)\]/) {
            if (exists $scores{$1}) {
                $current_group = $scores{$1};

            } else {
                $scores{$1} = $current_group = {};

        # Extract the score value.
        } elsif ($line =~ /^Score: (.*)/) {
            $current_group->{$epochtime}->{SCORE} = $1;

        # Extract the header that was scored on.
        } elsif ($line =~ /^\s+(\w+): (.*)$/) {
            $current_group->{$epochtime}->{HEADER} = $1;
            $current_group->{$epochtime}->{MATCH} = $2;

    close SCORES;

# This sub will write out the score file.
sub write_score_struct {
    open (SCORES, "> $scorefile") or die $!;

    # Traverse over the data structure.
    foreach my $newsgroup (keys %scores) {
        foreach my $epochtime (sort keys %{$scores{$newsgroup}}) {
            print SCORES "%Score created by slrn on ";
            print SCORES scalar localtime($epochtime);
            print SCORES "\n\n";
            print SCORES "[$newsgroup]\n";
            print SCORES "Score: $scores{$newsgroup}->{$epochtime}->{S
            print SCORES "\t$scores{$newsgroup}->{$epochtime}->{HEADER
+}: " .

    close SCORES;

# Print out the list of newsgroups and the scores count.
sub show_newsgroups {
    print "Scores exist on these newsgroups:\n";
    print "---------------------------------\n\n";

    foreach (sort keys %scores) {
        print "$_: ";
        printf "%d score%s\n", scalar keys %{$scores{$_}},
                scalar keys %{$scores{$_}} == 1 ? "" : "s";

    print "\n";

# Expire scores in a newsgroup on a given date.
sub expire {
    my ($newsgroup, $epochtime) = @_;

    foreach (keys %{$scores{$newsgroup}}) {
        delete $scores{$newsgroup}->{$_} if $_ < $epochtime;

    # If there are no more scores for a newsgroup, we can delete it, t
    delete $scores{$newsgroup} unless scalar keys %{$scores{$newsgroup

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://30823]
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (2)
As of 2017-05-01 03:54 GMT
Find Nodes?
    Voting Booth?
    I'm a fool:

    Results (544 votes). Check out past polls.