#!/usr/bin/perl

use strict;
use warnings;

use momjian_us;

###

# Usage:  mcal [-a] [-d] [-x] [month [year]]
# -a all entries
# -d debug
# -x exclude birhtdays

use File::stat;
use File::Temp 'tempfile';
use File::Basename;
use Fcntl ':flock';
use Getopt::Std;
use POSIX 'strftime';
use Readonly;
use Text::Tabs;
use Text::Wrap;
use Time::localtime;
use Term::ReadKey;

# lesskey forces redraw for up/down arrow
Readonly my $LESSFLAGS => '-rE -k/u/mcal/lesskey.bin';
Readonly my $BASE => basename("$0");
Readonly my $indent_spaces => 22;

Readonly my $TERM => (defined($ENV{'TERM'}) && -t STDIN) ? $ENV{'TERM'} : 'dumb';

# 10000 is too large
Readonly my $WIDTH => defined($ENV{'COLUMNS'}) ? $ENV{'COLUMNS'} :
	(! -t STDIN) ? 1000 : (GetTerminalSize())[0];

# `` returns undef is no string is returned, so use //
Readonly my $ENTRYRESET => `tput -T $TERM sgr0` // '';

# bold
# if stdin is /dev/null, $ENTRYRESET is undefined, not sure why, 2011-12-22
Readonly my $CALRESET => $ENTRYRESET . (($TERM eq 'xterm') ?
		`tput -T $TERM setaf 8` // '' :
		`tput -T $TERM setaf 3; tput -T $TERM bold` // '');
# reverse
Readonly my $CALACTIVE => `tput -T $TERM rev` // '';
# red
Readonly my $MARK_CURDAY => `tput -T $TERM bold; tput -T $TERM setaf 9` // '';

Readonly my $GREENBAR => ($TERM eq 'xterm') ? `tput -T $TERM setaf 4` // '' : `tput -T $TERM setaf 2; tput -T $TERM bold` // '';


my %options;

# must be global for sort comparison access
my %current_date;

sub set_defaults ()
{
	$options{args_supplied} = 0;
	$options{print_all}     = 0;
	$options{exclude}       = 0;

	@current_date{qw(day month year)} =(localtime->mday(), localtime->mon(), localtime->year());
	$current_date{year} += 1900;
	$current_date{month}++;

	# strip off leading zero
	$current_date{month} += 0;
	return;
}

# find month X months in the future
sub get_future_month ($)
{
	return ($current_date{month} + shift() - 1) % 12 + 1;
}

# find year X months in the future, X <= 12
sub get_future_year_of_month ($)
{
	return ($current_date{year} + ($current_date{month} + shift() > 12));
}

sub get_mcal_args ()
{
	my %argv_opts;

	$options{args_supplied} = 1 if (@ARGV);

	getopts('adx', \%argv_opts) or exit(1);

	$options{print_all} = $argv_opts{a};
	$options{debug} = $argv_opts{d};
	$options{exclude} = $argv_opts{x};

	$current_date{day} = 0 if ($options{print_all});

	# Get arguments if supplied
	$current_date{month} = shift @ARGV if (@ARGV);
	$current_date{year}  = shift @ARGV if (@ARGV);
	die "$BASE:  Too many arguments\n" if (@ARGV);

	# strip off leading zero
	$current_date{month} += 0;
	return;
}

sub can_use_cache ()
{
	my $stat_main = stat("/u/mcal/$BASE");

	my $stat_cache = stat("/u/mcal/cache/$BASE.$TERM.$WIDTH");

	# Can we display the cached copy for this terminal type?
	if (
		   !$options{args_supplied}
		&& defined($stat_main)
		&& defined($stat_cache)
		&& $stat_main->mtime < $stat_cache->mtime

		# is local timezone?
		&& (!defined($ENV{'TZ'}) || $ENV{'TZ'} =~ m/^E.T$/)
	  )
	{
		system(qq(less $LESSFLAGS /u/mcal/cache/$BASE.$TERM.$WIDTH; echo -n "$ENTRYRESET"));
		exit(0);
	}
	return;
}

sub print_error_entry ($)
{
	my $entry = shift();

	for my $key (keys %$entry)
	{
		(my $capkey = $key) =~ s/(\w+)/\L\u$1/g;
		print STDERR "$capkey = " . $entry->{$key} . "\n";
	}
	print STDERR "\n";
	return;
}

sub entry_cmp ()
{

	# months differ?
	if ($a->{month} != $b->{month})
	{
		return 1
		  if (     $a->{month} < $current_date{month}
			&& $b->{month} >= $current_date{month});
		return -1
		  if (     $a->{month} >= $current_date{month}
			&& $b->{month} < $current_date{month});

		# both are before or after $current_date{month}
		# so they must be in the same year
		return ($a->{month} <=> $b->{month});
	}

	# days differ?
	return ($a->{day} <=> $b->{day}) if ($a->{day} != $b->{day});

	# times differ?  At least one is not blank.
	if ($a->{time} ne $b->{time})
	{

		# One blank time?  It goes first unless they are birthdays 
		# (parens), in which case they go last.
		return ($b->{description} =~ m/^\(/ ? -1 : 1)
		  if ($a->{time} && !$b->{time});
		return ($a->{description} =~ m/^\(/ ? 1 : -1)
		  if (!$a->{time} && $b->{time});

		# No blanks; both integers (years)?
		return ($a->{time} <=> $b->{time})
		  if ($a->{time} =~ m/^\d*$/ && $b->{time} =~ m/^\d*$/);

		# Not both integers;  is one an integer?  If so, years after times
		return 1 if ($a->{time} =~ m/^\d*$/);
		return -1 if ($b->{time} =~ m/^\d*$/);

		# time defined for both entries?
		# ?: allows grouping without backreferences
		if ($a->{time} !~ m{^(?:(\d*):(\d*))?([ap]m?|nn?|md?)?$})
		{
			print "Invalid time entry\n";
			print_error_entry($a);
			sleep(1);
			return 0;
		}

		# set ordering of meridian values
		# midnight, AM, noon, PM
		my $a_meridian =
		    $3 eq 'm'  ? 1
		  : $3 eq 'md' ? 1
		  : $3 eq 'a'  ? 2
		  : $3 eq 'am' ? 2
		  : $3 eq 'n'  ? 3
		  : $3 eq 'nn' ? 3
		  : $3 eq 'p'  ? 4
		  : $3 eq 'pm' ? 4
		  :             0;

		my $a_hour = 
			(defined($1) && $1 != 12) ? $1 :
			(defined($1) && $1 == 12) ? 0 :
			# not defined
			($a_meridian == 2) ? 10 : 
			($a_meridian == 4) ? 3 : 
			0;
		my $a_minute = defined($2) ? $2 : 0;

		if ($b->{time} !~ m{^(?:(\d*):(\d*))?([ap]m?|nn?|md?)?$})
		{
			print "Invalid time entry\n";
			print_error_entry($b);
			sleep(1);
			return 0;
		}

		my $b_meridian =
		    $3 eq 'm'  ? 1
		  : $3 eq 'md' ? 1
		  : $3 eq 'a'  ? 2
		  : $3 eq 'am' ? 2
		  : $3 eq 'n'  ? 3
		  : $3 eq 'nn' ? 3
		  : $3 eq 'p'  ? 4
		  : $3 eq 'pm' ? 4
		  :             0;

		my $b_hour = 
			(defined($1) && $1 != 12) ? $1 :
			(defined($1) && $1 == 12) ? 0 :
			# not defined
			# sort am alone as 10am
			($b_meridian == 2) ? 10 : 
			# sort pm alone as 3pm
			($b_meridian == 4) ? 3 : 
			0;
		my $b_minute = defined($2) ? $2 : 0;

		return (     $a_meridian <=> $b_meridian
			  || $a_hour <=> $b_hour
			  || $a_minute <=> $b_minute);
	}

	# all the same, compare descriptions
	return 1 if ($a->{description} =~ m/^\(/ && $b->{description} !~ m/^\(/);
	return -1 if ($a->{description} !~ m/^\(/ && $b->{description} =~ m/^\(/);
	return ($a->{description} cmp $b->{description});
}

sub add_file_entries ($)
{
	my $filename = shift;
	my $base = basename($filename);
	my @entries;

	open(my $MCAL, '<', $filename) or sysdie "Cannot open $filename";
	while (my $line = <$MCAL>)
	{
		my %new_entry;

		chomp($line);

		next if ($line =~ m/^\s*$/);

		# We can handle space or tabs with regex, but it is hard
		# to handle a mix of spaces and tabs in the same field
		# separator block, so just convert everything to spaces
		$line = expand($line);

		# trim off trailing spaces
		$line =~ s/ +$//;

		# time is optional
		$line =~ m{^(\d+)/(\d+) {1,5}([^ ]*) +(.*)$}
		  or die "Invalid $base date entry on line $.\n$line\n";

		$new_entry{month}       = $1;
		$new_entry{day}         = $2;
		$new_entry{time}        = $3;
		$new_entry{description} = $4;

		# skip entries that should not appear
		#		next
		#		  if (    !$options{print_all}
		#			&& $new_entry{month} != get_future_month(0)
		#			&& $new_entry{month} != get_future_month(1)
		#			&& $new_entry{month} != get_future_month(2)
		#			&& $new_entry{month} != get_future_month(3));

		# skip date if already past
		next
		  if (    !$options{print_all}
			&& $new_entry{month} == $current_date{month}
			&& $new_entry{day} < $current_date{day});

		# lowercase am/pm, change am to a, etc., but leave solitary 'am/pm' alone
		$new_entry{time} =~ s{(\d[ap])m$}{\L$1}i;

		# change noon to 12:00p
		$new_entry{time} =~ s{^noon$}{12:00n}i;

		# change mid to 12:00a
		$new_entry{time} =~ s{^mid$}{12:00m}i;

		# change 2p to 2:00p
		$new_entry{time} =~ s{^(\d+)([apnm])$}{$1:00$2}i;

		# change 2:0p to 2:00p
		$new_entry{time} =~ s{^(\d+:\d)([apnm])$}{${1}0$2}i;

		# Verify time format as single number(year) or time, or print error line number
		$new_entry{time} =~ m{^(\d+|\d+:\d\d[apnm]|am|pm)?$}
		  or die "Invalid $base time entry on line $.\n$line\n";

		print_error_entry(\%new_entry) if ($options{debug});

		push @entries, \%new_entry;	# returned as a closure
	}
	close($MCAL) or sysdie "Cannot close $filename";
	return \@entries;	# returned as a closure
}

# move first column of description over, or add "Birthday"
sub adjust_birthday_entries ($)
{
	for my $entry (@{shift()})
	{
		# has entry type prefix?
		$entry->{description} =~ m/^\w+: +/ ?
			# add parens about type prefix
			$entry->{description} =~ s/^(\w+): +/($1) - / :
			$entry->{description} =~ s/^/(Birthday) - /;
	}
	return;
}

sub create_calendar ($)
{
	my $entries = shift();
	my @cal;

	for my $i (0 .. 3)
	{
		my $str = 'cal ' . get_future_month($i) . ' ' . get_future_year_of_month($i);
		# save array reference, one line per array element
		$cal[$i] = [`$str`];
		chomp(@{$cal[$i]});
	}

	# calendar is bold, with reverse for active days, and red for
	# the current day

	# find maximum line width for calendars
	my $cal_width = 0;
	map { map {$cal_width = length($_) if (length($_) > $cal_width)} @$_} @cal[0..3];

	# We add cal_width spaces, then strip length to cal_width
	# Add space on left and right of each calendar too for date matching
	# Must be done before escapes are added so lengths are correct
	map { map 
	{
		$_ .= ' ' x $cal_width;
		s/^(.{$cal_width}).*$/ $1 /;
	} @$_} @cal[0..3];

	# mark current day first so it will not get CALACTIVE
	for (@{$cal[0]}) { s/ ($current_date{day}) / $MARK_CURDAY$1$CALRESET / }

	# mark active days
	for my $entry (@$entries)
	{
		# skip birthday entries
		next if ($entry->{description} =~ m/^\(/);

		# skip recurring entries
		next if ($entry->{description} =~ m/\*\s*$/);

		# skip specially marked entries
		next if ($entry->{description} =~ m/%\s*$/);

		# skip conference call
		next
		  if ($entry->{description} =~
			m{Bruce/EDB.*(teleconference|conference call|office vacation)}i);

		# Use spaces instead of \b to prevent item from being highlighted multiple times
		# (escape string might appear as a word break character)
		for my $i (0 .. 3)
		{
			if (get_future_month($i) == $entry->{month})
			{
				map {s/ ($entry->{day}) / $CALACTIVE$1$CALRESET /} @{$cal[$i]};
			}
		}
	}
	return \@cal;
}

sub produce_output ($$)
{
	my ($entries, $cal) = @_;

	my $OUT;
	my $out_filename;
	my $USER = defined($ENV{'USER'}) ? $ENV{'USER'} : '';

	if (!$options{args_supplied} && $USER eq 'root')
	{
		$out_filename = "/u/mcal/cache/$BASE.$TERM.$WIDTH";
		open($OUT, '>', $out_filename) or sysdie "Cannot create $out_filename\n";
		flock($OUT, LOCK_EX) or sysdie "Locking failed";
	}
	else
	{
		($OUT, $out_filename) = tempfile(UNLINK => 1);
	}

	print {$OUT} "$CALRESET";

	# print calendar at top
	for my $lineno (0 .. $#{$cal->[0]})
	{
		printf(
			{$OUT} " %s  %s  %s  %s\n",
			$cal->[0][$lineno], $cal->[1][$lineno],
			$cal->[2][$lineno], $cal->[3][$lineno]
		);
	}

	my $last_month = '';
	my $last_day   = '';
	my $dow        = '';
	my $bar_mode   = 0;

	# seconary lines need two extra spaces
	$Text::Wrap::columns = $WIDTH - $indent_spaces - 2;
	$Text::Wrap::unexpand = 0; # no tab expansion

	for my $entry (@$entries)
	{
		# New date?, adjust color
		if (       $entry->{month} ne $last_month
			|| $entry->{day} ne $last_day)
		{

			# alternate dates with GREENBAR and ENTRYRESET
			print {$OUT} $bar_mode ? $GREENBAR : $ENTRYRESET;
			$last_month = $entry->{month};
			$last_day   = $entry->{day};
			$bar_mode   = !$bar_mode;
			# cache dow
			$dow        = strftime(
				'%a', 0, 0, 0,
				$entry->{day},
				$entry->{month} - 1,
				(
					($entry->{month} >= $current_date{month})
					? $current_date{year}
					: $current_date{year} + 1
				  ) - 1900
			);
		}

		# do highlighting on the end of the line to preserve tabs 
		# (though there are no tabs)
		print {$OUT} "\n";

		# output start of date entry, length $indent_spaces
		printf({$OUT} "%2s/%-2s  %3s   %6s   ",
			$entry->{month}, $entry->{day}, $dow, $entry->{time});

		# print first description line, then remainder, indented
		my @description = split("\n", wrap('', '', $entry->{description}));
		for my $lineno (0 .. $#description)
		{
			# new entry always gets newline
			print {$OUT} "\n" if ($lineno != 0);
			($lineno == 0)
			  ?print {$OUT} $description[$lineno]
			  :print {$OUT} ' ' x ($indent_spaces + 2) . $description[$lineno];
		}
	}

	print {$OUT} "$ENTRYRESET\n";

	flock($OUT, LOCK_UN) if (!$options{args_supplied} && $USER eq 'root');

	close($OUT) or sysdie "Cannot close $out_filename\n";
	return $out_filename;
}

sub calsort ()
{
	my $entries;

	@ARGV = ('/dev/stdin') if (!@ARGV);
	map { push(@$entries, @{add_file_entries($_)}); } @ARGV;

	@$entries = sort entry_cmp @{$entries};

	for my $entry (@$entries)
	{
		printf("%s/%s\t%s\t%s\n",
			$entry->{month}, $entry->{day},
			defined($entry->{time}) ? $entry->{time} : '',
			$entry->{description});
	}
	return;
}

# main

set_defaults;
if ($BASE eq 'calsort')
{
	$options{print_all} = 1;
	calsort;
}
else
{
	my $entries;

	get_mcal_args;
	can_use_cache;

	# Do birthday first because entries need adjustment
	if ($BASE eq "mcal" && !$options{exclude})
	{
		$entries = add_file_entries('/u/mcal/birthdays');
		adjust_birthday_entries($entries);
	}
	push @$entries, @{add_file_entries("/u/mcal/$BASE")};

	@$entries = sort entry_cmp @$entries;

	my $out_filename =produce_output($entries, create_calendar($entries));

	(-t STDOUT)
	  ? system(qq(less $LESSFLAGS $out_filename; echo -n "$ENTRYRESET"))
	  : system("cat $out_filename");
}