perl source of ziff
authorStefano Zacchiroli <zack@debian.org>
Wed, 26 Dec 2007 11:08:02 +0000 (12:08 +0100)
committerStefano Zacchiroli <zack@debian.org>
Wed, 26 Dec 2007 11:08:02 +0000 (12:08 +0100)
hacking/software/ziff [new file with mode: 0644]

diff --git a/hacking/software/ziff b/hacking/software/ziff
new file mode 100644 (file)
index 0000000..529965b
--- /dev/null
@@ -0,0 +1,256 @@
+#!/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");
+}
+