#!/usr/bin/perl
#
# Lily 1.2.3 by Todd Boland <itodd@itodd.org>
# Biff was named after a dog (who barked at the mail man).
# My mail notification utility is named after my dog, Lily.

use strict;
use Tk;			# Widget set
use Net::POP3;		# To connect to POP3 server
use Getopt::Long;	# To parse the arguments
use Pod::Usage;		# For the manual

# The pop3 password is sent via command line, hide it!
$0 = "lily.pl";

# Variables used in runtime
my ($main,@frames,@buffer,%showing,$width);
my $stamp_pixmap = do { local $/; <DATA> }; 

# These variables are for buffer rotation
my ($offscreen,$lock);

# Variable needed to emulate double click
my $next;

# Variables used for controlling ticker with the mouse
my ($click,$position);

# Default optional arguments
my $opt_bg	= "#000000";
my $opt_fg	= "#00FF00";
my $opt_interval= 60;
my $opt_timeout	= 30;

# Optional arguments
my($opt_usage, $opt_manual, $opt_agent, $opt_bark, $opt_font, $opt_geometry);

# Required arguments
my($arg_username, $arg_password, $arg_server);

# GetOptions parses the arguments from ARGV for me (Thanks ybiC@perlmonks) :)
GetOptions(
	"usage!"	=> \$opt_usage,
	"help!"		=> \$opt_usage,
	"manual!"	=> \$opt_manual,
	"username=s"	=> \$arg_username,
	"password=s"	=> \$arg_password,
	"server=s"	=> \$arg_server,
	"timeout=i"	=> \$opt_timeout,
	"fg=s"		=> \$opt_fg,
	"bg=s"		=> \$opt_bg,
	"agent=s"	=> \$opt_agent,
	"bark=s"	=> \$opt_bark,
	"font=s"	=> \$opt_font,
	"geometry=s"	=> \$opt_geometry,
	"interval=i"	=> \$opt_interval,
	"width=i"	=> \$width,

	# Maintain backwards compatibility
	"sound=s"	=> \$opt_bark,
);

# Should we print the manual or usage?
pod2usage(-verbose => 1) and exit if(defined $opt_usage);
pod2usage(-verbose => 2) and exit if(defined $opt_manual);

# Print usage and exit if the required arguments were left out
pod2usage(-verbose => 1, -message => "Required arguments missing.") and exit 
	if(!$arg_username || !$arg_password || !$arg_server);

# Convert from seconds to ms
$opt_interval = $opt_interval . ("0" x 3);

# We don't like defunct zombies
$SIG{"CHLD"} = 'IGNORE';

# Create main window
$main = new MainWindow(
	-title => "Lily",
	-bg => $opt_bg,
	-width => 640,
	-height => 35,
);

# Configure the main window
$main->overrideredirect(1);				# No decor
$main->bind("<Visibility>" => sub { $main->raise });	# Always on top
$main->withdraw;					# Initially hide it
$main->Pixmap('stamp', data => $stamp_pixmap);		# Create pixmap

# What happens when button 1 is pressed
$main->bind("<ButtonPress-1>" => sub {
	$position = $main->pointerx - $main->x;
	$click = 1;
});

# What happens when button 1 is released
$main->bind("<ButtonRelease-1>" => sub {
	$click = 0;
});

# What happens when the mouse moves inside the window
$main->bind("<Motion>" => sub {
	if($click) {
		&move_ticker($main->pointerx - $main->x - $position);
		$position = $main->pointerx - $main->x;
	}
});

# Update the main window
$main->update;

# Resize if geometry specified
$main->geometry($opt_geometry) if($opt_geometry);

# Check mail timer
$main->repeat($opt_interval, sub {
	&check_mail;
});

# We need an initial call to check the mail upon starting
&check_mail;

# Move the ticker
$main->repeat(20, sub {
	return if $click or !defined $frames[0];
	&move_ticker(-1);
});

# Main program loop
MainLoop;

# Routine to rotate messages in the buffer to the display
sub rotate_buffer {

	my($offscreen,$headers) = @_;
	my($new_from,$new_subject) = @{$headers};

	# Fetch old headers
	my($stamp,$label) = $frames[$offscreen]->children;
	my($old_subject,$old_from) = 
		split(/\n/, $label->cget("-text"));

	# Put new headers into the label
	$label->configure(
		-text => "$new_subject\n$new_from"
	);

	[$old_from, $old_subject];
}

