#!/usr/bin/perl
#
#   Copyright (C) 2001-2006 Ola Lundqvist <opal@debian.org>
#
# This 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, or (at your option) any later
# version.
# 
# This 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 with
# the mboxcheck source package as the file COPYING.  If not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
# 02111-1307, USA. Free
#

###############################################################################
##################### DOCUMENTATION ###########################################
###############################################################################
# Changes:
#	20020717 Ola Lundqvist <opal@debian.org>
#		Wrote this section.
#	20020904 Ola Lundqvist <opal@debian.org>
#		Moved documentation to top of file because _END_ seems not
#		to work in perl 5.8.
#	20021106 Ola Lundqvist <opal@debian.org>
#		Added a ignore-symlink option and MBOX test.
###############################################################################

=head1 NAME

mboxcheck - MBOX mail checking program.

=head1 SYNOPSIS

mboxcheck [options] [file [...] ]

=head1 DESCRIPTION

MBOXcheck is a simple mailbox checker. Give some options and at least one
mailbox file as an argument and it will print some status of how many messages
there are and which status they have.

=head1 OPTIONS

  --help	 The help text.
  --version      The version information about this tool.
  --showon [v][?]
		 When to show a mailbox in the list.
		 [v] - verbose, always show.
		 [?] - show when count is above 0 for the below types, see
		       --show what for more information about that.
		 The default is to trigger only on new messages (--showon new).
  --show [n][s][r][o][a][d]
		 What counts to show. The caracter in the bracket is
  		 the short form. The what string can be comma separated
		 to specify more than one option. Multiple --show options
		 will add more (and will not remove shows).
		 [n] - new (new messages)
		 [s] - seen (seen but not read messages)
		 [r] - read (read and answered messages)
		 [o] - onlyread (just read messages)
		 [a] - answered (answered messages)
		 [d] - deleted (deleted messages)
		 The default is to show new and seen messages (--show ns).
  --recurse	 This option will tell the tool to recurse into
    -R -r	 subdirectories.
  --nosymlink	 Tell the program to ignore symlinked files and directories.
  --cachedir dir A temporary directory to use for speedup cache
		 (default ~/.mboxcheckcache)
  --nocache 	 Do not use a temporary directory.

=head1 CACHE

The cache file is named after the path to the file with slash caracters '/'
replaced with two commas ',,'. The content is a list of comma separated
values; last position, new, seen, only read, answered and deleted mail.

=head1 AUTHOR

Ola Lundqvist <opal@debian.org>

=head1 SEE ALSO

http://www.opal.dhs.org/programs/mailchecker

=cut

###############################################################################
# Changes:
#	20010223 Ola Lundqvist <opal@debian.org>
#		Wrote it.
#	20020618 Ola Lundqvist <opal@debian.org>
#		Added $cachedir settings.
#	20020704 Ola Lundqvist <opal@debian.org>
#		Added mkpath use.
#	20021106 Ola Lundqvist <opal@debian.org>
#		Added a ignore-symlink option.
###############################################################################
use File::Path qw(mkpath);

$argcheckmode = 1;
$usecache = 1;
@checklist = ();
$recurse = 0;
$cachedir = "/tmp/mboxcheckcache";
$cachedir = "$ENV{HOME}/.mboxcheckcache";
$usesymlink = 1;
%fixlen = (
	   n => 4,
	   s => 4,
	   o => 4,
	   a => 3,
	   d => 2
	   );

$help = "
	mboxcheck - MBOX mail checking program.

  Licensed under the GNU public License (NO WARRANTY).

USAGE:
  mboxcheck [options] dirs_or_files ...

OPTIONS:
  --help:	The help text (ie: this text)
  --version:    The version information about this tool ($version).
  --showon [v][?]
		When to show a mailbox in the list.
		[v] - verbose, always show.
		[?] - show when count is above 0 for the below types, see
		      --show what for more information about that.
		The default is to trigger only on new messages (--showon new).
  --show [n][s][r][o][a][d]
		What counts to show. The caracter in the bracket is
  		the short form. The what string can be comma separated
		to specify more than one option. Multiple --show options
		will add more (and will not remove shows).
		[n] - new (new messages)
		[s] - seen (seen but not read messages)
		[r] - read (read and answered messages)
		[o] - onlyread (just read messages)
		[a] - answered (answered messages)
		[d] - deleted (deleted messages)
		The default is to show new and seen messages (--show new,seen).
  --recurse:	This option will tell the tool to recurse into
    -R -r	subdirectories.
  --cachedir d:	A temporary directory to use for speedup cache
		(default $cachedir)
  --nocache:	Do not use a temporary directory.

