#!/usr/bin/perl -w
use strict;

# Ziff! (an offline biff replacement)
#
# Author: Stefano "Zack" Zacchiroli <zack@cs.unibo.it>
# Copyright: this software is freely distributed under the term of the GNU
# General Public License (GPL).
#
# Ziff is an offline biff replacement, used to know how many new mails
# reside in various mailboxes.
# Ziff parse a mutt configuration file (mutt is a really powerful Mail
# User Agent!!) to know where user mailboxes reside and then parse all
# that mailboxes showing how many new mails are in each of them.
#
# Try "ziff -h" for command line arguments.
#
# If no path is given for mutt configuration file, Ziff try to use the
# .muttrc file of the user, otherwise use the given mutt configuration
# file.
# Note that you really don't need mutt to use Ziff, you can create a
# fake mutt configuration file formatted as below:
#
# set folder=~/Mail
# mailboxes $MAIL =personal =mylove =mom =mydog =bill_games
#
# The folder assignmente specify that '=mailbox' is relative to 'folder'
# value (i.e. 'folder' value is the base dir for what follow the '='
# sign).
# 'mailboxes' line specify a list of space separated mailboxes,
# environment variable substitution is performed on mailbox names.
#
# Enjoy!
#

# Last modified: Wed, 25 Aug 2004 15:21:13 +0200 zack

########################################################################
# LIBS
########################################################################

use vars qw/ $opt_f $opt_p $opt_h /;

use Getopt::Std;
use Compress::Zlib;

my $use_lsmbox = 1;

########################################################################
# SUBS
########################################################################

# parse a mutt configuration file and return a list containing file
# marked as "mailboxes". See mutt documentation for 'mailboxes' command.
sub parseMailboxes($);
sub parseMailboxes($) {
  my ($muttrc) = @_;
      # mutt "set folder=" directive
  my $setFolderRE = '^[ \t]*set[ \t]*folder[ \t]*=[ \t]*';
      # mutt "mailboxes" directive
  my $mailboxesRE = '^[ \t]*mailboxes[ \t]*';
      # reference to environment variable like $VARNAME
  my $sourceRE = '^[ \t]*source[ \t]*([^\s]*)';
  my $varNameRE = '\$([a-zA-Z]\w*)';
  my ($name,$passwd,$uid,
      $gid,$quota,$comment,
      $gcos,$homedir,
      $shell,$expire) = getpwnam(getlogin());
  my ($folderDir, @mailboxes);
  my @todo = (); # sourced muttrc

  open(MUTTRC, "< $muttrc")
    or die "Can't open mutt configuration file: $muttrc";
  while(<MUTTRC>) { # parse mutt configuration file
    chomp($_);
    if ($_ =~ /$setFolderRE/) { # is a "set folder=" line
      $_ =~ s/^[^=]*=(.*)$/$1/; # get 'foler' variable value
      $folderDir = $_;
    } elsif ($_ =~ /$mailboxesRE/) {  # is a "mailboxes " line
      $_ =~ s/^[ \t]*mailboxes[ \t]*//; # remove "mailboxes " header
      push @mailboxes, (split /[ \t]+/, $_);  # collect mailbox names
    } elsif ($_ =~ /$sourceRE/) { # "source" line: remember sourced rc
      my $filename = $1;
      $filename =~ s/^~/$ENV{HOME}/;
      push @todo, $filename;
    } else {  # other muttrc lines
      # do nothing
    }
  }
  close(MUTTRC);
  foreach my $filename (@todo) {  # recurse on sourced rcs
    my @tmpMailboxes = parseMailboxes($filename);
    push @mailboxes, @tmpMailboxes;
  }

  if ($folderDir) {  # patch '=' with folderDir if defined
    map {
      s/=/$folderDir/;
    } @mailboxes;
  }
  map { # patch "~" with home directory
    s/~/$homedir/;
  } @mailboxes;
  map { # patch $VARNAME with value of VARNAME environmente variable
    if ($_ =~ /$varNameRE/) { # line contains a variable reference
      my $varname = $_;
      $varname =~ s/$varNameRE/$1/;
      $_ =~ s/$varNameRE/$ENV{"$varname"}/g;
    }
  } @mailboxes;

  return(@mailboxes);
} # parseMailboxes