# Routine to move the entire ticker
sub move_ticker {
	my $movement = shift;

	# This prevents underrun
	return if defined $lock;
	$lock = 1;

	# To the right?
	if($movement > 0) {
		if($frames[0]->x + $movement > $main->width) {
		
			# Move the left side
			$frames[0]->place(-x => $frames[0]->x - ($main->width + $frames[0]->width) + $movement);

			# Ratate if there are messages in the buffer
			push(@buffer, &rotate_buffer(0, shift @buffer))
				if $#buffer >= 0;
		} else {
		
			# Move along
			$frames[0]->place(-x => $frames[0]->x + $movement);
		}
	
	# To the left?
	} elsif($movement < 0) {
		if($frames[0]->x + $frames[0]->width < 0) {

			# Move to right side
			$frames[0]->place(-x => $frames[0]->x + $frames[0]->width + $main->width + $movement);

			# Rotate if there are messages in the buffer
			unshift(@buffer, &rotate_buffer(0, pop @buffer))
				if $#buffer >= 0; 
		} else {

			# Move along
			$frames[0]->place(-x => $frames[0]->x + $movement);
		}
	}

	# Update the first frame so we can get the new x coords
	$frames[0]->update;
	my $new_x = $frames[0]->x + $width;

	# Every frame should follow 256 pixels apart
	for(my $i=1; $i<=$#frames; $i++) {

		# Figure new x for frame
		$new_x = $new_x - $main->width - $width 
			if($new_x >= $main->width);

		# Should we rotate the buffer?
		if($#buffer >= 0) {
			if($frames[$i]->x > 0 && $new_x < 0 && $movement > 0) { 
				push @buffer, 
					&rotate_buffer($i, shift @buffer);

			} elsif($frames[$i]->x < 0 && $new_x > 0 && 
				$movement < 0) {
				unshift @buffer, 
					&rotate_buffer($i, pop @buffer);
			}
		}

		# Place frame, get new x coord and update
		$frames[$i]->place(-x => $new_x);
		$new_x += $width;
		$frames[$i]->update;
	}

	# unlock the routine
	$lock = undef;
}

# The routine that checks for new mail
sub check_mail {
	my($new_messages, $bark);

	# Login to POP3 server
	my $pop = new Net::POP3(
		$arg_server, 
		timeout => $opt_timeout,
	) or do {
		warn "Invalid POP3 server.";
		return;
	};

	# Count the number of messages waiting
	$new_messages = $pop->login($arg_username, $arg_password) or do {
		warn "POP3 login failed.";
		return;
	};

	# List messages
	for(my $i=1; $i<=$new_messages; $i++) {
		my($from,$subject,$id);

		# Fetch headers
		foreach my $header ($pop->top($i)) {
			foreach(@{$header}) {

				# Net::POP3 doesnt chomp for us
				chomp;
				
				# Only snag the first 43 chars to keep em short
				$from	= substr($_,0,43) if(/^(From):\s+/i);
				$subject= substr($_,0,43) if(/^(Subject):\s+/i);
				$id = $1 if(/^Message-Id:\s*(.*)$/i);
			}
		}

		# Add ... if string is longer than the allowed length
		$subject = substr($subject,0,40) . "..." if(length($subject) > 40);
		$from = substr($from,0,40) . "..." if(length($from) > 40);

		# Unless the item is already showing
		unless($showing{$id}) {
		
			# Don't show it again!
			$showing{$id} = 1;

			# Did it fit?
			if(&add_frame($from, $subject) == -1) {

				# No, put it in the buffer
				unshift @buffer, [$from, $subject];
			}

			# Toggle barking
			$bark = 1;
		}
	}

	# Close pop connection
	$pop->quit();

	# Bark?
	if($opt_bark && $bark) {
		my $pid = fork;
		if($pid == 0) {
					
			# Die after barking
			exec($opt_bark);
			exit;
		}
	}
}

