#! /usr/bin/perl
#
# 履歴記録ＣＧＩ
#
# 2.008 : 6/19/08 : 変更、一括削除の機能を追加
# 2.007 : 2/2/08 : 年表示、年月表示の時のマス内表示順を日付順に修正
# 2.006 : 8/14/07 : タグ処理を修正
# 2.005 : 7/29/07 : 日付チェック方法を修正
# 2.004 : 6/10/07 : うるう年を修正
# 2.003 : 5/18/07 : 書き込みページを別ページにするオプションを追加
# 2.002 : 5/10/07 : 0から始まる日付を修正。
# 2.001 : 5/9/07 : 0から始まる年を修正。時刻を修正。
# 2.0 : 5/6/07 : 「ヒストリー」より西暦1年から指定できるようにし、
#                 2038年問題を修正。カラム数を変更できるように修正。
#
# http://www.hidekik.com/
#
# $Id: history2.cgi,v 1.14 2008/06/19 06:17:09 Hideki Kanayama Exp $
# Copyright(c) 2005-2008, Hideki Kanayama, All rights reserved.

use strict;
use CGI qw(:cgi-lib);
use CGI::Carp qw(fatalsToBrowser);
use File::Basename;
use Time::Local;
use Date::Calc qw(Delta_Days check_date);

my $adminpwd = "adminpwd.dat";
my $setupfile = "hist_setup.pl";

my $version = "2.008";
my $lastupdatedyear = "2008";
my $script = basename($0);

my $charset = "Shift_JIS";

# Language 0:Japanese 1:English
my $lang = 0;

### デフォルト設定 ###

# data file
our $datafile = 'history.dat';

# Title
our $title = 'ヒストリー２';

# Delete page title
our $deltitle = 'ヒストリー削除';

# Background
our $bgimage_en = 0;
our $bgimage_file = '';
our $bgcolor = "#ffffff";

# Back link
our $backlink_en = 1;
our $backlink = '..';
our $backlink_name = '戻る';

# Body width
our $body_width = '80';

# Display order 0:From new, 1:From old
our $order = 0;

# Date display 0:年月日 1:年月のみ 2:年のみ
our $date_disp = 0;

# Header
our $headers = '日付,コメント１,コメント２';

# 書き込み別ページ 1:on 0:off
our $sep_wrpage = 0;

# body_head
our $body_head = "
<center><h1>$title</h1></center><p>
";

# body_tail
our $body_tail = '
';

# mode 0:admin only, 1:user mode
our $user_mode = 0;

# Style Sheet
our $style_sheet_en = 0;
our $style_sheet = '
';

# Head insert
our $head_insert_en = 0;
our $head_insert = '
';

# Offset from GMT, Japan:+9
our $offset = 9;

#######################

require $setupfile if (-e "$setupfile");

my $LOCK_EX = 2;

my $now = time + $offset*3600;
my $q = new CGI;
my $cgierror = $q->cgi_error;
&error($cgierror) if ($cgierror);

my $mode = $q->param('mode');

if (! -e "$adminpwd"){
    if ($mode eq 'wradminpwd'){
	&wradminpwd;
    } else {
	&setadminpwd;
    }
}

my @header = split /,/, $headers;
my $cols = $#header + 1;

if ($mode eq 'write'){
    &histwrite;
} elsif ($mode eq 'delpage'){
    &delpage;
} elsif ($mode eq 'delete'){
    &histdelete;
} elsif ($mode eq 'modify'){
    &histwrite;
} elsif ($mode eq 'setup'){
    &setup;
} elsif ($mode eq 'setupwrite'){
    &setupwrite;
} elsif ($mode eq 'wrform'){
    &wrform;
} else {
    &display;
}

sub sortdays {
    my $histdata = @_[0];
    my @alist = @{$histdata->{$a}};
    my @blist = @{$histdata->{$b}};
    return Delta_Days(@alist[1 .. 3],@blist[1 .. 3]);
}

