#!/usr/bin/perl -w

#################################################################################
#
# 	spliff v0.8.1 (Fri Jan 28 2000)
#	
#	Written by Justin R. Miller <justin@openup.com>
#
# 	http://openup.com/justin/software/spliff/
#
#	This software is released as freeware; feel free to modify it 
#	to your liking.  I would appreciate it if you would let me know 
#	of any changes or suggestions that you have.  
#	
#################################################################################

$title = 'spliff v0.8.1';

use Tk;
use Tk::widgets qw(ErrorDialog Balloon NoteBook LabFrame FBox);
use Mail::Cclient qw(set_callback);

$prefsfile = $ENV{'HOME'} . '/.spliffrc';

%defaults = (hostname     =>    'localhost',
             protocol     =>    'imap',
             username     =>    '',
             password     =>    '',
             interval     =>    '15',
             size         =>    '5',
             beep         =>    'y',
             fontface     =>    'Times',
             fontsize     =>    '10',
             xlocation    =>    '0',
             ylocation    =>    '0',
             soundplayer  =>    '',
             soundfile    =>    '',
             mailer       =>    '');

&initprefs;

$mainwindow = MainWindow->new;
$mainwindow->title($title);
$mainwindow->geometry('+' . $saved{'xlocation'} . '+' . $saved{'ylocation'});
$mainwindow->resizable(0, 0);
$mainwindow->protocol('WM_DELETE_WINDOW', \&savegeometryexit);
$mainwindow->bind('<Button-1>', \&update);
$mainwindow->bind('<Button-2>', sub { $mainwindow->withdraw() } );
$mainwindow->bind('<Button-3>', \&prefswindow);
$mainwindow->bind('<Control-Button-1>', \&startmailer);

&setfonts;
&dotopframe;
&domiddleframe;
&dobottomframe;
	
if ($newuser) {
	$mainwindow->withdraw();
	&prefswindow;
}
else {
	$status = "Connecting to $active{'hostname'}...";
	$mainwindow->after(1000, \&update);
	$mainwindow->repeat($active{'interval'} * 60000, \&update);
}

MainLoop;

################################################################################
#
# 	initprefs:
#
# 	- read preferences from disk if they exist
#
# 		@saved = prefs as they exist in prefs file
# 		@active = prefs as they exist in main window
# 		@prefs = prefs as they exist in prefs window
# 		@defaults = default prefs hardcoded in script
#
#	- set preferences to defaults if they don't exist
# 	- initialize message count at last update to zero
#
################################################################################

sub initprefs {
	
	if (open(PREFS,"<$prefsfile")) {
		# attempt to read saved prefs
		@prefscontents = <PREFS>;
		close(PREFS);
		foreach (@prefscontents) {
			/^#/ and next;
			/^hostname: (.+)/ and $saved{'hostname'} = $1;
			/^protocol: (\w{4})/ and $saved{'protocol'} = $1;
			/^username: (\w+)/ and $saved{'username'} = $1;
			/^password: (\w+)/ and $saved{'password'} = $1;
			/^interval: (\d+)/ and $saved{'interval'} = $1;
			/^size: (\d+)/ and $saved{'size'} = $1;
			/^beep: ([yn])/ and $saved{'beep'} = $1;
			/^fontface: (.+)/ and $saved{'fontface'} = $1;
			/^fontsize: (.+)/ and $saved{'fontsize'} = $1;
			/^xlocation: (\d+)/ and $saved{'xlocation'} = $1;
			/^ylocation: (\d+)/ and $saved{'ylocation'} = $1;
			/^soundplayer: (.+)/ and $saved{'soundplayer'} = $1;
			/^soundfile: (.+)/ and $saved{'soundfile'} = $1;
			/^mailer: (.+)/ and $saved{'mailer'} = $1;
		}
		while (($key,$value) = each %saved) {
			$prefs{$key} = $active{$key} = $saved{$key};
    		}
	} 
	else {
		# set prefs to default prefs
		while (($key,$value) = each %defaults) {
			$prefs{$key} = $active{$key} = $saved{$key} = $defaults{$key};
    		}
		$newuser = 1;
	}

	$lastcount = 0;

}