# Routine to add message to display
sub add_frame {
	my($from,$subject) = @_;
	my($x,$stamp,$label);

	# Bring up main window
	$main->deiconify;
	$main->raise;

	# Where oh where shall we put it?
	$x = ($#frames >= 0) ? $width * ($#frames + 1) : 0;

	# Put it in the buffer
	return -1 if($x >= $main->width + $width); 

	# Create frame
	push @frames, $main->Frame(
		-height => $main->height,
		-bg => $opt_bg,
	)->place(-x => $x);

	# Create Stamp
	$stamp = $frames[$#frames]->Label(
		-image => 'stamp',
		-bg => $opt_bg,
	)->place(-x=>0,-y=>0);

	# Configure stamp
	$stamp->bind("<ButtonRelease-1>" => \&release ) if($opt_agent);
	$stamp->configure( -cursor => "hand2") if ($opt_agent);

	# Create label
	$label = $frames[$#frames]->Label(
		-justify => "left",
		-text => "$subject\n$from",
		-fg => $opt_fg,
		-bg => $opt_bg,
		-width => 38,
		-anchor => "w",
	)->place(-x=>0,-y=>0);

	# Configure label
	$label->configure( -font=> $opt_font) if($opt_font);
	$label->bind("<ButtonRelease-1>" => \&release ) if($opt_agent);
	$label->configure( -cursor => "hand2") if ($opt_agent);

	# Re-configure the frame
	$frames[$#frames]->update;
	$width = $label->width + $stamp->width if !defined $width;
	$frames[$#frames]->configure(-width=>$width);
	$frames[$#frames]->update;

	# Place label
	$label->place(
		-x => $stamp->width,
		-y => $frames[$#frames]->height / 2 - $label->height / 2,
	);

	# Place stamp
	$stamp->place(
		-x => 0,
		-y => $frames[$#frames]->height / 2 - $stamp->height / 2,
	);
}

# Mouse release routine
sub release {

	# Cancel any moves
	$click = 0;

	# Emulate a double click since Double-ButtonPress 
	# doesn't work on moving labels
	if(!$next) {
	
		# Double click rate is 250ms
		$main->after(250, sub {
			$next = 0;
		});
		$next = 1;

		# It's only the first click, return
		return;
	}
	$next = 0;

	# Destroy the active frames
	while(my $frame = pop @frames) {
		my @children = $frame->children;
		foreach(@children) {
			$_->destroy();
		}
		$frame->destroy();
	}

	# Return buffer and frames arays to their defaults
	undef @buffer;
	undef @frames;

	# Launch email client?
	if($opt_agent) {
		my $pid = fork;
		if($pid == 0) {

			# Launch the  mail client
			exec($opt_agent);
			exit;
		}
		$main->withdraw;
	}
}

# The pod
=head1 NAME

lily.pl

=head1 SYNOPSIS

lily.pl [-option=VALUE ...] B<-username=USERNAME -password=PASSWORD -server=SERVER>

=head1 DESCRIPTION

Scrolls From: and Subject: headers of all email found on SERVER using USERNAME 
and PASSWORD as the login information.

=head1 ARGUMENTS

=item B<-server=SERVER>		Use SERVER as the POP3 server

=item B<-username=USERNAME>	Use USERNAME for username on SERVER

=item B<-password=PASSWORD>	Use PASSWORD for password on SERVER

=head1 OPTIONS

=item -timeout=SECONDS	Timeout after SECONDS seconds

=item -fg=COLOR			Use COLOR for the foreground

=item -bg=COLOR			Use COLOR for the background

=item -agent=COMMAND		Execute COMMAND to launch mail agent

=item -bark=COMMAND		Execute COMMAND on new mail

=item -font=FONT		Use FONT to display headers

=item -width=PIXELS		Make each message PIXELS pixels wide

=item -geometry=GEOMETRY	Use GEOMETRY to map window

=item -interval=SECONDS	Check mail every SECONDS seconds

=item -manual			Display the manual

=item -usage			Show usage screen

=head1 EXAMPLE

This is my configuration:

lily.pl -bark="plaympeg /home/itodd/newmail.mp3" -agent="mozilla -remote xfeDoCommand\(openInbox\) || mozilla -mail" -interval=30 -font="-*-helvetica-medium-r-*-*-10-*-*-*-*-*-*-*" -geometry="1280x30+0-0" -width=256 B<-username=USERNAME -password=PASSWORD -server=SERVER>

=head1 AUTHOR

Todd Boland <itodd@itodd.org> http://www.itodd.org

=cut

# The stamp xpm
__DATA__
/* XPM */
static char * stamp_xpm[] = {
"16 16 3 1",
" 	c None",
"#	c #FFFFFF",
"%	c #0000FF",
"                ",
" ##  ##  ##  ## ",
" ############## ",
"  #%%%%%%%%%%#  ",
"  #%%%%##%%%%#  ",
" ##%%%####%%%## ",
" ##%%######%%## ",
"  #%%%%##%%%%#  ",
"  #%%%%##%%%%#  ",
" ##%%%%##%%%%## ",
" ##%%%%##%%%%## ",
"  #%%%%%%%%%%#  ",
"  #%%%%%%%%%%#  ",
" ############## ",
" ##  ##  ##  ## ",
"                "};