#!/usr/bin/perl -w

# gdbmrecent-purge: purge old entries in gdbmrecent databases
# Copyright (C) 2007  Rafael Laboissiere

# This script is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

=head1 NAME

gdbmrecent-purge - purge old entries in gdbmrecent databases

=head1 SYNOPSIS

    gdbmrecent-purge [options] AGE

=head1 DESCRIPTION

B<gdbmrecent> is an add-on module for the B<JED> editor that records
the cursor positions of visited files, as well as some buffer local
variables, and remember them later.  B<gdbmrecent-purge> allows the
maintainance of gdbmrecent databases, e.g. through cron tables.
Database entries older than C<AGE> are purged.

C<AGE> is age-since-last-view in seconds unless appended with C<Y>
(years), C<O> (months), C<W> (weeks), C<D> (days), C<H> (hours) or
C<M> (minutes), e.g., "2w" (2 weeks) or "19d" (19 days).  The letters
are case-insensitive. If C<AGE> is zero the database will be cleared!
To purge only non-existant files set C<AGE>=10000000000 or some other
large number.

=head1 OPTIONS

=over

=item C<-q --quiet>

Suppress normal output

=item C<-dFILE --database=FILE>

Use C<FILE> instead of the default C<~/.jed/recent_db> as the
gdbmrecent databse.  If C<FILE> does not exist, it will be created and
contains an empty GDBM database.

=back

=head1 EXAMPLES

Sample crontab entries for database maintenance:

       # Keep four weeks' worth of data
       02 00  *  *  *  /usr/bin/gdbmrecent-purge 4w

       # Keep four weeks' worth of data and shut your mouth
       02 00  *  *  *  /usr/bin/gdbmrecent-purge 4w -q

       # Purge only non-existant files
       02 00  *  *  *  /usr/bin/gdbmrecent-purge 0x7fffffff

       # Reset database every Monday
       02 00  *  *  1  /usr/bin/gdbmrecent-purge 0

       # Don't do anything
       02 00  *  *  *  /usr/bin/gdbmrecent-purge -1

=head1 SEE ALSO

L<jed (1)>, L<crontab (5)>

=head1 CREDITS

This script was inspired on the B<jedstate> command, which is now
obsolete in Debian.  Parts of this man page are copied verbatim from
the man page of B<jedstate>.

=head1 AUTHOR

Rafael Laboissiere

=cut

use GDBM_File;
use Getopt::Long;

use constant SECONDS_PER_HOUR => 60 * 60;
use constant SECONDS_PER_DAY  => SECONDS_PER_HOUR * 24;

(my $prog = $0) =~ s{.*/}{};

my $quiet;
my $dbfile = "~/.jed/recent_db";

my $result = GetOptions ("quiet" => \$quiet, "database=s" => \$dbfile);

die "Usage: $prog [options] AGE\n"
  if not $result or $#ARGV != 0;

$dbfile =~ s|^~/|$ENV{HOME}/|;

my $arg = $ARGV [0];
$arg = lc $arg;
(my $rest = $arg) =~ s/(\d+)([yowdhms]*)//;

die "$prog: Wrong format for AGE"
  if $rest ne "";

tie %database, 'GDBM_File', $dbfile , &GDBM_WRCREAT, 0644
  or die "$prog: Cannot open file $dbfile for reading/writing\n";


my %seconds = ("" => 1,
               s => 1,
               m => 60,
               h => SECONDS_PER_HOUR,
               d => SECONDS_PER_DAY,
               w => SECONDS_PER_DAY * 7,
               o => int (SECONDS_PER_DAY * 30.437),
               y => int (SECONDS_PER_DAY * 365.25));

my $age = $1 * $seconds {$2};
my $now = time ();
my $then = $now - $age;
my $date = localtime ($then);

print STDOUT ("Purging entries not viewed since $date\n")
  if not $quiet;

%tmp = %database;
$count = 0;

while ((my $k, $v) = each %tmp) {
  if (not -f $k or (split (":", $v)) [0] < $then) {
     delete ($database {$k});
     $count ++;
     print STDOUT (" - dereferencing `$k'\n")
       if not $quiet;
  }
}

print STDOUT ("Purged $count name", $count > 1 ? "s" : "", "\n")
  if not $quiet;

untie %database;
