Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

expirescore.pl

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: expirescore.pl
#
# 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.
&read_score_struct();

# Endless loop.
while (1) {
    system("clear");

    # Print out the list of newsgroups.
    &show_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";
        last;

    # 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") {
        &write_score_struct();

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

        last;
    }

}
    

####
# 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 
+setup
        # 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
+CORE}\n";
            print SCORES "\t$scores{$newsgroup}->{$epochtime}->{HEADER
+}: " .
                            "$scores{$newsgroup}->{$epochtime}->{MATCH
+}\n\n";
        }
    }

    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
+oo.
    delete $scores{$newsgroup} unless scalar keys %{$scores{$newsgroup
+}};

}

Comment on expirescore.pl
Download Code

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://30823]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (4)
As of 2015-07-05 06:09 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (60 votes), past polls