The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

#Here is my first stab at a cal program. Works fine for dates after
#Sept 9, 1752.
# by Tim Allwine <tallwine@ixlabs.com>

use strict;
use Getopt::Std;
use vars qw( $opt_j $opt_y $opt_h);

# A first attempt at the cal program for the PPT project.

#require 'dumpvar.pl'; # if debugging or you want to see the data structures

getopts('yjh');

printHelp() if $opt_h;

BEGIN {
# In order to find out the first year-day number for a given month
# I need the last day for the previous month .. and the previous...
# Adapted this trick from the Cookbook
	my $lastday = [];
	sub lastJulian {
		my $m = shift; # month number jan = 1
		my $y = shift; # year
		return 0 if $m == 0;
		return $lastday->[$m] if defined $lastday->[$m];

		my $days = [31,28,31,30,31,30,31,31,30,31,30,31];
		my $last;
		if($m == 2) {
			if(!($y % 4) && (($y % 100) || !($y %400))) {
				$last = 29;
			} else {
				$last = 28;
			}
		} else {
			$last = $days->[$m - 1];
		}
		$lastday->[$m] = $last + lastJulian($m - 1,$y);
	}
}

my $num2month = {
	1  => 'January',
	2  => 'February',
	3  => 'March',
	4  => 'April',
	5  => 'May',
	6  => 'June',
	7  => 'July',
	8  => 'August',
	9  => 'September',
	10 => 'October',
	11 => 'November',
	12 => 'December'
};

# I use to calculate this row but thought 
# hard coding was best...??
my $WDR = [
	'Su Mo Tu We Th Fr Sa',
	'Sun Mon Tue Wed Thu Fri Sat'
];

# Uncomment these if you don't like above
#my $WeekDays = [qw(
#	Sun
#	Mon
#	Tue
#	Wed
#	Thu
#	Fri
#	Sat
#	)
#];

# j_rows is a ref to a hash 
# keys are row numbers values are ref to an array of month numbers
# Used when printing a year using julian days.
my $j_rows = { 
	1 => [ 1,2 ],
	2 => [ 3,4 ],
	3 => [ 5,6 ],
	4 => [ 7,8 ],
	5 => [ 9,10 ],
	6 => [ 11,12 ]
};

# Same as above keys are row numbers 
# Used when printing a year.
my $rows = {
	1 => [ 1,2,3 ],
	2 => [ 4,5,6 ],
	3 => [ 7,8,9 ],
	4 => [ 10,11,12 ],
};

# deal with the command line
my $year;
my $month;
if(@ARGV == 2) {
	$month = shift;
	monthError() if ($month < 1) || ($month > 12);
	$year = shift; 
} elsif(@ARGV == 1) {
	$year = shift; 
	$opt_y = 1;
} else {
	$month = ((localtime)[4])+1;
	$year = 1900 + (localtime)[5];
}

# unless we are doing a year we are doing a month
unless ($opt_y) { 
	my $m =  &do_month($month,$year);
#dumpValue(\$m);
	display_month($m);
} else {
	my $y = &do_year($year);
#dumpValue(\$y);
	display_year($y);
}

#######################################
# FUNCTIONS
#

sub display_month {
	my $data = shift;
	for(@{$data}) {
		print "$_\n";
	}
}

# Returns the last day of a month.
sub lastDay {
	my $m = shift;
	my $y = shift;
    my $days = [31,28,31,30,31,30,31,31,30,31,30,31];
	my $last;
    if($m == 2) {
		if(!($y % 4) && (($y % 100) || !($y %400))) {
			$last = 29;
		} else {
			$last = 28;
		}
    } else {
		$last = $days->[$m - 1];
    }
    return $last;
}
    
# Returns a value 0-6, 0 = Sunday, that represents the first day of
# a given month for a given year.
sub firstDay {
	my $m = shift;
	my $y = shift;
	if($m < 3) {
		$y--;
	}

	if($m < 3) {
		$m = $m + 10;
	} else {
		$m = $m - 2;
	}

#	$y =~ /(\d\d)(\d\d)/;
	my $C = int($y/100);
	my $Y = $y - ($C*100);

	my $first = (1 + int(2.6 * $m - .2) - 2 * $C + $Y + int($Y/4) + int($C/4))% 7;
	return $first;
}