################################################################################
#
# 	update:
#
# 	- connect to server and grab latest message information
# 	- update status message
#	- check for new mail and perform necessary actions
#	- update count placeholder
#
################################################################################

sub update {

	# check for necessary variables
	if (!$active{'hostname'} || !$active{'protocol'} || !$active{'username'} || !$active{'password'}) {
		$status = 'Invalid server configuration';
		return();
	}
	
	# set login callback
	set_callback(login => sub { return ($active{'username'}, $active{'password'}) } );

	# attempt to connect to server
	$mail = Mail::Cclient->new('{' . $active{'hostname'} . '/' . $active{'protocol'} . '}INBOX', 'readonly');
	if (!$mail) {
		$status = "Unable to connect to $active{'hostname'} via " . uc($active{'protocol'});
		return();
	}

	# determine latest message count
	$count = $mail->nmsgs();

	# determine count status message
	if ($count == 0) {
		$status = "There are no messages on $active{'hostname'}";
	}
	else {
		if ($count <= $active{'size'}) {
			$shown = $count;
		}
		else {
			$shown = $active{'size'};
		}
		$status = "Most recent $shown of $count messages on $active{'hostname'}";
	}

	# read in the message summaries
	$last = $count - $active{'size'};
	@headers = ('From','Subject','Date');
	for ($loop = $count; $loop > $last; $loop--) {
		$message = $loop - $last;
		$from[$message] = $subject[$message] = $date[$message] = '';
		if ($loop > 0) {
			@lines = split(/\n/, $mail->fetchheader($loop, \@headers));
			foreach (@lines) {
				/^From: (.*)/ and $from[$message] = $1;
				/^Subject: (.*)/ and $subject[$message] = $1;
				/^Date: (.*)/ and $date[$message] = $1;
			}
		}
	}

	# disconnect from server
	$mail->close;

	# notify if new mail
	if ($count > $lastcount) {
		if ($notfirstupdate) {
			if ($active{'soundplayer'} && $active{'soundfile'}) {
				system($active{'soundplayer'} . ' ' . $active{'soundfile'} . ' >& /dev/null &');
			}
			$mainwindow->bell() if $active{'beep'} eq 'y';
		}
		$mainwindow->deiconify();
		$mainwindow->raise();
	}
	$notfirstupdate = 1;
	
	$lastcount = $count;

}

################################################################################
#
# 	savegeometryexit:
#
# 	- remember main window coordinates
#	- exit program
#
################################################################################

sub savegeometryexit {

	if (!$newuser) {
		$exitgeometry = $mainwindow->geometry();
		$exitgeometry =~ s/\d+x\d+\+//;
		($saved{'xlocation'}, $saved{'ylocation'}) = split(/\+/, $exitgeometry);
		&saveprefs;
	}

	exit();
	
}

################################################################################
#
#	 prefswindow:
#
# 	- set prefs window settings to active settings
# 	- bring up prefs window
#
################################################################################

