#! c:/perl/bin/perl
#
# calen2.cgi
#
# 2.0 : 6/10/07 : calen.cgiより機能を追加
#
# http://www.hidekik.com
#
# Copyright(c) 2006-2007, Hideki Kanayama All Rights Reserved

use strict;
use CGI::Carp qw(fatalsToBrowser);
use CGI;
use File::Basename;
use Date::Calc qw(Day_of_Week);

my $version = "2.0";
my $lastupdatedyear = "2007";
my $script = basename($0);

# Use localtime?
my $localtime_en = 0;

# Offset from GMT if $localtime_en = 0
my $offset = 9;

my $title = 'プリントアウト用カレンダー２';
my $backlink = "calen2.html";
my $backname = "解説ページへ";

my $charset = "Shift_JIS";

my $now = time;

my $q = new CGI;
my $cgierror = $q->cgi_error;
&error($cgierror) if ($cgierror);
my $reqyear = $q->param('yearset');
my $reqmon = $q->param('monset');
my $yearormon = $q->param('yearormon');
my $aspect = $q->param('aspect');
my $blank = $q->param('blank');

my @weekname = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
my @monname = qw(January February March April May June July August September October November December);

if ($yearormon ne ''){
    &gencalen;
} else {
    &inputform;
}

sub inputform {
    &htmlhead($title);

    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = 
	$localtime_en ? localtime($now) : gmtime($now + $offset * 3600);

    print "<center>\n";
    print "<a href=\"$backlink\">$backname</a><p>\n";
    print "<form actoin=\"$script\" method=\"post\">\n";

    print "<table cols=2 border=1 align=center size=30%>\n";

    print "<tr>\n";
    print "<td colspan=2 align=center>";
    print "<input type=text name=yearset size=4 value=";
    print $year+1900;
    print ">年\n";
    print "<input type=text name=monset size=2 value=";
    print $mon+1;
    print ">月\n";
    print "</td>\n";
    print "</tr>\n";

    print "<tr>\n";
    print "<td align=center>";
    print qq(<input type="radio" name="yearormon" value="mon" checked>一ヶ月表\示\n);
    print "</td>\n";
    print "<td align=center>";
    print qq(<input type="radio" name="yearormon" value="year">一年表\示\n);
    print "</td>\n";
    print "</tr>\n";


    print "<tr>\n";
    print "<td align=center>";
    print "空欄";
    print qq(<input type="text" name="blank" value="5" size=3>\n);
    print "</td>\n";
    print "<td nowrap align=center>";
    print qq(<input type="radio" name="aspect" value="txf" checked>3x4\n);
    print qq(<input type="radio" name="aspect" value="fxt">4x3\n);
    print "</td>\n";
    print "</tr>\n";

    print "<td colspan=2 align=center>";
    print qq(<input type="submit" name="makecal" value="カレンダー作成">\n);
    print "</td>\n";
    print "</tr>\n";
    print "</table>\n";

    &htmltail;
}

sub gencalen {
    &htmlhead;

    if ($yearormon eq 'year'){
	&yeargen;
    } else {
	&monthgen($reqmon);
    }
    print "</body>";
    print "</html>";
    exit;
}

sub yeargen {
    my %moncol = (fxt => 3, txf => 2);
    my %monrow = (fxt => 2, txf => 3);
    my $tablecol = $moncol{$aspect}+1;
    print "<center><h2>$reqyear</h2></center>\n";
    print "<table cols=$tablecol border=0 width=100% cellspacing=20>\n";
    foreach my $row (0 .. $monrow{$aspect}){
	print "<tr>\n";
	foreach my $col (0 .. $moncol{$aspect}){
	    print "<td align=center valign=top>\n";
	    my $mon = $col+$row*($moncol{$aspect}+1);
	    print "$monname[$mon]\n";
	    &monthgen($mon+1);
	    print "</td>\n";
	}
	print "</tr>\n";
    }
    print "</table>\n";
}

sub monthgen {
    my $reqmon = shift;
    my $swday = Day_of_Week($reqyear,$reqmon,1) % 7;

    if ($yearormon eq 'mon'){
	print "<center><h2>$monname[$reqmon-1], $reqyear</h2></center><p>\n";
    }
    my $border;
    my $align;
    if ($yearormon eq 'mon') {
	$border=1;
	$align = "right";
    } else {
	$border=0;
	$align = "center";
    }
    print "<table cols=7 border=$border width=100%>\n";
    foreach my $week (-1 .. 5) {
	last if ($week == 5 and !&monthdaycheck($reqyear,$reqmon,36-$swday));
	print "<tr>\n";
	foreach my $day (0 .. 6){
	    if ($week == -1){
		print "<td align=center width=\"14%\">";
		if ($yearormon eq 'mon'){
		    print "$weekname[$day]";
		} else {
		    print substr($weekname[$day],0,1);
		}
		print "</td>\n";
	    } else {
		print "<td align=$align>";
		if ($week == 0 and $day >= $swday or $week != 0){
		    my $today = $day + $week * 7 - $swday + 1;
		    if ($yearormon eq 'mon'){
			if (&monthdaycheck($reqyear,$reqmon,$today)){
			    print "<font size=\"+1\">$today</font>";
			} else {
			    print "<br>";
			}
			print "<br>" x $blank;
		    } else {
			if (&monthdaycheck($reqyear,$reqmon,$today)){
			    print "$today";
			} else {
			    print "&nbsp;";
			}
		    }
		} else {
		    print "&nbsp;";
		}
		print "</td>\n";
	    }
	}
	print "</tr>\n";
    }
    print "</table>";
}

sub htmlhead {
    my $title = shift;
    print $q->header(-charset=>"$charset");
    print "<html>";
    print <<HEADPRINT;
<HEAD>
   <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=$charset">
   <META NAME="Author" CONTENT="Hideki Kanayama">
   <TITLE>$title</TITLE>
</head>
<body>
HEADPRINT
}

sub htmltail {
    my $mysite = 'http://www.hidekik.com/';
    print "<div align=\"right\"><i>calen2.cgi $version<br>Copyright(c) 2006-$lastupdatedyear, <a href=\"$mysite\" target=\"_blank\">hidekik.com</a></i></div>\n";
    print "</body>";
    print "</html>";
    exit;
}

sub error {
  my ($msg) = shift;
  &htmlhead($msg);
  print "<br><center>$msg</center>\n";
  &htmltail;
  exit;
}

sub monthdaycheck {
  my ($year,$month,$day) = @_;
  my @monthdays = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  my $md = $monthdays[$month-1];
  ++$md if ($month == 2 and $year % 4 == 0 and ($year % 100 != 0 or $year % 400 == 0));
  return ($day  <= $md  and $day  >= 1);
}