sub display {
    my $histdata = &getdata;
    my @regtime = keys %{$histdata};
    @regtime = sort {sortdays($histdata)} @regtime;
    @regtime = reverse @regtime if ($order == 1);

    &htmlhead($title);
    print "$body_head\n";

    my ($d_dev,$d_ino,$d_mode,$d_nlink,$d_uid,$d_gid,$d_rdev,$d_size,$d_atime,$d_mtime,$d_ctime,$d_blksize,$d_blocks)=stat("$datafile");
    my ($ssec,$smin,$shour,$sday,$smon,$syear,$swday,$syday,$sisdst)=gmtime($d_mtime+$offset*3600);
    $syear += 1900 if ($syear < 1900);
    $smon++;
    print "<center>\n";
    print "<a href=\"$backlink\">$backlink_name</a><p>\n" if ($backlink_en);
    print "${syear}年${smon}月${sday}日更新\n";
    print "</center><p>\n";

    print "<table cols=$cols width=\"100%\" border=1 align=center>\n";

    print "<tr>";
    foreach (@header){
	print "<th>$_</th>";
    }
    print "</tr>\n";

    # ($id,$dyear,$dmonth,$dday,$dhour,$dmin,$dtime,$dnow,$dpwd,$host,$ip,$dcomment);
    foreach (@regtime){
	print "<tr>\n";

	print "<td nowrap width=\"10%\">";
	print "$histdata->{$_}[1]年";
	print "$histdata->{$_}[2]月" if ($date_disp == 0 or $date_disp == 1);
	print "$histdata->{$_}[3]日" if ($date_disp == 0);
	print "</td>\n";

	my @comarray = split /<>/, $histdata->{$_}[11];
	for (my $i=0;$i<$cols-1;$i++){
	    print "<td valign=\"top\">";
#	    print "$comarray[$i]:$#comarray:$histdata->{$_}[11]";
	    if ($comarray[$i] eq ''){
		print "&nbsp;";
	    } else {
		print "$comarray[$i]";
	    }
	    print "</td>\n";
	}

	print "</tr>\n";
    }
    print "</table><p>\n";

    &wrform unless ($sep_wrpage);

    print "$body_tail\n";
    print "<table cols=2 border=0 width=\"100%\" style=\"border:0px\">\n";
    print "<tr><td align=left>";
    if ($sep_wrpage){
	print "<a href=\"$script?mode=wrform\">登録ページ</a> \n";
    }
    print "<a href=\"$script?mode=delpage\">削除変更ページ</a></td>\n";
    print "<td align=right>";
    print "<a href=\"$script?mode=setup\">管理用</a></td></tr>\n";
    print "</table>\n";

    &htmltail;
}

sub wrform {
    if ($sep_wrpage and $mode eq 'wrform'){
	&htmlhead($title);
	print "<h3>$title書き込み</h3><p>\n";
	print "<a href=\"$script\">$titleへ</a><p>\n";
    }
    my ($sec,$min,$hour,$day,$mon,$year,$wday,$yday,$isdst)=gmtime($now);
    $mon++;
    $year += 1900 if ($year < 1900);

    print "<table cols=1 width=\"100%\" border=0 style=\"border:0px\" align=center>\n";
    print "<tr><td>";
    print "<form name=histwrite action=\"$script\" method=post>\n";
    print "<input type=text size=5 name=year value=\"$year\">年";
    print "<input type=text size=3 name=month value=\"$mon\">月";
    print "<input type=text size=3 name=day value=\"$day\">日<br>\n";
    shift @header;
    my $i=0;
    foreach (@header){
	print "$_<br><textarea cols=30 rows=3 name=comment_$i wrap=soft>\n";
	print "</textarea><br>\n";
	$i++;
    }
    print "パスワード<input type=password size=10 name=pwd><br>\n";
    print "<input type=submit name=\"submit\" value=\"書きこみ\">\n";
    print "<input type=hidden name=mode value=\"write\">\n";
    print "</form>\n";
    print "</td></tr>\n";
    print "</table>\n";

    &htmltail if ($sep_wrpage and $mode eq 'wrform');
}