sub prefswindow {

	if (!Exists($prefswindow)) {
		# create prefs window
		$prefswindow = $mainwindow->Toplevel();
		$prefswindow->title('spliff preferences');
		$prefswindow->resizable(0, 0);
		$prefswindow->protocol('WM_DELETE_WINDOW', \&cancelprefs);
		$prefswindow->bind('<Alt-o>', \&okprefs);
		$prefswindow->bind('<Alt-a>', \&applyprefs);
		$prefswindow->bind('<Alt-c>', \&cancelprefs);
		$prefswindow->bind('<KeyPress-Escape>', \&cancelprefs);
		
		$prefsbook = $prefswindow->NoteBook()->pack(-expand => 1, -fill => 'both', -padx => 5, -pady => 2);

		$serverpage = $prefsbook->add('server', -label => 'Server');
		$serverinfoframe = $serverpage->LabFrame(-label => 'Server info', -labelside => 'acrosstop')->pack(-expand => 1, -fill => 'both');
		$serverinfoframe->Label(-text => 'Hostname:', -justify => 'left', -anchor => 'e')->grid($serverinfoframe->Entry(-textvariable => \$prefs{'hostname'}), "-", -pady => 5, -sticky => 'nsew');
		$serverinfoframe->Label(-text => 'Username:', -justify => 'left', -anchor => 'e')->grid($serverinfoframe->Entry(-textvariable => \$prefs{'username'}), "-", -pady => 5, -sticky => 'nsew');
		$serverinfoframe->Label(-text => 'Password:', -justify => 'left', -anchor => 'e')->grid($serverinfoframe->Entry(-textvariable => \$prefs{'password'}, -show => '*'), "-", -pady => 5, -sticky => 'nsew');
		$serverprotocolframe = $serverpage->LabFrame(-label => 'Server protocol', -labelside => 'acrosstop')->pack(-expand => 1, -fill => 'both');
		$serverprotocolframe->Radiobutton(-text => 'IMAP', -variable => \$prefs{'protocol'}, -value => 'imap')->pack(-anchor => 'n', -side => 'left', -expand => '1', -fill => 'both', -padx => 5, -pady => 5);
		$serverprotocolframe->Radiobutton(-text => 'POP3', -variable => \$prefs{'protocol'}, -value => 'pop3')->pack(-anchor => 'n', -side => 'left', -expand => '1', -fill => 'both', -padx => 5, -pady => 5);
		$serverintervalframe = $serverpage->LabFrame(-label => 'Update interval in minutes', -labelside => 'acrosstop')->pack(-expand => 1, -fill => 'both');
		$serverintervalframe->Scale(-from => 1, -to => 30, -orient => 'horizontal', -variable => \$prefs{'interval'})->pack(-fill => 'both', -padx => 5, -pady => 2);

		$featurespage = $prefsbook->add('features', -label => 'Features');
		$featuresfontfaceframe = $featurespage->LabFrame(-label => 'Font face', -labelside => 'acrosstop')->pack(-expand => 1, -fill => 'both');
		$featuresfontfaceframe->Entry(-textvariable => \$prefs{'fontface'})->pack(-expand => 1, -fill => 'x', -padx => 5, -pady => 2);
		$featuresfontsizeframe = $featurespage->LabFrame(-label => 'Font size', -labelside => 'acrosstop')->pack(-expand => 1, -fill => 'both');
		$featuresfontsizeframe->Entry(-textvariable => \$prefs{'fontsize'})->pack(-expand => 1, -fill => 'x', -padx => 5, -pady => 2);
		$featuresmailerframe = $featurespage->LabFrame(-label => 'Mailer', -labelside => 'acrosstop')->pack(-expand => 1, -fill => 'both');
		$featuresmailerframe->Entry(-textvariable => \$prefs{'mailer'})->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 5, -pady => 2);
		$featuresmailerframe->Button(-text => 'Browse...', -command => [ \&selectfile, 'mailer' ] )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 5, -pady => 2);
		$featuressizeframe = $featurespage->LabFrame(-label => 'Number of messages to show', -labelside => 'acrosstop')->pack(-expand => 1, -fill => 'both');
		$featuressizeframe->Scale(-from => 1, -to => 10, -orient => 'horizontal', -variable => \$prefs{'size'})->pack(-fill => 'both', -padx => 5, -pady => 2);

		$soundpage = $prefsbook->add('sound', -label => 'Sound');
		$soundplayerframe = $soundpage->LabFrame(-label => 'Sound player', -labelside => 'acrosstop')->pack(-expand => 1, -fill => 'both');
		$soundplayerframe->Entry(-textvariable => \$prefs{'soundplayer'})->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 5, -pady => 2);
		$soundplayerframe->Button(-text => 'Browse...', -command => [ \&selectfile, 'soundplayer' ] )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 5, -pady => 2);
		$soundfileframe = $soundpage->LabFrame(-label => 'Sound to play on new mail', -labelside => 'acrosstop')->pack(-expand => 1, -fill => 'both');
		$soundfileframe->Entry(-textvariable => \$prefs{'soundfile'})->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 5, -pady => 2);
		$soundfileframe->Button(-text => 'Browse...', -command => [ \&selectfile, 'soundfile' ] )->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 5, -pady => 2);
		$soundbeepframe = $soundpage->LabFrame(-label => 'Beep on new mail', -labelside => 'acrosstop')->pack(-expand => 1, -fill => 'both');
		$soundbeepframe->Radiobutton(-text => 'Yes', -variable => \$prefs{'beep'}, -value => 'y')->pack(-anchor => 'n', -side => 'left', -expand => '1', -fill => 'both', -padx => 5, -pady => 2);
		$soundbeepframe->Radiobutton(-text => 'No', -variable => \$prefs{'beep'}, -value => 'n')->pack(-anchor => 'n', -side => 'left', -expand => '1', -fill => 'both', -padx => 5, -pady => 2);

		$aboutpage = $prefsbook->add('about', -label => 'About');
		$aboutframe = $aboutpage->LabFrame(-label => $title, -labelside => 'acrosstop')->pack(-expand => 1, -fill => 'both');
		$aboutframe->Label(-text => "A mail-watching utility\n\nJustin R. Miller\n<justin\@openup.com>", -justify => 'left')->pack(-expand => 1, -fill => 'both', padx => 5, -pady => 5);

		$prefsbottomframe = $prefswindow->Frame()->pack(-expand => 1, -fill => 'x');
		$prefsbottomframe->Button(-text => 'Ok', -command => \&okprefs, -width => 6, -underline => 0, -default => 'active')->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 10, -pady => 5);
		$prefsbottomframe->Button(-text => 'Apply', -command => \&applyprefs, -underline => 0, -width => 6)->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 10, -pady => 5);
		$prefsbottomframe->Button(-text => 'Cancel', -command => \&cancelprefs, -underline => 0, -width => 6)->pack(-side => 'left', -expand => 1, -fill => 'x', -padx => 10, -pady => 5);
	}
	else {
		# bring up existing prefs window
		$prefswindow->deiconify();
		$prefswindow->raise();
	}

}

