#!/usr/bin/perl -w
#
# $Id: speech-biff,v 1.2 2003/07/14 12:06:31 suter Exp $
# Copyright (C) 2003 Mark Suter <suter@humbug.org.au>
#
# This program 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.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

=head1 NAME

speech-biff - Announce number and senders for new emails

=head1 SYNOPSIS

speech-biff /var/mail/user other-inbox third-inbox

=head1 OPTIONS

=over 8

=item B<--man>

Print the manual page and exit.

=item B<--help>

Print a brief help message and exit.

=back

=head1 DESCRIPTION

B<This program> is a biff variant with speech output.  According
the Jargon File v4.3.1:

    biff /bif/ vt.

    To notify someone of incoming mail. From the BSD utility biff(1),
    which was in turn named after a friendly dog who used to chase
    frisbees in the halls at UCB while 4.2BSD was in development. There
    was a legend that it had a habit of barking whenever the mailman
    came, but the author of biff says this is not true.

The output is done using the festival utility.  On a Debian GNU/Linux
system, you need the following packages installed.

=over 8

=item perl

=item perl-base

=item pdl

=item libmail-box-perl

=item festival

=back

The output should be similar to the following:

    3 new emails from Foo, Bar and Baz

=head1 EXIT CODES

If B<this program> exits with a zero exit status and the correct output
should be heard.  Nothing else is ever printed to standard output.

B<This program> will exit with a non-zero exit status if there was a
fatal error.  Both fatal and non-fatal errors will cause output on
standard error.

=head1 AUTHOR

Mark Suter E<lt>F<suter@humbug.org.au>E<gt>

=head1 COPYRIGHT

Copyright (C) 2003 Mark Suter E<lt>F<suter@humbug.org.au>E<gt>

This program 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.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA
or from the following webpage.

    http://www.gnu.org/licenses/gpl.txt

=cut

##
## The perl packages and their Debian packages
##
use strict;             # perl-base
use Getopt::Long;       # perl-base
use IO::File;           # perl-base
use Fcntl qw/F_SETFD/;  # perl-base
use Pod::Usage;         # pdl
use Mail::Box::Manager; # libmail-box-perl
use Storable;		# perl

## Where is the festival tool (Debian package festival)
use constant FESTIVAL => "/usr/bin/festival";

## Where we store last invocation's hash
my $cache = "$ENV{HOME}/.speech-biff.cache";

## Set our path and process any options
$ENV{'PATH'} = '/bin:/usr/bin';
my %opt = (man => 0, help => 0);
GetOptions(\%opt, "man", "help") or pod2usage(0);
$opt{man} and pod2usage(-exitval => 0, -verbose => 2);
$opt{help} and pod2usage(0);
scalar @ARGV >=1 or pod2usage(-exitval => 1, -verbose => 1);

## What was there last time? (nothing if file not there)
my $oldref = -e $cache ? ( retrieve($cache) or die "retrieve: $!\n" ) : {} ;

## What is there now? (our arguments should be a list of folders to process)
my $newref = {};
my $mgr = Mail::Box::Manager->new;
foreach my $folder (@ARGV) {
    my $folder = $mgr->open(folder => $folder, lock_type => 'NONE', extract => 'LAZY');
    foreach ($folder->messages) {
	$newref->{$_->messageId} = ($_->sender)[0]->format();
    }
}
store $newref, $cache or die "store: $!\n";

## Figure out what is new
my ($count, %senders) = (0, ());
foreach (keys %{$newref}) {
    next if defined $oldref->{$_};
    $count ++;
    $senders{$newref->{$_}}++;
}

## Is there anything new?
$count > 0 or exit;

## Get the inflection correct
my $plural = $count eq 1 ? "" : "s";

## Prepare the senders as a "x, y and z" type listing
my $senders = join ', <BREAK LEVEL="MEDIUM"/>',
    map { s/ \s* (?: "? (.+?) "? \s )? \s* <? (\S+\@\S+?) >? \s* $/$1 or $2/xe and $_ or "Unknown" } keys %senders;
$senders =~ s/,([^,]*)$/ and$1/;

## Put our data in a temporary file
my $fh = IO::File->new_tmpfile() or die "new_tmpfile: $!\n";
print $fh <<EOF ;
<?xml version="1.0"?>
<!DOCTYPE SABLE PUBLIC "-//SABLE//DTD SABLE speech mark up//EN" "Sable.v0_2.dtd" []>
<SABLE>
<VOLUME LEVEL="loud">
<RATE SPEED="-50%"><SAYAS MODE="cardinal">$count</SAYAS></RATE>
<BREAK LEVEL="SMALL"/>new <PRON SUB="e mail$plural">email$plural</PRON>
from <RATE SPEED="-25%">$senders</RATE>
</VOLUME>
</SABLE>
EOF

## Ready the tempfile to be passed as a filehandle
fcntl($fh, F_SETFD, 0) or die "fcntl: $!\n";
seek $fh, 0, SEEK_SET or die "seek: $!\n";

## Invoke festival on the temporary file
if (open(CHILD, "|-")) {
    print CHILD "(tts \"/dev/fd/", fileno($fh), "\" 'sable) nil\n";
    close CHILD or die "close: $!\n";
    $? == 0 or die "non-zero exit from festival: $?\n";
} else {
    exec FESTIVAL or die "exec: $!\n";
}