Author: Ola Lundqvist <opal\@lysator.liu.se>
Homepage: http://www.opal.dhs.org/programs/mailchecker

";

$version = "0.1.2";

$verstr = "Mailbox checker version $version.\n";

###############################################################################
########################### Check for arguments ###############################
###############################################################################
# Changes:
#	20010223 Ola Lundqvist <opal@debian.org>
#		Wrote it.
#	20020618 Ola Lundqvist <opal@debian.org>
#		Added $cachedir settings.
#	20021106 Ola Lundqvist <opal@debian.org>
#		Added a ignore-symlink option.

my $arg = "";
while ($arg = shift) {
    if ($argcheckmode && $arg =~ /^--/) {
	if ($arg =~ /^--help$/) {
	    print($help);
	    exit(0);
	}
	elsif ($arg =~ /^--version$/) {
	    print($verstr);
	    exit(0);
	}
	elsif ($arg =~ /^--recurse$/) {
	    $recurse = 1;
	}
	elsif ($arg =~ /^--show$/) {
	    my $t;
	    foreach $_ (split /,/, shift) {
		s/^new$/n/;
		s/^seen$/s/;
		s/^read$/so/;
		s/^onlyread$/o/;
		s/^answered$/a/;
		s/^deleted$/d/;
	    }
	    $t = $_;
	    foreach $_ (grep (!/^$/, (split /(.)/, $t))) {
		push @show, $_;
	    }
	}
	elsif ($arg =~ /^--nosymlink$/) {
	    $usesymlink = 0;
	}
	elsif ($arg =~ /^--showon$/) {
	    my $t;
	    foreach $_ (split /,/, shift) {
		s/^verbose$/v/;
		s/^new$/n/;
		s/^seen$/s/;
		s/^read$/so/;
		s/^onlyread$/o/;
		s/^answered$/a/;
		s/^deleted$/d/;
	    }
	    $t = $_;
	    foreach $_ (grep (!/^$/, (split /(.)/, $t))) {
		$showon{$_} = 1;
	    }
	}
	elsif ($arg =~ /^--cachedir$/) {
	    $cachedir = shift;
        }
	elsif ($arg =~ /^--nocache$/) {
	    $usecache = 0;
	}
	else {
	    print("Unknown argument '$arg' !!!\n");
	    exit(0);
	}
    }
    elsif ($argcheckmode && $arg =~ /^-/) {
	if ($arg =~ /^-r$/i) {
	    $recurse = 1;
	}
    }
    else {
	push @checklist, $arg;
    }
}

##############################################################################
####################### Some default values ##################################
##############################################################################

if (! defined %show) {
    push @show, 'n';
    push @show, 's';
    push @show, 'o';
}

if (! defined %showon) {
    $showon{n} = 1;
}

if (0 == scalar @checklist) {
    print("No directory or file specified, using default $ENV{MAIL} instead.\n");
    push @checklist, $ENV{MAIL};
}

##############################################################################
###################### The script starts here ################################
##############################################################################
# Changes:
#	20010223 Ola Lundqvist <opal@debian.org>
#		Wrote it.
#	20020618 Ola Lundqvist <opal@debian.org>
#		Added some comments.
#	20021106 Ola Lundqvist <opal@debian.org>
#		Added a ignore-symlink option and mbox test.

