Bug 60375

      Perl program that is cronable - removes stale codes from sendpr db based on an expired time. 

Ceri requested this.

Fix: 

#!/usr/bin/perl -T
#
# 
#
# Copyright (c) 2003 Eric Anderson

use DB_File;
use Fcntl qw(:DEFAULT :flock);
use strict;

$ENV{"PATH"} = "/bin:/usr/bin";
$ENV{"TMPDIR"} = "/tmp";

my($fd, $db_obj, %db_hash, $currenttime, $randomcode, $expiretime, $dbpath);

############################################
$dbpath = "/tmp/sendpr-code.db";
$expiretime = 900;              # seconds until code expires
############################################

$currenttime = time();

# DB stuff here
$db_obj = tie(%db_hash, 'DB_File', $dbpath, O_CREAT|O_RDWR, 0644)
                    or die "dbcreate $dbpath $!";
$fd = $db_obj->fd;
open(DB_FH, "+<&=$fd") or die "fdopen $!";

unless (flock (DB_FH, LOCK_EX | LOCK_NB)) {
    unless (flock (DB_FH, LOCK_EX)) { die "flock: $!" }
}

foreach $randomcode (keys %db_hash) {
        if ( ($currenttime - $expiretime) <= $db_hash{$randomcode}) {
                delete $db_hash{"$randomcode"};
        }
}

$db_obj->sync();                   # to flush
flock(DB_FH, LOCK_UN);
undef $db_obj;

untie %db_hash;
How-To-Repeat: No problems reported yet.. :)  

File for Ceri..