Katrin - an email reminder

gistfile1.pl

#!/usr/bin/env perl

=head1 NAME

B<Katrin> - remind via local mail

=head1 DESCRIPTION

B<Katrin> searches for files of a special format in the directory
F<~/.katrin> and sends out reminder emails to a specified user via
mail(1).  B<Katrin> will not only send out those reminders that match
the actual date but also look whether there are files older than the
actual date it has not sent out yet. One may compare that to anacron(8).

=head1 USAGE

Place files of the format described in the next section in the directory
F<.katrin>. Then call 

    katrin <username>
   
to get due reminders sent to the specified user.

=cut

use 5.010;
use strict;
use warnings;
use Date::Parse;
use Date::Manip::Date;

# the username to whose mailbox the mails are sent
my $recipient = shift @ARGV;

# actual time/date
my $time    = time;
my @time    = localtime(time);
my $mday    = $time[3];
my $month   = $time[4] + 1;
my $year    = $time[5] + 1900;
my $isodate = sprintf '%4d-%02d-%02d', $year, $month, $mday;

=head1 FILES

All reminder files are stored in the directory F<.katrin>. Depending on
when or at which period of time reminders shall be sent out, they have
different naming conventions (see below).  The common thing is that
the first line of each file is taken as the subject for the sent
reminder email and the rest is its body. Having a body is not required.

=cut

if (-e "$ENV{HOME}/.katrin") {
    chdir "$ENV{HOME}/.katrin"
        or die "Can't change into directory ~/.katrin: $!";
} else {
    mkdir "$ENV{HOME}/.katrin"
        or die "Can't create directory ~/.katrin: $!";
}

# The file .katrin/.last_check gets touch every time Katrin is run. Thus
# Katrin can determine when it was run the last time.
my $last_check;
if (-e '.last_check') {
    $last_check = (stat '.last_check')[9]
        or die "Can't stat .last_check: $!";
} else {
    system qw(touch .last_check)
        or die "Can't create .last_check: $!";
    $last_check = 0; # Katrins early life.
}

# all other files are reminder files
my @reminders = glob '*';

# parse them
## This hash contains the names of the reminder files associated with
## the appropriate date which belongs to them.
my %parsed;
for (@reminders) {

=head2 Remind Once

The name of these files has the format F<YYYY-MM-DD> following the
common ISO 8601 standard. These files are deleted when they
were due and B<Katrin> has sent out the concerned reminder email.

=cut

    when (/^\d{4}-\d\d-\d\d$/) {
        $time > str2time($_) and
            remind($_)
                && (unlink $_
                    or warn "Can't unlink $_: $!\n");
    }

=head2 Remind Weekiy

The name of these files has the format F<D> meaning the day of
week at which the reminder should be sent. 1 stands for
Monday, 2 for tuesday and so on.

=cut

    when (/^\d$/) {
        # get the date of the last occurance of the day of week
        my $date = Date::Manip::Date->new;
        $date->parse($isodate);
        $date->prev($_, 1);
        
        $parsed{$_} = $date->printf('%Y-%m-%d');
    }

=head2 Remind Monthly

The name of these files has the format F<DD> meaning the
day of month at which the reminder should be sent.

=cut

    when (/^\d\d$/) { $parsed{$_} = "$year-$month-" . $_ }

=head2 Remind Yearly

The name of these files has the format F<MM-DD> meaning the date
in a year at which the reminder should be sent.

=cut

    when (/^\d\d-\d\d$/) { $parsed{$_} = "$year-" . $_ }

=head2 Remind at More-Than-One-Year Periods

The name of these files has the format F<YYYY-MM-DD-PP> with the
first three fields containing the date at which the first
reminding shall happen and the last field telling after how
many years the next is due.

=cut

    when (/^(\d{4})-(\d\d-\d\d)-(\d\d)$/) {
        # store it in the hash only when the current year matches the
        # cycle
        $parsed{$_} = "$year-" . $2
            if ($year - $1) % $3 == 0;
    }
}

# send mail if due
for (keys %parsed) {
    my $time_of_parsed = str2time($parsed{$_});
    remind($_)
        if $last_check < $time_of_parsed and $time_of_parsed <= $time;
}

# update the file with the information of the last check
utime $time, $time, '.last_check'
    or die "Can't modify mtime or atime of .last_check: $!";

sub remind {
    my $reminder = shift;
    open REMINDER, '<', $_
        or die "Can't open reminder file for reading ${_}:$!\n";
    $/ = "";

    my @content = <REMINDER>;
    chomp(my $subject = shift @content);

    open MAIL, '|-', qq(mail -s "${_}: $subject" $recipient 2>/dev/null)
        or die "Can't open the mail pipe for writing: $!\n";
    print MAIL (join "\n", @content);
    close MAIL
        or    (warn $! ? "System error on closing the mail pipe: $!"
                       : "Wait status of mail program: $?")
           && (return 0);
    return 1;
}

=head1 AUTHOR

Richard Möhn, <myrtscht@cpan.org>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2010 Richard Möhn.

This Program may be used by anyone in accordance with the terms of the
German Free Software License.

The License may be obtained under <http://www.d-fsl.org>. There is also
a version in German language available, which is legally equal to the
English one.

=cut