sub delpage {
    my $histdata = &getdeldata;
    my @regtime = @{$histdata};
    @regtime = sort {Delta_Days($a->[1],$a->[2],$a->[3],$b->[1],$b->[2],$b->[3])} @regtime;
    @regtime = reverse @regtime if ($order == 1);
    
    &htmlhead($deltitle);
    print "<center><h3>$deltitle</h3></center>\n";

    my ($d_dev,$d_ino,$d_mode,$d_nlink,$d_uid,$d_gid,$d_rdev,$d_size,$d_atime,$d_mtime,$d_ctime,$d_blksize,$d_blocks)=stat("$datafile");
    my ($ssec,$smin,$shour,$sday,$smon,$syear,$swday,$syday,$sisdst)=gmtime($d_mtime+$offset*3600);
    $syear += 1900 if ($syear < 1900);
    $smon++;
    print "<center>\n";
    print "<a href=\"$script\">${title}へ</a><br>\n";
    print "</center><p>\n";

    print "<form name=delform action=$script method=post>\n";
    my $headcols = $cols + 4;
    print "<table cols=$headcols width=\"100%\" border=1 align=center>\n";

    print "<tr>";
    foreach (@header){
	print "<th>$_</th>";
    }
    print "<th>&nbsp;</th><th>&nbsp;</th>";
    print "<th>&nbsp;</th>";
    print "<th>";
    print "<input type=submit name=\"delete_checked\" value=\"一括削除\">\n";
    print "<input type=password name=\"pwd_checked\" size=10><br>↑パスワード\n";
    print "</th>";
    print "</tr>\n";

    # ($id,$dyear,$dmonth,$dday,$dhour,$dmin,$dtime,$dnow,$dpwd,$host,$ip,$dcomment);
    foreach my $refkey (@regtime){
	print "<tr>\n";

	print "<td nowrap width=\"10%\">";
	print "$refkey->[1]年";
	print "$refkey->[2]月";
	print "$refkey->[3]日";
	print "</td>\n";

	my @comarray = split /<>/, $refkey->[11];
	for (my $i=0;$i<$cols-1;$i++){
	    print "<td>";
	    if ($comarray[$i] eq ''){
		print "&nbsp;";
	    } else {
		print "$comarray[$i]";
	    }
	    print "</td>\n";
	}

	print "<td width=\"5%\" align=center>";
	print "<input type=password name=\"pwd_$refkey->[0]\" size=10>\n";
	print "</td>";

	print "<td width=\"5%\" nowrap align=center>";
	print "<input type=submit name=\"sub_$refkey->[0]\" value=\"削除\">\n";
	print "</td>";
	print "<td width=\"5%\" nowrap align=center>";
	print "<input type=submit name=\"mod_$refkey->[0]\" value=\"変更\">\n";
	print "</td>";
	print "<td width=\"5%\" nowrap align=center>";
	print "<input type=checkbox name=\"chk_$refkey->[0]\" value=\"on\">\n";
	print "</td>";

	print "</tr>\n";
    }
    print "</table><p>\n";
    print "削除・変更したい行のテキストボックスににパスワードを入れて削除、変更ボタンをクリックしてください。";
    print "<input type=hidden name=mode value=delete>\n";
    print "</form>\n";

    &htmltail;
}

sub histdelete {

    if ($q->param('delete_checked') ne ''){
	&delete_checked;
    }
    my ($fid,$fyear,$fmonth,$fday,$fhour,$fmin,$ftime,$fnow,$fpwd,$fhost,$fip,$fcomment);
    open (FILE, "< $datafile") or &error("${datafile}が開けません。");
    while (<FILE>){
	my @line = split /,/;
	my $modname = 'mod_' . $line[0];
	if ($q->param($modname) ne ''){
	    close(FILE);
	    &histmodify(@line);
	}
    }
    close(FILE);

    my @tmparray = ();
    open (DATAFILE, "+< $datafile") or &error("${datafile}が開けません。");
    flock DATAFILE, $LOCK_EX;
    while (<DATAFILE>){
	chomp;
	($fid,$fyear,$fmonth,$fday,$fhour,$fmin,$ftime,$fnow,$fpwd,$fhost,$fip,$fcomment) = split /,/;
	my $subname = 'sub_' . $fid;
	my $pwdname = 'pwd_' . $fid;
	my $inpwd = $q->param($pwdname);
	if (!$q->param($subname)) {
	    push @tmparray, "$fid,$fyear,$fmonth,$fday,$fhour,$fmin,$ftime,$now,$fpwd,$fhost,$fip,$fcomment\n";
	} elsif (! &checkcrypt($inpwd,$fpwd)) {
	    close(DATAFILE);
	    &error('パスワードが違います。');
	}
    }

    truncate DATAFILE, 0;
    seek DATAFILE, 0, 0;
    print DATAFILE @tmparray;
    close(DATAFILE);

    print "Location: $script\n\n";
    exit;
}

