#!/usr/bin/perl

use CGI qw(:cgi-lib :all);
use strict;
use vars qw(
 $cgiobj $thisscript
 $rmonth $ryear $ndays $thismonth $thisyear $today
 $nav_next $nav_prev
 %query
 @dmonth
 );

$cgiobj = new CGI;
set_common_vals();

print $cgiobj->header(-type=>'text/html', -charset=>'shift_jis');

print $cgiobj->start_html(
 -title=>'Calender for life',
 -meta=>{'keywords'=>'calender'},
 -head=>[
  Link({-rel=>'stylesheet',
   -href=>'/styles/style_calender.css',
   -type=>'text/css',
   -media=>'screen,print'
   }),
  Link({-rel=>'stylesheet',
   -href=>'/styles/style_calender_print.css',
   -type=>'text/css',
   -media=>'print'
   }),
  Link({-rel=>'stylesheet',
   -href=>'/styles/style.css',
   -type=>'text/css',
   -media=>'screen,print'
   })
  ]  
 );

print_calender(1);

print $cgiobj->address('(C) Omi KIKUCHI');

print $cgiobj->startform(
  -method=>'get',
  );
print $cgiobj->p(
 'Enter the year and select the month:', $cgiobj->br(),
 $cgiobj->textfield(
  -name=>'ryear',
  -default=>$ryear,
  -size=>9,
  -maxlength=>80
  ),
 $cgiobj->popup_menu(
  'rmonth',
  [1..12],
  $rmonth, {map { $_=>"$_ $dmonth[$_-1]" } (1..12)}
  ),
 $cgiobj->submit('submitbtn', 'DISPLAY!') 
 )
 ; 
print $cgiobj->endform();

print $cgiobj->p(
 $cgiobj->a({href=>'calender_source.cgi'}, 'SOURCE (PERL)')
 );



sub print_calender {
 if ($rmonth == 2) {
  if (isLeap($ryear)) { $ndays++; }
  }
 my $firstwday = getwday($ryear, $rmonth, 1);

 
 if (shift) {
  $nav_next = $thisscript . '?';
  $nav_prev = $thisscript . '?';
  if ($rmonth == 12) {
   $nav_next .= 'rmonth=1&ryear=' . ($ryear + 1);
   $nav_prev .= 'rmonth='. ($rmonth - 1) . '&ryear='. $ryear;
   $nav_next = $cgiobj->a({href=>$nav_next}, $dmonth[0]);
   $nav_prev = $cgiobj->a({href=>$nav_prev}, $dmonth[10]);
   }
  elsif ($rmonth == 1) {
   $nav_next .= 'rmonth=2&ryear=' . $ryear;
   $nav_prev .= 'rmonth=12&ryear='. ($ryear - 1);
   $nav_next = $cgiobj->a({href=>$nav_next}, $dmonth[1]);
   $nav_prev = $cgiobj->a({href=>$nav_prev}, $dmonth[11]);
   }
  else {
   $nav_next .= 'rmonth=' . ($rmonth + 1). '&ryear=' . $ryear;
   $nav_prev .= 'rmonth=' . ($rmonth - 1). '&ryear=' . $ryear;
   $nav_next = $cgiobj->a({href=>$nav_next}, $dmonth[$rmonth]);
   $nav_prev = $cgiobj->a({href=>$nav_prev}, $dmonth[$rmonth - 2]);
   }
   ;
  }
  ;

 print '<div align="center">';
 

 #print "$ndays, $firstwday";
 print <<TABLETOP;
<table border="2" summary="calender" class="calender";>
<caption>$nav_prev -- $dmonth[$rmonth-1], $ryear -- $nav_next</caption>
<thead>
<tr>
<th class="sun">sun</th><th>mon</th><th>tue</th><th>wed</th><th>thu</th><th>fri</th><th class="sat">sat</th>
</tr>
TABLETOP


 for (my $i=0; $i <= $ndays + $firstwday -1; $i++) {
  if (($i % 7) == 0) {
   print '<tr>'."\n".'<td class="sun">';
   }
  elsif ((($i + 1) % 7) == 0) {
   print '<td class="sat">';
   }
  else { print '<td>'; }
  ;
  if ($i >= $firstwday) {
   print $i - $firstwday + 1;
   print '</td>';
   }
  else {
   print '&nbsp;</td>';
   }
   ;
  if ((($i+1) % 7) == 0) {
   print "\n</tr>\n";;
   }
  }
  ;
 if ((($ndays + $firstwday) % 7) != 0) {
  for (my $i=1; $i<=(7 - ($ndays + $firstwday) % 7); $i++) {
   if ($i == (7 - ($ndays + $firstwday) % 7)) {
    print '<td class="sat">';
    } else { print '<td>'; };
   print '&nbsp;</td>';
   }
  print "</tr>\n" ;
  };
 print "</table>\n\n</div>\n\n";
 }
 ;

sub isLeap {
 my $year = shift;
 if(
    (($year % 4) == 0 and ($year % 100) != 0)
    or
    (($year % 400) == 0)
   ) {
  return 1;
  }
 else {
  return 0;
  }
 }
 ;
sub getwday {
  my($year, $mon, $mday) = @_;

  if ($mon == 1 or $mon == 2) {
    $year--;
    $mon += 12;
  }
  int($year + int($year / 4) - int($year / 100) + int($year / 400)
      + int((13 * $mon + 8) / 5) + $mday) % 7;
 }
 ;


sub set_common_vals {
 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);;
 $thismonth = $mon + 1;
 $thisyear  = $year + 1900;
 $today = $mday;

 %query = $cgiobj->Vars;
 $ryear = $query{'ryear'};
 $rmonth = $query{'rmonth'};
 tidy_query();

 $thisscript = $cgiobj->url(-relative=>1); 
 @dmonth = qw(January February March April May June July August September October November December);
 }
 ;


sub tidy_query {
 foreach ($ryear, $rmonth) {
  s/[\x82]([\x4f-\x58])/chr((ord $1) - 31)/eg; #converting SHIFT_JIS coding to western
  s/\D//g;
  }
  ;
 if ($rmonth > 12) { $rmonth = 12; };
 unless ($ryear) { $ryear = $thisyear; };
 unless ($rmonth) { $rmonth = $thismonth; };

 $ndays = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)[$rmonth-1];
 
 }