my $check = "";
while ($check = shift @checklist) {
    # If it is a symlink, then just ignore it!
    next if (-l $check && $usesymlink == 0);
    # If it is a directory, maybe recurse.
    if (-d $check && $recurse) {
	next if ($check =~ (/\.\.?/));
	$check =~ s/\/$//;
	opendir (D, $check);
	my $dir;
	while ($dir = readdir(D)) {
	    push @checklist, "$check/$dir";
	}
	closedir(D);
    }
    # If it is a file, test for mbox.
    else {
	next if (! mboxtest($check));
	# Check it.
	my ($n, $s, $o, $a, $d) =
	    checkMailbox($check);
	# Print the result.
	#print ("$n $s $o $a $d: $check\n");
	if (defined $showon{v} ||
	    ($n > 0 && defined $showon{n}) ||
	    ($o > 0 && defined $showon{o}) ||
	    ($s > 0 && defined $showon{s}) ||
	    ($a > 0 && defined $showon{a}) ||
	    ($d > 0 && defined $showon{d})) {
	    my $t;
	    foreach $t (@show) {
		my $x = $t;
		$_ = $t;
		s/^n$/ New: /;
		s/^s$/ Seen: /;
		s/^a$/ Ans: /;
		s/^d$/ Del: /;
		s/^o$/ Read: /;
		print($_);
		$h = "fixprint(\$$x, \$fixlen{$x});";
#		print($h);
		eval($h);
	    }
	    print(" \[$check\]\n");
	}
    }
}

###############################################################################
############################## Print fixed ####################################
###############################################################################
# Parameters:	$val      - A integer to print with fixed length.
#		$fix	  - The fixed length to use.
# Changes:
#	20010223 Ola Lundqvist <opal@debian.org>
#		Wrote it.
#	20020618 Ola Lundqvist <opal@debian.org>
#		Added some comments.
###############################################################################
sub fixprint($$) {
    my ($val, $fix) = @_;
    my $i = scalar (split /(.)/, $val);
    $i/=2;
    # If string length < fixed length then print " " to the fixed length.
    if ($i < $fix) {
	for ($a=0;$a<$fix-$i;$a++) {
	    print(" ");
	}
    }
    print ($val);
}

###############################################################################
############################## Print fixed ####################################
###############################################################################
# Parameters:	$file     - File to check if it a mbox or not.
# Returns:	0 (not mbox), 1 (mbox)
# Changes:
#	20021106 Ola Lundqvist <opal@debian.org>
#		Wrote it.
###############################################################################
sub mboxtest($) {
    my ($file) = @_;
    if (open(F, $file)) {
	my $test = "";
	# Seek beginning (just for safety)
	seek(F, 0, 0);
	read F, $test, 10;
	close F;
	if ($test =~ /^From /) {
	    return 1;
	}
    }
    return 0;
}