sub delete_checked {
    my @tmparray = ();
    open (DATAFILE, "+< $datafile") or &error("${datafile}が開けません。");
    flock DATAFILE, $LOCK_EX;
    my $inpwd = $q->param('pwd_checked');
    while (<DATAFILE>){
	chomp;
	my ($fid,$fyear,$fmonth,$fday,$fhour,$fmin,$ftime,$fnow,$fpwd,$fhost,$fip,$fcomment) = split /,/;
	my $chkname = 'chk_' . $fid;
	if ($q->param($chkname) ne 'on') {
	    push @tmparray, "$fid,$fyear,$fmonth,$fday,$fhour,$fmin,$ftime,$now,$fpwd,$fhost,$fip,$fcomment\n";
	} elsif (! &checkcrypt($inpwd,$fpwd)) {
	    close(DATAFILE);
	    &error("「$fyear年$fmonth月$fday日：$fcomment」のパスワードが違います。");
	}
    }

    truncate DATAFILE, 0;
    seek DATAFILE, 0, 0;
    print DATAFILE @tmparray;
    close(DATAFILE);

    print "Location: $script\n\n";
    exit;
}

sub histmodify {
    my ($fid,$fyear,$fmonth,$fday,$fhour,$fmin,$ftime,$fnow,$fpwd,$fhost,$fip,$fcomment) = @_;
    my $pwdname = 'pwd_' . $fid;
    my $inpwd = $q->param($pwdname);
    if (! &checkcrypt($inpwd,$fpwd)) {
	&error('パスワードが違います。');
    }

    &htmlhead('変更');
    print "<table cols=1 width=\"100%\" border=0 style=\"border:0px\" align=center>\n";
    print "<tr><td>";
    print "<form name=histmodify action=\"$script\" method=post>\n";
    print "<input type=text size=5 name=year value=\"$fyear\">年";
    print "<input type=text size=3 name=month value=\"$fmonth\">月";
    print "<input type=text size=3 name=day value=\"$fday\">日<br>\n";
    my @comarray = split /<>/, $fcomment;
    shift @header;
    my $i=0;
    foreach (@header){
	print "$_<br><textarea cols=30 rows=3 name=comment_$i wrap=soft>\n";
	print "$comarray[$i]";
	print "</textarea><br>\n";
	$i++;
    }
    print "<input type=hidden name=pwd value=\"$inpwd\"><p>\n";
    print "<input type=submit name=\"submit\" value=\"変更\">\n";
    print "<input type=hidden name=mode value=\"modify\">\n";
    print "<input type=hidden name=id value=\"$fid\">\n";
    print "</form>\n";
    print "</td></tr>\n";
    print "</table>\n";
    &htmltail;

    exit;
}

sub check_indate {
    my ($year,$month,$day) = @_;
    if (($year =~ /\D/ or $month =~ /\D/ or $day =~ /\D/) or
	(! check_date($year,$month,$day))){
	&error("日付が適切ではありません。${year}年${month}月${day}日")
	}
}