sub do_month {
	my $month = shift;
	my $year = shift;
	my $month_name = $num2month->{$month};
	my $hash;
# This is ugly. Used to format the month name under different conditions.
# and needs to change...
	if ($opt_j && !$opt_y) {
		push(@{$hash}, " " x (11 - (length($month_name . " " . $year))/2) . 
				"$month_name $year" . ' ' x ((29 - length($month_name))/2) );
	} elsif($opt_y && !$opt_j) {
		my $tmp_s = " " x (11 - (int(length($month_name))/2)-1). "$month_name" .
				" " x (11 - (int(length($month_name))/2));
		$tmp_s = substr($tmp_s,0,20);
		push(@{$hash},$tmp_s);
	} elsif($opt_j && $opt_y) {
		push(@{$hash}, " " x (11 - (length($month_name ))/2). "$month_name" .
				" " x(17 - (length($month_name))/2));
	} else {
		push(@{$hash}, " " x (11 - (length($month_name . " " . $year))/2) . 
				"$month_name $year");
	}

	my $wday;
	my $str;
#	for $wday (@{$WeekDays}) {
#		unless ($opt_j) {
#			$str .= substr($wday,0,2)." ";
#		} else {
#			$str .= substr($wday,0,3)." ";
#		}
#	}
#	$str =~ s/ $//;
#push(@{$hash},$str);

# either 'Su Mo Tu...' or 'Sun Mon Tue...'
	push(@{$hash},($opt_j)?$WDR->[1]:$WDR->[0]);
	$str = '';
	my $empty_day = &firstDay($month,$year);
	my $last = &lastDay($month,$year);

	if($empty_day) {
		for(my $i=1;$i <= $empty_day;$i++) {
			if($opt_j) {
				$str .= " " x 4;
			} else {
				$str .= " " x 3;
			}
		}
	}
	my $weekDay = $empty_day;
	unless ($opt_j) {
		my @tmp;
		for(my $days=1;$days <= $last; $days++) {
			(length($days) == 2)?push(@tmp, "$days "):push(@tmp," $days ");
			$weekDay++;
			if($weekDay > 6) {
				$str .= join('',@tmp);
			$str =~ s/ $//;
				push(@{$hash}, $str);
				$str = '';
				@tmp = ();
				$weekDay = 0;
			}
		}
		if($weekDay != 0) {
			$str .= join('',@tmp);
			for(my $i = $weekDay;$i <= 6;$i++) {
				$str .= " " x 3;
			}
			$str = substr($str,0,20);

			push(@{$hash}, $str);
		}
# All calanders have the same number of rows
		while(scalar @{$hash} < 8) { # blank 
			push(@{$hash}, " " x 20);
		}
	} else {
		my @tmp;
		my $first = &lastJulian($month - 1,$year);
		for(my $days= $first+1;$days <= $first + $last; $days++) {
			if(length($days) == 1) {
				push(@tmp, "  $days ");
			} elsif(length($days) == 2) {
				push(@tmp, " $days ");
			} else {
				push(@tmp, "$days ");
			}
			$weekDay++;
			if($weekDay > 6) {
				$str .= join('',@tmp);
			$str =~ s/ $//;
				push(@{$hash}, $str);
				$str = '';
				@tmp = ();
				$weekDay = 0;
			}
		}
		if($weekDay != 0) {
			$str .= join('',@tmp);
			for(my $i = $weekDay;$i <=6;$i++) {
				$str .= " " x 4; #fill out the week.
			}
			$str =~ s/ $//; #trim that last space
			push(@{$hash}, $str);
		}
		while(scalar @{$hash} < 8) {
			push(@{$hash}, " " x 27); # everyone has the same
		}
	}
	return $hash;
}

# returns a hash. Keys are row numbers
# values are lists of calanders
# if we are doing a Julian year then two calanders
# per row, othewise three.
sub do_year {
	my $year = shift;
	my $hash = ($opt_j)?$j_rows:$rows;
	my $num_rows = keys %{$hash};
	my $data;
	for my $row (1..$num_rows) {
		for(@{$hash->{$row}}) {
			push(@{$data->{$row}}, &do_month($_,$year));
		}
	}
	return $data;
}

sub display_year {
	my $data = shift;
	print " " x (((67 - 2)/2) - 1). "$year" ;
	print "\n\n";
		
	for my $row (sort {$a <=> $b} keys %{$data}) {
		next unless $row;
		for (0..7) {
			my $n = 0;
			for my $jd (0..2) {
				$n++;
				print $data->{$row}[$jd][$_];
				($n % 3)?print "   " :print "\n";
			}
		}
		print "\n";
	}
}

sub monthError {
	print STDERR "$0: illegal month value: use 1-12\n";
	exit;
}

sub printHelp {
	print "Usage: $0 [-jy] [month [year]]\n";
	exit;
}
__END__

-- 
Tim Allwine
IX Development Laboratories
(707)-543-8030 Ext.15