# Check a line of a mailbox against a status and return a new
# status. A status is a triple (mails, oldmails, inHeaderFlag).
sub chkMBoxLine($$$$) {
  my ($line, $mails, $oldmails, $inHeaders) = @_;

  my $mailStartRE = '^From ';  # start of a new mail
  my $mailStatusRE = '^Status:'; # "Status:" header

  chomp($line);
  if ($line =~ /$mailStartRE/) { # mail envelope From
    $mails++;
    $inHeaders = 1;
  } elsif (($line =~ /$mailStatusRE/) and ($inHeaders == 1)) { # "Status:"
      # if we are still reading headers and current header is a
      # "Status:" header, we have found an old mail
    $oldmails++;
  } elsif ($line =~ /^$/) {  # start mail body
    $inHeaders = 0;
  }

  return($mails, $oldmails, $inHeaders);
} # chkMBoxLine

# check whether a file is gzipped or not
sub isGzipped($) {
  my ($fname) = @_;

  return ($fname =~ /\.gz$/);
}

# return number of new mail in a given mailbox
sub newMails_old($) {
  my ($mailbox) = @_; # mailbox to check
  my ($mails, $oldmails, $inHeaders) = (0, 0, 0);

  if (isGzipped($mailbox)) {  # compressed mailbox
    my $line;
    my $gz = gzopen($mailbox, "r");
    if (not $gz) {
      print "Can't open compressed mailbox: $mailbox\n";
      return(-1);
    }
    while($gz->gzreadline($line) > 0) {
      ($mails, $oldmails, $inHeaders) =
        chkMBoxLine($line, $mails, $oldmails, $inHeaders);
    }
    $gz->gzclose();

  } else {  # uncompressed mailbox

    if (not open(MAILBOX, "< $mailbox")) {  # error opening mailbox
      print "Can't open mailbox: $mailbox\n";
      return(-1);
    } else {  # mailbox opened
      while(<MAILBOX>) {
        ($mails, $oldmails, $inHeaders) =
          chkMBoxLine($_, $mails, $oldmails, $inHeaders);
      }
    close(MAILBOX);
    }
  }

  return($mails - $oldmails);
} # newMails

sub newMails($) {
  my ($mailbox) = @_;
  if (not $use_lsmbox) {
    return(newMails_old($mailbox));
  } else {
    open(LS, "lsmbox $mailbox |");
    my $line = <LS>;
    $line = <LS>;
    $line =~ /^(.*)\s+(\d+)\s+(\d+).*$/;
    return($2 - $3);
    close(LS);
  }
}

# print an help message
sub usage() {
  print <<EOH;
Usage: ziff [-p] [-h] [-f muttrc] [mbox ..]
Options:
       -f     specify the mutt configuration file name (default is ~/.muttrc)
       -p     output a MAILPATH string instead of parsing mailboxes
       -h     print this help message and exit
EOH
}

########################################################################
# MAIN
########################################################################

getopts("fph");

if (defined $opt_h) { # print help and exit
  usage();
  exit(0);
}

my ($muttrc, @mbs, $newmails);

if (defined $opt_f) {
  $muttrc = $opt_f if (defined $opt_f);
} else {
  $muttrc = "$ENV{'HOME'}/.muttrc";
}

if (defined $ARGV[0]) { # file argument passed, check this mbox only
  @mbs = @ARGV;
} else { # check all mboxes defined in muttrc
    # fetch mailboxes definition from muttrc
  @mbs = parseMailboxes($muttrc);
}

if (defined $opt_p) { # output a MAILPATH bash string and exit
  print join(':', @mbs), "\n";
  exit(0);
}

my @newMbs = ();
my $totNewMails = 0;  # new mails total
foreach my $m (@mbs) {  # search mailboxes for new mails
  $newmails = newMails($m);
  if ($newmails == -1) {  # error while reading mbox
    print "Skipped mailbox '$m'\n";
  } elsif ($newmails >= 1) { # at least one new mail
    print "$m contains $newmails new mail(s)\n" if ($newmails != 0);
    push @newMbs, $m;
    $totNewMails += $newmails;
  } else {  # no new mails
    system("touch -a $m");
  }
}
print "New mails to be read: $totNewMails :-(", "("x($totNewMails/10), "\n"
  unless ($totNewMails == 0);

foreach my $m (@newMbs) {
  system("touch -m $m");
}