sub histwrite {
    my $year = $q->param('year');
    my $month = $q->param('month');
    my $day = $q->param('day');
    &check_indate($year,$month,$day);
    $year = sprintf("%d",$year);
    $month = sprintf("%d",$month);
    $day = sprintf("%d",$day);
    my $hour = 0;
    my $min = 0;
    my @comment;
    for (my $i=0;$i<$cols-1;$i++){
	$comment[$i] = $q->param("comment_$i");
    }
    my $pwd = $q->param('pwd');
    my $infid = $q->param('id');
    my $id;
    my $regtime;
    my $host;
    my $ip;
    my $encpwd;

    for (my $i=0;$i<$cols-1;$i++){
	$comment[$i] =~ s/,/&#44;/g;
	$comment[$i] =~ s/\r\n/<br>/g;
	$comment[$i] =~ s/\r/<br>/g;
	$comment[$i] =~ s/\n/<br>/g;
	$comment[$i] =~ s/<(\s*\/? *t)/&lt;$1/ig; # Do not allow table tag
	$comment[$i] =~ s/<(\s*plaintext)/&lt;$1/ig;
	$comment[$i] =~ s/<(\s*script)/&lt;$1/ig;
	$comment[$i] =~ s/<(\s*input)/&lt;$1/ig;
	$comment[$i] =~ s/<(\s*pre)/&lt;$1/ig;
	$comment[$i] =~ s/<(\s*embed)/&lt;$1/ig;
	$comment[$i] =~ s/<>/&lt;&gt;/ig;
    }

    $host = $ENV{'REMOTE_HOST'};
    $ip = $ENV{'REMOTE_ADDR'};
    # This colum is not used.
#    $regtime = timegm(0,$min,$hour,$day,$monthn1,$year);
    $regtime = 0;
    $encpwd = &makecrypt($pwd);

    &error('管理人オンリーモードなので管理人しか書き込めません。')
	if ($user_mode == 0 and !&checkadmin($pwd));
#    &error('パスワードが違います。') 
#	if ($user_mode == 1 and !&checkcrypt($pwd,$encpwd));

    if ($mode eq 'modify'){

	my @tmparray = ();
	open (DATAFILE, "+< $datafile") or &error("${datafile}が開けません。");
	flock DATAFILE, $LOCK_EX;
	while (<DATAFILE>){
	    chomp;
	    my ($fid,$fyear,$fmonth,$fday,$fhour,$fmin,$ftime,$fnow,$fpwd,$fhost,$fip,$fcomment) = split /,/;
	    my $modname = 'mod_' . $fid;
	    if ($fid != $infid) {
		push @tmparray, "$fid,$fyear,$fmonth,$fday,$fhour,$fmin,$ftime,$now,$fpwd,$fhost,$fip,$fcomment\n";
	    } elsif (&checkcrypt($pwd,$fpwd)) {
		my $jcomment = join '<>', @comment;
		push @tmparray, "$fid,$year,$month,$day,$hour,$min,$regtime,$now,$encpwd,$host,$ip,$jcomment\n";
	    } else {
		close(DATAFILE);
		&error("$fid:$infidパスワードが違います。");
	    }
	}
	
	truncate DATAFILE, 0;
	seek DATAFILE, 0, 0;
	print DATAFILE @tmparray;
	close(DATAFILE);

    } else {

	if (open DATA, "< $datafile"){
	    while (<DATA>){
		my @dummy;
		($id,@dummy) = split /,/;
	    }
	    close DATA;
	    $id++;
	} else {
	    $id = 1;
	}
	
	open (FILE, ">> $datafile") or &error("${datafile}が開けません。");
	# ($id,$dyear,$dmonth,$dday,$dhour,$dmin,$dtime,$dnow,$dpwd,$host,$ip,$dcomment);
	flock FILE, $LOCK_EX;
	my $jcomment = join '<>', @comment;
	print FILE "$id,$year,$month,$day,$hour,$min,$regtime,$now,$encpwd,$host,$ip,$jcomment\n";
	close(FILE);
    }

    print "Location: $script\n\n";

}

sub sortdata {
    my @alist = split /,/, $a;
    my @blist = split /,/, $b;
    return Delta_Days(@blist[1 .. 3],@alist[1 .. 3]);
}

