#!/usr/bin/perl
################################################################
# A simple mail counter _ _ 
#   ___ _ __ ___   __ _(_) | by Chip Marshall (InterNIC: CLM21)
#  / __| '_ ` _ \ / _` | | | http://www.chocobo.cx/chip/
# | (__| | | | | | (_| | | | chip@chocobo.cx
#  \___|_| |_| |_|\__,_|_|_| $Revision: 3.1 $
################################################################
# Copyright (c) 2001 Charles L. S. Marshall
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
# $Id: cmail,v 3.1 2001/03/26 20:48:14 chip Exp chip $
################################################################
# $Log: cmail,v $
# Revision 3.1  2001/03/26 20:48:14  chip
# Now with POD documentation!
#
################################################################
use Env qw(HOME);	# Imports the $HOME variable

my $usecolor = 0;
if ( eval "require Term::ANSIColor" ) {
	$usecolor = 1;
}

# Version information 
my $VERSION;
( $VERSION ) = '2.11';

$rcfile = "$HOME/.cmailrc";

use Getopt::Std;
getopts('dc:hn');
$debug = $opt_d;
warn "DEBUG: Debug mode active via command line switch.\n" if $debug;
$rcfile = $opt_c if $opt_c;
$usecolor = 0 if $opt_n;
do { &printhelp; exit; } if $opt_h;