################################################################################
#
# 	selectfile:
#
# 	- bring up file selector for file named in argument
# 	- return either selected file or original if cancelled
#
################################################################################

sub selectfile {

	# get prefs argument
	$selectfile = $_[0];
	
	# remember original file
	$initialfile = $prefs{$selectfile};

	# create the selection dialog
	$fileselector = $prefswindow->FBox(-title => "Choose a $selectfile", -initialdir => $ENV{'HOME'});

	# grab the return value
	$prefs{$selectfile} = $fileselector->Show;

	# go back to old value if user cancelled
	if (!$prefs{$selectfile}) {
		$prefs{$selectfile} = $initialfile;
	}
	
}

################################################################################
#
# 	setfonts:
#
# 	- set up the bold and normal font strings
#
################################################################################

sub setfonts {

	$normalfont = $active{'fontface'} . ' ' . $active{'fontsize'} . ' ' . 'normal';
	$boldfont = $active{'fontface'} . ' ' . $active{'fontsize'} . ' ' . 'bold';

}

################################################################################
#
# 	dotopframe:
#
# 	- create main window top frame (column headings)
#
################################################################################

sub dotopframe {

	$topframe = $mainwindow->Frame(-relief => 'raised', -borderwidth => 1)->pack(-fill => 'x');
	$fromheader = $topframe->Label(-text => 'From', -font => $boldfont, -width => 15, -padx => 5, -pady => 0, -anchor => 'w');
	$subjectheader = $topframe->Label(-text => 'Subject', -font => $boldfont, -width => 25, -padx => 5, -pady => 0, -anchor => 'w');
	$dateheader = $topframe->Label(-text => 'Date', -font => $boldfont, -width => 20, -padx => 5, -pady => 0, -anchor => 'w');
	$fromheader->grid($subjectheader, $dateheader);
	
}

################################################################################
#
# 	domiddleframe:
#
# 	- create main window middle frame (message summaries)
#
################################################################################

sub domiddleframe {

	$middleframe = $mainwindow->Frame()->pack(-fill => 'x');
	for ($loop = $active{'size'}; $loop > 0; $loop--) {
		$fromcell = $middleframe->Label(-textvariable => \$from[$loop], -font => $normalfont, -width => 15, -padx => 5, -pady => 0, -anchor => 'w');
		$subjectcell = $middleframe->Label(-textvariable => \$subject[$loop], -font => $normalfont, -width => 25, -padx => 5, -pady => 0, -anchor => 'w');
		$datecell = $middleframe->Label(-textvariable => \$date[$loop], -font => $normalfont, -width => 20, -padx => 5, -pady => 0, -anchor => 'w');
		$fromcell->grid($subjectcell, $datecell);
	}
	$helpballoon = $middleframe->Balloon(-balloonposition => 'mouse');
	$helpballoon->attach($middleframe, -msg => "<Button-1> Update\n<Button-2> Hide\n<Button-3> Preferences\n<Control-Button-1> Start mailer", -initwait => 1000);

}