sub getdata {
  my %histdata;
  my @dataarray;
  my $id;
  my $host;
  my $ip;
  my $id;
  my @alldata;
  if (open DATA, "< $datafile"){
      @alldata = <DATA>;
      close DATA;
  }

  foreach (sort sortdata @alldata) {
      chomp;
      # ($id,$dyear,$dmonth,$dday,$dhour,$dmin,$dtime,$dnow,$dpwd,$host,$ip,$dcomment);
      @dataarray = split /,/;
      next if ($dataarray[11] eq '');
      my $key;
      if ($date_disp == 0) {
	  $key = join '_', @dataarray[1 .. 3];
      } elsif ($date_disp == 1) {
	  $key = join '_', @dataarray[1 .. 2];
      } elsif ($date_disp == 2){
	  $key = $dataarray[1];
      }
      if (exists $histdata{$key}){
	  my @orgcomment = split /<>/, $histdata{$key}->[$#dataarray];
	  my @newcomment = split /<>/, $dataarray[11];
	  my $max;
	  if ($#orgcomment >= $#newcomment){
	      $max = $#orgcomment;
	  } else {
	      $max = $#newcomment;
	  }
	  my @replacecomment;
	  for (my $i=0;$i<=$max;$i++){
	      if ($orgcomment[$i] ne ''and $newcomment[$i] ne ''){
		  $replacecomment[$i] = $orgcomment[$i] . "<br>" . $newcomment[$i];
	      } elsif ($orgcomment[$i] eq '' and $newcomment[$i] ne ''){
		  $replacecomment[$i] = $newcomment[$i];
	      } else {
		  $replacecomment[$i] = $orgcomment[$i];
	      }
	  }
	  my $replacecomment = join '<>', @replacecomment;
	  $histdata{$key} = [
			     @dataarray[0 .. $#dataarray-1],
			     $replacecomment,
			     ];
      } else {
	  $histdata{$key} = [@dataarray];
      }
  }
  return (\%histdata);
}

sub getdeldata {
  my @histdata;
  my @dataarray;

  if (open DATA, "< $datafile"){
      @histdata = ();
      while (<DATA>){
	  chomp;
	  # ($id,$dyear,$dmonth,$dday,$dhour,$dmin,$dtime,$dnow,$dpwd,$host,$ip,$dcomment);
	  @dataarray = split /,/;
	  next if ($dataarray[11] eq '');
	  push(@histdata, [@dataarray]);
      }
      close DATA;
      return (\@histdata);
  }
}

sub htmlhead {
  
  my $title = shift;

  my $bgimage;
  if ($bgimage_en == 1){
    $bgimage = "background=\"$bgimage_file\"";
  } else {
    $bgimage = "bgcolor=\"$bgcolor\"";
  }

#  print "Content-type:text/html\n\n";
  print $q->header(-charset=>"$charset");
  print "<html>\n";
  print "<HEAD>\n";
  print "<TITLE>$title</TITLE>\n";
  if ($head_insert_en == 1){
    print "$head_insert\n";
  }
  
  if ($style_sheet_en == 1){
    print "<STYLE type=\"text/css\">\n";
    print "$style_sheet";
    print "\n</style>\n";
  }
  print "</HEAD>\n";
  print "<BODY TEXT=\"#000000\" $bgimage LINK=\"#0000EE\" VLINK=\"#551A8B\" ALINK=\"#FF0000\">\n";
  print "<table cols=1 border=0 width=\"${body_width}%\" style=\"border:0px\" align=center><tr><td style=\"border:0px;background-color:transparent\" >\n";
  
}

sub htmltail {
    my $mysite = ('http://www.hidekik.com/','http://www.hidekik.com/en/')[$lang];
  print "<div align=\"right\"><i>history2.cgi Ver. $version</i></div>\n";
  print "<div align=\"right\"><i>Copyright(C) 2005-$lastupdatedyear, <a href=\"$mysite\" target=\"_blank\">hidekik.com</a></i></div>\n";
  print "</td></tr></table></body></html>\n";
  exit;
}

sub makecrypt {
    my $plain = shift;
    my $salt = join "", ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64];
    my $result = crypt($plain,$salt) or crypt($plain,'$1$'.$salt.'$');
    return $result;
}

sub checkcrypt {
    my ($pwd,$encpwd)=@_;
    return(crypt($pwd,$encpwd) eq "$encpwd" or &checkadmin($pwd));
}

sub checkadmin {
  my $pwd = shift;
  
  if (open(FILE,"< $adminpwd")){
    my $filepwd = <FILE>;
    close(FILE);
    my $inpwd = crypt($pwd,$filepwd);
    return ("$inpwd" eq "$filepwd");
  } else {
    &error('パスワードファイルが存在しません');
  }
  
}
sub setadminpwd {
  
  &htmlhead('管理者用パスワードを入力してください');
  
  print "<form name=\"setpwd\" action=\"$script\" method=\"post\">\n";
  
  if ($mode eq 'setup'){
    print "<center>管理者用パスワードを入力してください。<br>\n";
    print "<input type=password name=\"pwd\" size=20>\n";
    print "<input type=submit name=\"sub\" value=\"入力\">\n";
    print "<input type=hidden name=\"mode\" value=\"setup\">\n";
  } else {
    print "<center>管理者用パスワードを設定してください。<br>\n";
    print "<input type=input name=\"pwd\" size=20>\n";
    print "<input type=submit name=\"sub\" value=\"設定\">\n";
    print "<input type=hidden name=\"mode\" value=\"wradminpwd\">\n";
  }
  
  &htmltail;
}

sub wradminpwd {

    my $plain = $q->param('pwd');
    my $passwd = &makecrypt($plain);
  
    if (open(FILE,"> $adminpwd")){
	print FILE "$passwd";
	close(FILE);
    } else {
	&error('パスワードファイル作成に失敗しました');
    }
  
    print "Location: $script\n\n";
}

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

sub setup {
    my $inpwd = $q->param('pwd');
    &setadminpwd if ($inpwd eq '');
    &error('管理用パスワードが違います。') unless &checkadmin($inpwd);

    &htmlhead('管理用セットアップ');
  
    my %check;
  
    $check{bgimage}[$bgimage_en] = "checked";
    $check{backlink}[$backlink_en] = "checked";
    $check{order}[$order] = "checked";
    $check{date_disp}[$date_disp] = "checked";
    $check{user_mode}[$user_mode] = "checked";
    $check{style_sheet}[$style_sheet_en] = "checked";
    $check{head_insert}[$head_insert_en] = "checked";
    $check{sep_wrpage}[$sep_wrpage] = "checked";
    
    print "<form name=\"setup\" action=\"$script\" method=\"post\">\n";
    print "<input type=hidden name=\"mode\" value=\"setupwrite\">\n";
    print "<input type=hidden name=\"pwd\" value=\"$inpwd\">\n";
    
    print <<END;
<table cols=2 border=1 width="100%">
<tr>
<td colspan=2>
<ul>
<li><font color=red>数字やカラー指定は必ず半角で指定してください。全角やブランクだとＣＧＩが起動しなくなります。</font>万一間違って全角で書いてしまった場合は、${setupfile}をエディタで開きその場所を半角に正しく修正してください。それで直ります。</li>
</ul>
</td>
</tr>

<tr>
<td>データファイル</td>
<td><input type=text name="datafile" value="$datafile" size=30></td>
</tr>

<td>タイトル</td>
<td>
<input type=text name="title" value="$title" size=30>
</td>
</tr>

<td>削除ページタイトル</td>
<td>
<input type=text name="deltitle" value="$deltitle" size=30>
</td>
</tr>

<tr>
<td>バックグランド</td>
<td>
<input type=radio name=bgimage_en value=1 $check{bgimage}[1]>画像を使う
<input type=radio name=bgimage_en value=0 $check{bgimage}[0]>カラー設定にする<br>
<input type=text name="bgimage_file" value="$bgimage_file" size=30>画像を使う場合の画像ファイル<br>
<input type=text name="bgcolor" value="$bgcolor" size=10>カラー設定の場合のカラー番号（白：#ffffff 又は white）
</td>
</tr>

<tr>
<td>トップへのリンク</td>
<td>
<input type=radio name=backlink_en value=1 $check{backlink}[1]>表\示
<input type=radio name=backlink_en value=0 $check{backlink}[0]>非表\示<br>
<input type=text name="backlink_name" value="$backlink_name" size=30>リンク名<br>
<input type=text name="backlink" value="$backlink" size=30>ＵＲＬ<br>
</td>
</tr>

<tr>
<td>表\示幅</td>
<td>
ブラウザ全体の<input type=text name="body_width" value="$body_width" size=5>％
</td>
</tr>

<tr>
<td>表\示する順序</td>
<td>
<input type=radio name=order value=0 $check{order}[0]>新しい順
<input type=radio name=order value=1 $check{order}[1]>古い順
</td>
</tr>

<tr>
<td>年月日表\示</td>
<td>
<input type=radio name=date_disp value=0 $check{date_disp}[0]>年月日
<input type=radio name=date_disp value=1 $check{date_disp}[1]>年月のみ
<input type=radio name=date_disp value=2 $check{date_disp}[2]>年のみ
</td>
</tr>

<td>カラムのタイトル</td>
<td>
半角カンマで区切ってください。日付と最低もう一つは指定してください。指定した数だけコメントがその日に記入でいるようになります。<br>
<input type=text name="headers" value="$headers" size=30>
</td>
</tr>

<tr>
<td>管理人モード</td>
<td>
<input type=radio name=user_mode value=0 $check{user_mode}[0]>管理人オンリーモード
<input type=radio name=user_mode value=1 $check{user_mode}[1]>ユーザーモード<br>
管理人オンリーでは管理人しか書き込めません。ユーザーモードでは誰でも書き込めます。
</td>
</tr>

<tr>
<td>書き込み別ページ</td>
<td>
<input type=radio name=sep_wrpage value=0 $check{sep_wrpage}[0]>書き込みフォームは表\示ページの下
<input type=radio name=sep_wrpage value=1 $check{sep_wrpage}[1]>書き込みページは別ページ<br>
</td>
</tr>

<tr>
<td>ページ上部</td>
<td>
ページ上部に表\示させるものをＨＴＭＬ表\記<br>
<textarea name="body_head" cols=50 rows=3 wrap=soft>$body_head</textarea><br>
</td>
</tr>

<tr>
<td>ページ下部</td>
<td>
ページ下部に表\示させるものをＨＴＭＬ表\記<br>
<textarea name="body_tail" cols=50 rows=3 wrap=soft>$body_tail</textarea><br>
</td>
</tr>

<tr>
<td>スタイルシート</td>
<td>
<input type=radio name=style_sheet_en value=1 $check{style_sheet}[1]>有効
<input type=radio name=style_sheet_en value=0 $check{style_sheet}[0]>無効<br>
<textarea name="style_sheet" cols=50 rows=3>$style_sheet</textarea><br>
</td>
</tr>

<tr>
<td>&lt;head&gt;内挿入文</td>
<td>
<input type=radio name=head_insert_en value=1 $check{head_insert}[1]>有効
<input type=radio name=head_insert_en value=0 $check{head_insert}[0]>無効<br>
ＨＴＭＬ書式<br>
ポップアップ広告やJavascript、&lt;META&gt;を挿入したい場合にここに記述する。<br>
以下の記述が&lt;head&gt;〜&lt;/head&gt;内に挿入される。<br>
<textarea name="head_insert" cols=50 rows=3>$head_insert</textarea><br>
</td>
</tr>

<tr>
<td>時間設定</td>
<td>GMTより<input type=text name=offset value=$offset size=2>時間(日本：+9時間)</td>
</tr>

</table>

END

  print "<input type=submit name=\"sub\" value=\"設定\">";
  print "</form>";

  &htmltail;
}

sub setupwrite {

    my %in = $q->Vars;

    open (SETUP, "> $setupfile") or &error("${setupfile}が開けません。");
    print SETUP <<END;
### デフォルト設定 ###
    
# data file
\$datafile = '$in{datafile}';

# Title
\$title = '$in{title}';

# Delete page title
\$deltitle = '$in{deltitle}';

# Background
\$bgimage_en = $in{bgimage_en};
\$bgimage_file = '$in{bgimage_file}';
\$bgcolor = "$in{bgcolor}";

# Back link
\$backlink_en = $in{backlink_en};
\$backlink = '$in{backlink}';
\$backlink_name = '$in{backlink_name}';

# Body width
\$body_width = '$in{body_width}';

# Display order 0:From new, 1:From old
\$order = $in{order};

# Date display 0:年月日 1:年月のみ 2:年のみ
\$date_disp = $in{date_disp};

# Header
\$headers = '$in{headers}';

# body_head
\$body_head = '$in{body_head}';

# body_tail
\$body_tail = '$in{body_tail}';

# mode 0:admin only, 1:user mode
\$user_mode = $in{user_mode};

# 書き込み別ページ 1:on 0:off
\$sep_wrpage = $in{sep_wrpage};

# Style Sheet
\$style_sheet_en = $in{style_sheet_en};
\$style_sheet = '$in{style_sheet}';

# Head insert
\$head_insert_en = $in{head_insert_en};
\$head_insert = '$in{head_insert}';

# Offset from GMT, Japan:+9
\$offset = $in{offset};
END
    close(SETUP);

    print "Location: $script\n\n";
}