# Open the rc file and begin to parse
open(RC,"<$rcfile") || die "Couldn't open $rcfile :\n\t$!";
while(<RC>) {
	next if ($_ =~ /^#/);	# Skip if line is a comment

	# Split URI from description, parse URI into usable format
	chomp($_);
	my($uri,$descr,$color) = split(/\t+/,$_);
	warn "DEBUG: URI = \'$uri\' DESCR = \'$descr\'\n" if $debug;

	$uri =~ /(.*):\/\/(.*?)\/(.*)/;
	my($proto,$usrhst,$path) = ($1,$2,$3);
	warn "DEBUG: Protocol = \'$proto\' Userhost = \'$usrhst\' Path = \'$path\'\n" if $debug;

	print Term::ANSIColor::color($color) if $usecolor;
	if ($proto eq 'file') {
		&filecount('/'.$path,$descr);
	} elsif ($proto eq 'pop3') {
		&popcount($usrhst,$descr);
	}
	print Term::ANSIColor::color('reset') if $usecolor;
}
close(RC);

sub printhelp {
	print <<ENDHELP;
cmail online help
cmail v 2.11 2000/01/12

Command line switches -
  -d         Enter debug mode. Displays many messages about each mailbox
  -c [file]  Change config file to [file]. Config file defaults to ~/.cmailrc
  -n         Disables the use of colors
  -h         Displays this message
ENDHELP
}

sub filecount {
	($file,$name) = @_;
	($messages,$old) = (0,0);

	warn "DEBUG::file File = \'$file\' Name = \'$name\'\n" if $debug;
	warn "DEBUG::file Checking $file for size and readablitiy...\n" if $debug;

	# Now test the file to make sure it exists and has size
	return unless (-e $file and -s $file);
	# and warn if we can't read it, or it isn't text
	unless (-r $file) {
		warn "WARN::file $file is not readable by me. skipping...\n";
		return;
	}
	unless (-T $file || $file =~ /\.gz$/) {
		warn "WARN::file $file is not normal text. skipping...\n";
		return;
	}
	# if we got here, everything should be nominal
	warn "DEBUG::file File is OK. Checking for mail...\n" if $debug;

	# Open the file and slurp it into an array of lines
	undef @file;
	if ($file =~ /\.gz$/) { # File ends with .gz, assume gzip file
		require Compress::Zlib;
		warn "DEBUG::file::gz Opening gzipped file...\n" if $debug;
		my $gz = Compress::Zlib::gzopen($file,"r");
		my $line = '';
		my $x = 0;
		warn "DEBUG::file::gz Reading gzipped file...\n" if $debug;
		while ($gz->gzreadline($line) > 0) {
			$file[$x] = $line;
			$x++;
		}
		$gz->gzclose;
	} else {	# normal file
		open(MAILBOX,"<$file") || die "Can't open $file : $!";
		for (my($x)=0; $file[$x] = <MAILBOX>; $x++) {};
		close MAILBOX;
	}

	warn "DEBUG::file File slurped in. $#file lines.\n" if $debug;

	# And check for the number of total messages
	my($grepcount) = 0;
	$messages = grep {
		$grepcount++, print "\r$grepcount" if $debug;
		$old++ if /^Status:.*O/;	# Get old messages as side effect
		/^From .* [MTWFS][a-z]{2} [A-Z][a-z]{2} [ 0-9]{2} [0-9:]{8} [0-9]{4}/;
	} @file;
	($new) = $messages - $old;	# Compute new count from total and old;

	warn "DEBUG::file New = $new\tOld = $old\tTotal = $messages\n" if $debug;

	# And print it out nicely with correct plurals
	$s = "";
	($s) = "s" if $messages > 1;
	if ($new > 0) { $new = "($new new)" } else { $new = '' }
	write;
	return;
}

sub popcount {
	my $userhost = $_[0];
	$name = $_[1];
	undef $messages;
	undef $old;
	undef $new;

	$userhost =~ /(.*):(.*)\@(.*)/;
	my($user,$pass,$host) = ($1,$2,$3);
	warn "DEBUG:pop User = \'$user\' Pass = \'$pass\' Host = \'$host\'\n" if $debug;
	
	require Net::POP3;

	warn "DEBUG:pop Opening POP3 connection to $host...\n" if $debug;
	my($pop) = Net::POP3->new($host);
	if ($pop eq undef) {
		warn "ERROR: Could not connect to $host for POP3!\n";
		return;
	}

	warn "DEBUG:pop Sending username and password...\n" if $debug;
	$messages = $pop->login($user,$pass);
	if ($messages eq undef) {
		warn "ERROR: POP3 Authentication failed. Bad password or server error.\n";
		return;
	}

	warn "DEBUG:pop Closing POP3 connection\n" if $debug;
	$pop->quit;
	write;
	return;
}

format =
@>>>>>>>>>>>>>>>>>>>>>>>> @### message@ @<<<<<<<<<<<<
$name,                    $messages, $s, $new
.

quit;
__END__

=head1 NAME

B<cmail> - a simple mail counter

=head1 SYNOPSIS

B<cmail> [B<-dnh>] [B<-c> F<config>]

=head1 DESCRIPTION

cmail reads in ~/.cmailrc for a list of mailboxes names and
mailbox paths (full paths) and checks each box for new and old
mail. It the prints out the description, and the number of
total messages, followed by the number of new message if there
are any. Command line options are:

=over 4

=item B<-d>

enables debug mode, printing what cmail is trying to do

=item B<-c>

lets you specify a different config file

=item B<-n>

disables the use of color

=item B<-h>

prints a helpful help message

=back

=head1 CONFIGURATION FILE

The cmail configuration file contains a number of lines, each describing
a single mailbox to check. Each line has three fields, a box URL, a
description, and an optional color. Each field is seperated by one or
more tabs. For example, the following is an entry for /var/mail/chip:

 file:///var/mail/chip 	Inbox	   green

If Net::POP3 is installed, you can also have cmail check for mail in
POP3 mailboxes, using config lines like:

 pop3://user:passwd@mailhost/	POP3 Box	yellow

For a list of accepted colors, check L<Term::ANSIColor>.

=head1 OPTIONAL COMPONENTS

For some added features, you may want to install some of the
following Perl modules

=over 4

=item Net::POP3

Adds the ability for cmail to display number of messages waiting on a POP3 server

=item Term::ANSIColor

Adds spiffy color ability to cmail

=item Compress::Zlib

Allows cmail to read gzipped mailboxes

=back

=head1 FILES

=over 4

=item F<~/.cmailrc>

cmail configuration file

=back

=head1 AUTHOR

Chip Marshall E<lt>chip@chocobo.cxE<gt> http://www.chocobo.cx/chip/