###############################################################################
############################## Mailbox checker ################################
###############################################################################
# Parameters:	$file     - The filename to check.
# Returns:	$new      - How many new messages are in that file.
#		$seen     - How many unread (but seen) messages.
#		$onlyread - How many messages that just have been read.
#		$answered - How many massages that are replied.
#		$deleted  - How many messages that are marked deleted.
# Changes:
#	20010223 Ola Lundqvist <opal@debian.org>
#		Wrote it.
#	20020618 Ola Lundqvist <opal@debian.org>
#		Added support for speedup by caching the result.
#	20020703 Ola Lundqvist <opal@debian.org>
#		Continued the implementation of result caching.
#	20020704 Ola Lundqvist <opal@debian.org>
#		Completed the implementation of result caching. Seems to work
#		really fine. The code could be split out in different functions
#		but I do not do that now. Maybe later.
#	20020705 Ola Lundqvist <opal@debian.org>
#		Removed space from cache content before splitting it. This
#		makes the output look a lot better.
#	20020812 Ola Lundqvist <opal@debian.org>
#		Fixed seek bug. By some strange reason you can seek to a
#		position after the end of the file.
###############################################################################
# seek(HANDLE, position, WHENCE [X+position]{SEEK_SET = 0, SEEK_CUR = 1, SEEK_END = 2})
# return 1 on success 0 otherwise.
# $curpos = tell(FILEHANDLE)
sub checkMailbox() {
    # Read the entire content.
    ($file) = @_;

    # Calculate cache file.
    my $cfile = "";
    if ($usecache) {
	if ($file =~ m|^/|) {
	    $cfile = $file;
	}
	elsif ($file =~ m|^~/|) {
	    $cfile = $file;
	    $cfile =~ s|~/|$ENV{HOME}/|;
	}
	else {
	    $cfile = "$ENV{PWD}/$file";
	}
	$cfile =~ s|/|,,|g;
    }

    my $content = "";
    my $fpos = 0;
    my $ofpos = $fpos;

    my $mtime = 0;
    my $ctime = 0;
    my $omtime = 0;
    my $octime = 0;
    my $new = 0;
    my $seen = 0;
    my $onlyread = 0;
    my $answered = 0;
    my $deleted = 0;
    if (open(F, $file)) {
	my $t = $/;
	$t = $/;
	undef $/;
	$mtime = (stat(F))[9];
	$ctime = (stat(F))[10];


	if ($usecache) {
#	    print("Use1\n");
	    if (-f "$cachedir/$cfile") {
#		print("File found $cachedir/$cfile\n");
		if (open (CF, "$cachedir/$cfile")) {
		    my $cachecontent = <CF>;
		    $cachecontent =~ s/\s//g;
		    my $junk = "";
		    ($fpos, $omtime, $octime, $new, $seen, $onlyread, $answered, $deleted, $junk)
			= split("[,\n]", $cachecontent);
		    $ofpos = $fpos;
#		    print("DEBUG: Read $fpos, $new, $seen, $onlyread, $answered, $deleted, $junk from cache!\n");
		    close(CF);
		    seek(F, $fpos, 0);
		    $fpos = tell(F);
		}
		else {
		    print("ERROR: Can not open cache file $cachedir/$cfile.\n");
		}
	    }
	}
	$content = <F>;
	$fpos = tell(F);
	if ($usecache) {
#	    print("Use2\n");
	    if (($fpos < $ofpos) ||
		# You can not be after the file...
		($fpos > (stat(F))[7]) ||
		($fpos == 0) ||
		($content !~ /^From/ && $content !~ /^$/) ||
		($content !~ /^$/ && $mtime != $omtime && $omtime != 0) ) {
		# If the file has changed, then seek position 0 and read new
		# content.
#		print("WARNING: File $file has been rewritten, seek position 0!\n");
#		$omtime = 0;
#		$octime = 0;
		$new = 0;
		$seen = 0;
		$onlyread = 0;
		$answered = 0;
		$deleted = 0;
		seek(F, 0, 0);
		$fpos = tell(F);

		$content = <F>;
		$fpos = tell(F);
	    }
	}
	$/ = $t;
	close (F);
    }
    # Separate each mail from each other.
    my @mails = split /\nFrom .* .*/, $content;
    
    my $entry;
    foreach $entry (@mails) {
	my @l = split (/\n/, $entry);
	my @stat = grep (/^Status: /, @l);
	my @xstat = grep (/^X-Status: /, @l);
	my $status = @stat[0];
	$status =~ s/Status: //;
	my $xstatus = @xstat[0];
	$xstatus =~ s/X-Status: //;
	my @tmp;
	my $t;
	my %localinterest = ();
	foreach $t (@interesting) {
	    @tmp = grep (/^Subject: /, @l);
	    $localinterest{$t} = @tmp[0];
	}
#	print ("$status\n");
	if ($xstatus =~ /D/) {
	    $deleted++;
	}
	elsif ($xstatus =~ /A/) {
	    $answered++;
	}
	elsif ($status =~ /^$/) {
	    $new++;
	}
	elsif ($status =~ /R/) {
	    $onlyread++;
	}
	elsif ($status =~ /^O$/) {
	    $seen++;
	}
#	print($entry);
    }
#    print ("====== $new, $seen, $onlyread, $answered, $deleted ====\n");
    if ($usecache) {
	# Now write data back to cache!
	if (! -d $cachedir) {
	    if (! mkpath($cachedir)) {
		print("ERROR: Unable to create cache dir $cachedir!\n");
	    }
	}
	if (open (F, ">$cachedir/$cfile")) {
	    print F "$fpos, $mtime, $ctime, $new, $seen, $onlyread, $answered, $deleted\n";
#	    print "Wrote $fpos, $mtime, $ctime, $new, $seen, $onlyread, $answered, $deleted to cachefile $cfile\n";
	    close (F);
	}
	else {
	    print("ERROR: Unable to write to $cachedir/$cfile cache file.\n");
	}
    }

    return ($new, $seen, $onlyread, $answered, $deleted);
}
