#!/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