################################################################################
#
# 	dobottomframe:
#
# 	- create main window bottom frame (status message)
#
################################################################################

sub dobottomframe {

	$bottomframe = $mainwindow->Frame(-relief => 'raised', -borderwidth => 1)->pack(-fill => 'x');
	$bottomframe->Label(-textvariable => \$status, -font => $normalfont, -pady => 0)->pack();

}

################################################################################
#
# 	startmailer:
#
# 	- starts external mail program
#
################################################################################

sub startmailer {

	sleep 1;
	if ($active{'mailer'}) {
		system($active{'mailer'} . ' >& /dev/null &');
	}

}

################################################################################
#
# 	okprefs:
#
# 	- call apply and save routines
#	- destroy prefs window
#
################################################################################

sub okprefs {

	&applyprefs;
	&saveprefs;

	$prefswindow->destroy();

}

################################################################################
#
# 	applyprefs:
#
#	- redraw main window if necessary
# 	- apply selected preferences
#	- bring main window up and to the front
#	- call update routine
#
################################################################################

sub applyprefs {

	if ($active{'size'} != $prefs{'size'} || $active{'fontface'} ne $prefs{'fontface'} || $active{'fontsize'} ne $prefs{'fontsize'}) {
		$active{'size'} = $prefs{'size'};
		$active{'fontface'} = $prefs{'fontface'};
		$active{'fontsize'} = $prefs{'fontsize'};
		&setfonts;
		&redraw;
	}

	while (($key,$value) = each %defaults) {
		$active{$key} = $prefs{$key};
    	}

	$mainwindow->deiconify();
	$mainwindow->raise();

	&update;

}

################################################################################
#
# 	cancelprefs:
#
#	- exit if new user
#	- redraw main window if necessary
# 	- revert to saved preferences
#	- destroy prefs window
# 	- call update routine
#
################################################################################

sub cancelprefs {

	if ($newuser) {
		exit();
	}

	if ($active{'size'} != $saved{'size'} || $active{'fontface'} ne $saved{'fontface'} || $active{'fontsize'} ne $saved{'fontsize'}) {
		$active{'size'} = $saved{'size'};
		$active{'fontface'} = $saved{'fontface'};
		$active{'fontsize'} = $saved{'fontsize'};
		&setfonts;
		&redraw;
	}

	while (($key,$value) = each %defaults) {
		$active{$key} = $prefs{$key} = $saved{$key};
    	}

	$prefswindow->destroy();

	&update;

}

################################################################################
#
# 	saveprefs:
#
# 	- modify all preferences on disk if not called by savegeometryexit
#	- modify only geometry on disk if called by savegeometryexit
#	- indicate no longer a new user
#
################################################################################

sub saveprefs {

	if (!$exitgeometry) {
		while (($key,$value) = each %defaults) {
			if ($prefs{$key}) {
				$saved{$key} = $active{$key} = $prefs{$key};
			}
			else {
				$saved{$key} = $active{$key} = $prefs{$key} = $defaults{$key};
			}
		}
	}

	open(PREFS,">$prefsfile");
	chmod(0600, $prefsfile);
	print PREFS "#\n# spliff preferences file\n#\n";
    	foreach $key (sort(keys %saved)) {
		print PREFS "$key: $saved{$key}\n";
	}
	close(PREFS);

	$newuser = 0 if ($newuser);

}

################################################################################
#
# 	redraw:
#
# 	- recreate main window
#
################################################################################

sub redraw {

	$topframe->destroy() if (Exists($topframe));
	$middleframe->destroy() if (Exists($middleframe));
	$bottomframe->destroy() if (Exists($bottomframe));
	&dotopframe;
	&domiddleframe;
	&dobottomframe;

}