perlからPHPへの書き換え補助

変数名	スカラー	配列	ハッシュ
history	●	●		historyを編集
ver	●	●		verを編集
file	●	●		fileを編集
tmp	●	●		tmpを編集
val	●	●		valを編集
memo	●	●		memoを編集
m	●	●		mを編集
wh	●	●		whを編集
str	●	●		strを編集
category	●	●		categoryを編集
w	●	●		wを編集
cont	●	●		contを編集
cook	●	●		cookを編集
param		●	●	paramを編集

--------------------------------------------------------------------------------------------------

■以下の書式を変換します

qq() → "" 226件
my 除去 91件
my ()除去 12件
eq → === 62件
ne → !== 14件
elsif → elseif 24件
ループ中のnext → continue 2件
行末のifを変換 30件
ループ中のlast → break 11件
sub func { → function() { 39件
(stat($path))[9] → filemtime($path) 2件
正規表現のマッチを変換 59件
正規表現のマッチを変換(否定) 3件
正規表現の置換を変換(複数回) 46件
正規表現の置換を変換(1回のみ) 20件
-e → file_exists 14件
-d → is_dir 2件
int → intval 2件
関数呼び出し変更 142件
配列の要素数 1件
foreach文変更(要素名指定) 11件
foreach文変更(要素名省略) 17件
foreach $key (keys %ハッシュ)の変換 1件
foreach (keys %ハッシュ)の変換 2件
配列初期化 3件
配列の@を$に変更(代入あり) 15件
配列の@を$に変更 86件
ハッシュの%を$に変更(代入あり) 6件
文字列を分割して複数の変数に代入 6件
複数の変数に代入 16件
split → explode(要素名指定) 10件
split → explode(要素名省略) 2件
join修正 2件
mkdirに()をつける 3件
unlinkに()をつける 5件
文字列中の配列要素を分離 37件
$ENV[環境変数] 5件

--------------------------------------------------------------------------------------------------

上記の置換パターンを編集する

--------------------------------------------------------------------------------------------------

現在のcalendar.cgiの内容

1		#!/usr/local/bin/perl
2
3		#┌─────────────────────────────────
4		#│ 長期スケジュール表
5		#│ Copyright (c) hirayama
6		#│http://www2u.biglobe.ne.jp/~k_hiray/sts/fsw/
7		#｜年間の予定はもとより、1年前、1年後、2年後の予定も一覧で表示できる長期スケジュール表です。
8		#｜ブラウザからカレンダーの見た目をカスタマイズできます。
9		#｜スケジュールをカテゴリー分けし、色分け表示することができます。
10		#｜ローカル環境で動かす場合、総合情報管理ツールAgendaとデータを共有することができます。
11		#└─────────────────────────────────
12		#┌─────────────────────────────────
13		#│ [注意事項]
14		#│ 1. このスクリプトはフリーソフトです。このスクリプトを使用した
15		#│ いかなる損害に対して作者は一切の責任を負いません。
16		#└─────────────────────────────────
17		my $history = <<"EOF";
18		# ver.1.01 2007.12.11 過去のメモがうまく表示されないバグを修正
19		# ver.1.02 2008.10.10 表示年数をクッキーに保存するよう修正(パスワードをクッキーに保存する設定の場合)
20		# ver.1.03 2008.10.14 設定画面のデフォルト表示年数がクッキーの影響を受けてしまうのを修正
21		# ver.1.04 2010.02.25 Agendaのファイルがうまく読み込めない場合があるのを修正
22		# ver.1.05 2010.02.26 カレンダーのフォント、セルのサイズの微調整ボタンを追加し、クッキーに保存するようにしました。
23		# 誰でも書き込みできる場合はタグを無効にしました。
24		# ver.1.051 2010.03.08 3か月表示モードで今月の背景色が表示されていなかったのを修正しました。
25		# ver.1.06 2010.03.10 ファイルアップロード機能を追加しました。
26		# ver.1.061 2010.03.15 メモに"(ダブルクォート)が含まれていると表示が崩れるバグを修正しました。
27		# ver.1.07 2010.03.30 ファイルをオリジナル名のままアップロードできるようにしましたが、日本語の場合はURLエンコード化します。
28		# ver.1.08 2011.06.16 検索で、日本語の文字コードの途中でマッチするのを回避しました。init.cgiのバックアップファイル名を変更しました。
29		# ver.1.09 2012.03.07 カテゴリー編集で既存のカテゴリーを削除するとエラーになるバグを修正しました。
30		# ver.1.091 2012.04.17 表示年を西暦で指定するように変更しました。先月のカレンダーが左端にくるように配置していましたが、
31		# 現在が何月かにかかわらず、1月を左端に配置できるようにしました。(管理者設定画面で\$january_top を1にする)
32		# ver.1.092 2012.04.25 カレンダーの表示モード(年表示、3か月表示)をクッキーに保存するようにしました。
33		# バージョンアップでファイルを上書きしてもinit_bck.cgiから設定を復元するようにしました。
34		# ver.1.093 2012.05.17 先頭を1月にする設定にした場合、指定した範囲の年月がうまく表示されないバグを修正しました。
35		# ver.1.094 2013.03.08 カレンダーのサイズ調整がうまくいかないバグを修正しました。設定編集時のリダイレクトを廃止しました。
36		# ver.1.095 2014.02.13 9文字以上のパスワードも使用できるようにしました。
37		# ver.1.096 2014.02.19 先頭を1月にしない場合、1月から2月で指定した年数表示にならないバグを修正しました。
38		EOF
39		@ver = $history =~ /ver\.?(\d+\.\d*)/g;
40		foreach $version (@ver) {
41		$ver = $version if $version > $ver;
42		}
43		require './init.cgi';
44		require './lib/cgi-lib.pl';
45		require './lib/jcode.pl';
46		require './lib/holiday.pl'; # kent-webで公開されているholiday.plを使用させてもらっています。
47
48		#===========================
49		if (! $code) {
50		# 暗号化方法が未定の場合のみスクリプトファイルを書き換え
51		use File::Find;
52		# MD5モジュールがインストールされているかどうか調べる
53		my $md5ok;
54		find(\&mdsearch, @INC);
55		sub mdsearch {
56		if ($_ eq 'MD5.pm') {
57		$md5ok = 1;
58		return $md5ok;
59		}
60		}
61		&lock;
62		open(INT,'./init.cgi') \|\| &error("init.cgiが開けません。");
63		my @init = <INT>;
64		close(INT);
65
66		my $code_str;
67		if ($md5ok) {
68		$code_str = '$code = 2;' . "\n";
69		} else {
70		$code_str = '$code = 1;' . "\n";
71		}
72		open(INT,">./init.cgi");
73		foreach (@init) {
74		if (/^\s\$code\s=/) {
75		print INT $code_str;
76		} else {
77		print INT $_;
78		}
79		}
80		close(INT);
81		&unlock;
82		}
83
84
85		$title = $cal_title;
86		&decode;
87
88		# 本日を求める
89		$ENV['TZ'] = "JST-9";
90		my ($tsec, $tmin, $thour, $tmday, $tmon, $tyear)=localtime(time);
91		$tyear+=1900;
92		$tmon++;
93
94		if ($in['test']) {
95		$tyear = substr($in['test'],0,4);
96		$tmon = substr($in['test'],4,2);
97		}
98
99		my ($cpass,$cstyear,$cendyear,$ccfsize,$cccwidth,$type) = &get_cookie if $pass_cookie;
100		my $ctype = $type;
101		$in['type'] = $type if ! $in['type'];
102		if ($in['mode'] ne 'config') {
103		if ($cstyear ne '') {
104		$before_year = $cstyear;
105		}
106		if ($cendyear ne '') {
107		$show_year = $cendyear;
108		}
109		}
110
111		if ($ccfsize) {
112		$cal_fsize = $ccfsize;
113		} else {
114		$cal_fsize = $calSize;
115		}
116		if ($cccwidth) {
117		$cal_cwidth = $cccwidth;
118		} else {
119		$cal_cwidth = $cellwidth;
120		}
121
122		# パスワードが設定されていなければ初期設定
123		my @config_value;
124		my $load_config;
125		if (!$pass) {
126		# init.cgiのバックアップが存在すれば
127		if (-e 'init_bck.cgi') {
128		open(BCK,'init_bck.cgi');
129		my @scr = <BCK>;
130		close(BCK);
131		foreach my $cfg ('pass',@config) {
132		my (@tmp, $com, $name, $value);
133		foreach my $line (@scr) {
134		if ($line =~ /^\s*#/) { next; }
135		if ($line =~ /\s(my)?\s\$$cfg\s=\s/) {
136		@tmp = split(/;/,$line);
137		$com = pop(@tmp);
138		chomp $com;
139		$line = join(';',@tmp);
140		($name, $value) = split(/=/,$line);
141		$name =~ s/^\smy\s[^\$]//;
142		$name =~ s/\s*$//;
143		$value =~ s/^\s*['"]?//;
144		$value =~ s/['"]?\s*$//;
145		last;
146		}
147		}
148		push(@config_value,qq($cfg<>$value));
149		if ($cfg eq 'pass' && $value) {
150		$load_config = 1;
151		}
152		}
153		if ($load_config) {
154		$title .= '－設定読み込み－';
155		&load_config;
156		exit;
157		} else {
158		$title .= '－初期設定－';
159		&create_pass;
160		exit;
161		}
162		} else {
163		$title .= '－初期設定－';
164		&create_pass;
165		exit;
166		}
167		}
168		if ($in['year'] eq 'リセット') {
169		$in['show_year'] = '';
170		$in['before_year'] = '';
171		&set_cookie($cpass,1,1,$cal_fsize,$cal_cwidth,$in['type']);
172		my $url = $script;
173		&redirect($url);
174		}
175		if ($in['end_year']) {
176		if ($january_top \|\| $tmon <= 2) {
177		$in['show_year'] = $in['end_year'] - $tyear;
178		} else {
179		$in['show_year'] = $in['end_year'] - $tyear - 1;
180		}
181		}
182		if ($in['show_year'] ne '') {
183		$show_year = $in['show_year'];
184		}
185		if ($in['start_year']) {
186		$in['before_year'] = $tyear - $in['start_year'];
187		}
188		if ($in['before_year'] ne '') {
189		$before_year = $in['before_year'];
190		}
191		# カレンダーサイズ調整ボタンを押したら
192		if ($in['csize_edit']) {
193		$cal_fsize =~ /(\d+)/;
194		$calf = $1;
195		if ($in['cfsize'] eq '＋') {
196		$calf += 10;
197		} elsif ($in['cfsize'] eq '－') {
198		$calf -= 10;
199		}
200		$cal_fsize =~ s/^\d+/$calf/;
201		if ($in['ccsize'] eq '＋') {
202		$cal_cwidth ++;
203		} elsif ($in['ccsize'] eq '－') {
204		$cal_cwidth --;
205		}
206		&set_cookie($cpass,$cstyear,$cendyear,$cal_fsize,$cal_cwidth,$in['type']);
207		}
208
209		# クッキーを保存する設定で、表示年数変更ボタンを押したら
210		if ($in['change_show_year'] && $pass_cookie) {
211		$cstyear = $in['before_year'];
212		$cendyear = $in['show_year'];
213		&set_cookie($cpass,$cstyear,$cendyear,$cal_fsize,$cal_cwidth,$in['type']);
214		}
215
216		if ($pass_cookie && $ctype ne $in['type']) {
217		&set_cookie($cpass,$cstyear,$cendyear,$cal_fsize,$cal_cwidth,$in['type']);
218		}
219
220		if ($in['mode'] eq 'write') {
221		&write;
222		exit;
223		} elsif ($in['mode'] eq 'del_file') {
224		&del_file;
225		exit;
226
227		# 検索ボタンを押して、キーワードがTrueの場合
228		} elsif ($in['mode'] eq 'search' && $in['keyword'] ne '') {
229		$title .= qq(－検索－);
230		&search;
231		exit;
232		} elsif ($in['mode'] eq 'config') {
233		$title .= qq(－設定－);
234		&config;
235		exit;
236		} elsif ($in['mode'] eq 'history') {
237		&history;
238		exit;
239		}
240
241		# Agendaと連携する場合、Agendaの指定ディレクトリからファイルリストを作成
242		@agd_cont = ();
243		if ($coop_agenda) {
244		if (!-e $agenda_dir) {
245		&header;
246		print qq(<div style="line-height:1.5em;margin:1em">);
247		if ($agenda_dir) {
248		print qq(<span style="font-weight:bold;">$agenda_dir</span>が開けません。パスを確認してください。<br>\n);
249		} else {
250		print qq(AgendaのDataフォルダが指定されていません。<br>\n);
251		}
252		print '$agenda_dirを指定してください。Windows XPの場合は通常 <strong>"C:\Documents and Settings\(ユーザー名)\Application Data\Oceansoft\Agenda\Data"</strong> です。<br>';
253		print qq(総合情報管理ツールAgendaと連携しない場合は、<strong>\$coop_agenda = 0;</strong> に設定してください。<a href="$script?mode=config">$title設定</a>);
254		print qq(</div>);
255		&footer;
256		exit;
257		}
258		opendir(AGD,$agenda_dir) \|\| &error($agenda_dir . "が開けません。");
259		while ($file = readdir(AGD)) {
260		($dt,$ex) = split(/\./,$file);
261		$agenda_dir =~ s/\\/\//g;
262		$agenda_dir =~ s/\/$//g;
263		my $path = join('/',$agenda_dir, $file);
264		if ($file ne '.' && $file ne '..' && $ex eq 'dat' && (stat $path)[7] > 0 && $dt =~ /^[0-9]${8}/) {
265		push(@agd_cont,$file);
266		}
267		}
268		closedir(AGD)
269		}
270		$data_dir =~ s/\/$//g;
271		if (!-e $data_dir) { mkdir $data_dir; } # $data_dirがなければ作っておく。
272		&header;
273
274		# Agendaと連携する場合、Agendaのデータディレクトリにあるファイルをコピー。sjis → euc に文字コード変換
275		if ($coop_agenda) {
276		@agd_cont = sort {$b <=> $a} @agd_cont;
277		foreach (@agd_cont) {
278		$date = (split(/\./,$_))[0];
279		$ag_data = $agenda_dir . '/' . $date . '.dat';
280		$cal_data = $data_dir . '/' . $date . '.cgi';
281		if (!-e $cal_data \|\| (stat $ag_data)[9] > (stat $cal_data)[9]) {
282		open(DAT,"$ag_data") \|\| &error("$ag_dataが開けません。");
283		@ag_cont = <DAT>;
284		close(DAT);
285		if (!-e $cal_data) {
286		open(NEW,">$cal_data") \|\| &error("$cal_dataが作成できません。");
287		close(NEW);
288		}
289		open(OLD,"$cal_data") \|\| &error("$cal_dataが開けません。1");
290		$first_line = <OLD>;
291		close(OLD);
292		if (index($first_line,'<!-!>') >= 0) {
293		$cat = (split(/<!-!>/,$first_line))[0];
294		} else {
295		$cat = '';
296		}
297		open(NEW,">$cal_data") \|\| &error("$cal_dataが開けません。2");
298		print NEW $cat . qq(<!-!>);
299		foreach $line (@ag_cont) {
300		&jcode'convert(*line,'euc'); #'
301		print NEW $line;
302		}
303		close(NEW);
304		print $ag_data . "の内容をコピーしました。<br>\n";
305		}
306		}
307		}
308		&calen;
309		&footer;
310
311
312		# 更新履歴を表示
313		sub history {
314		$title .= ' 更新履歴';
315		&header;
316		@history = split("\n",$history);
317		my $i = 0;
318		foreach (@history) {
319		if (!/\s+ver[\.\s]*\d/) {
320		s/#\s*/<br>/;
321		$history[$i-1] .= $_;
322		$history[$i] = '';
323		}
324		$i++;
325		}
326		@history = reverse @history;
327		print qq(<div style="margin:1em"><a href="#" onClick="history.back(); return false;">戻る</a>\n<table cellpadding="2" style="line-height:1.5em">\n);
328		foreach (@history) {
329		next if !$_;
330		s/^#\s*//;
331		s/\t+/<\/td><td valign="top">/g;
332		print qq(<tr><td valign="top">●</td><td valign="top">);
333		print $_ . "<br>\n";
334		print qq(</td></tr>);
335		}
336		print qq(</table>\n</div>\n);
337		&footer;
338		}
339
340		sub create_pass {
341		# $in['pass']がTrueならinit.cgiに管理者用パスワードを書き込む
342		if ($in['pass']) {
343		if (length($in['pass']) < 5) {
344		&error("パスワードは5文字以上にしてください。");
345		}
346		# init.cgi読み込み
347		open(INIT,"./init.cgi") \|\| &error("./init.cgiが開けません。");
348		@init = <INIT>;
349		close(INIT);
350		@new_init = ();
351		foreach $line (@init) {
352		$tmp = $line;
353		$tmp =~ s/ //g;
354		if ($tmp =~ /^\$pass='/) {
355		# 入力された管理者用パスワードをcryptして$passに代入する文字列を生成
356		$crypt_pass = &encrypt($in['pass']);
357		@tmp = split(/;/,$line);
358		my $com = pop(@tmp);
359		$new_pass = '$pass = ' . qq(') . $crypt_pass . qq(';) . $com;
360		push(@new_init,$new_pass);
361		} else {
362		push(@new_init,$line);
363		}
364		}
365		# init.cgi書き込み前にバックアップ作成
366		open(INIT,">./init_bck.cgi") \|\| &error("./init_bck.cgiが開けません。");
367		print INIT @init;
368		close(INIT);
369		unlink 'init.bck' if -e 'init.bck'; # 以前のバックアップが残っていたら削除
370
371		# init.cgi書き込み
372		open(INIT,">./init.cgi") \|\| &error("./init.cgiが開けません。");
373		print INIT @new_init;
374		close(INIT);
375
376		# 掲示板設定画面に移動する
377		if ($ENV[PERLXS] eq "PerlIS") {
378		print "HTTP/1.0 302 Temporary Redirection\r\n";
379		print "Content-type: text/html\n";
380		}
381		print "Location: $script?mode=config&pass=$in['pass']\n\n";
382		exit;
383		}
384		&header;
385		print qq(<div style="margin:1em">);
386		print qq(<p>管理者用パスワードを設定してください。</p>\n);
387		print qq(<form action="$script" method="post">\n);
388		print qq(パスワード <input type="password" name="pass" value="" size="10">\n);
389		print qq(<input type="submit" value="登録">\n);
390		print qq(</form>\n);
391		print qq(</div>);
392		&footer;
393		}
394
395
396		sub config {
397		if ($in['change_pass'] eq '管理者パスワードを変更') {
398		if (length($in['new_pass']) < 5) {
399		&error("パスワードは5文字以上にしてください。");
400		}
401		}
402		if ($pass_cookie) { ($cpass) = &get_cookie; }
403		if ($in['pass'] eq "") {
404		&header;
405		print "<center><h4>パスワードを入力して下さい</h4>\n";
406		print "<form action=\"$script\" method=\"POST\">\n";
407		print "<input type=hidden name=mode value=\"config\">\n";
408		print "<p><input type=password name=pass size=8 value=\"$cpass\">\n";
409		print "<input type=submit value=\" 認証 \"></form>\n";
410		print "</center>\n";
411		&footer;
412		exit;
413		} elsif (&decrypt($in['pass'], $pass) eq 'no') {
414		&error("パスワードが違います");
415		}
416		if ($pass_cookie) {
417		if (!$in['before_year']) {
418		$in['before_year'] = $before_year;
419		}
420		if (!$in['show_year']) {
421		$in['show_year'] = $show_year;
422		}
423		&set_cookie($in['pass'],$in['before_year'],$in['show_year'],$cal_fsize,$cal_cwidth,$in['type']);
424		}
425
426		open(INIT,"./init.cgi") \|\| &error("./init.cgiが開けません。");
427		@init = <INIT>;
428		close(INIT);
429		my $list_nmb = 0;
430		foreach (keys %in) {
431		if (/^cat(\d+)/) {
432		$list_nmb = $1 if $1 > $list_nmb;
433		}
434		}
435		@new_line = ();
436		$line_count = 0;
437		foreach $init_line (@init) {
438		$line_flag =0;
439		if ($in['config'] eq 'category_color') {
440		if ($init_line =~ /^\s\@category\s=\s*/) { # 正規表現がイマイチわからない(^^;;
441		my @cat;
442		foreach (my $count=0; $count<=$list_nmb; $count++) {
443		if ($in["cat$count"] && $in["col$count"]) {
444		push(@cat,"'" . $in["cat$count"] . "'");
445		}
446		}
447		$init_line = '@category = (' . join(',',@cat) . ");\n";
448		} elsif ($init_line =~ /^\s\@category_color\s=\s*/) {
449		my @col;
450		foreach (my $count=0; $count<=$list_nmb; $count++) {
451		if ($in["cat$count"] && $in["col$count"]) {
452		$init_line .= "'" . $in["col$count"] . "',";
453		push(@col,"'" . $in["col$count"] . "'");
454		$base_color = $in["col$count"];
455		$base_color =~ s/#//;
456		$r = substr($base_color,0,2);
457		$g = substr($base_color,2,2);
458		$b = substr($base_color,4,2);
459		$r_hex = hex($r);
460		$g_hex = hex($g);
461		$b_hex = hex($b);
462		$meido = $r_hex * 0.299 + $g_hex * 0.587 + $b_hex * 0.114;
463		if ($meido < 128) {
464		$add_comment .= qq($in["cat$count"]の色) . '＃' . qq(${base_color}は暗すぎて文字の抜けが悪い恐れがあります。できればもっと明るい色にしてください。\n);
465		}
466		}
467		}
468		$init_line = '@category_color = (' . join(',',@col) . ");\n";
469		} elsif ($init_line =~ /^\s\$memo_col\s=\s*/ && $in['memo_col']) {
470		$init_line = '$memo_col = ' . "'" . $in['memo_col'] . "';\n";
471		}
472		}
473		foreach $cfg (@config) {
474		$next = 0;
475		foreach (@invalid) {
476		if ($cfg eq $_) {
477		$next = 1;
478		}
479		}
480		if ($cfg && $init_line =~ /^\s\$$cfg\s=\s*/) {
481		if ($in["$cfg"] =~ /^\d+$/) {
482		$value = $in["$cfg"];
483		} else {
484		$val = $in["$cfg"];
485		$val =~ s/</</g;
486		$val =~ s/>/>/g;
487		$val =~ s/"/"/g; #"
488		$val =~ s/\\$//;
489		$value = "'" . $val . "'";
490		}
491		@tmp = split(/;/,$init_line);
492		$com = pop(@tmp);
493
494		chomp $com;
495		$popup["$cfg"] = $com;
496		if (!$next && $in['config'] ne 'category_color') {
497		$init_line = '$' . $cfg . " = " . $value . ";" . $com . "\n";
498		}
499		$ex_line = $line_count - 1;
500		while ($init[$ex_line] =~ /^#+/) {
501		$memo = $init[$ex_line];
502		$popup["$cfg"] = $memo . $popup["$cfg"];
503		$ex_line--;
504		}
505		last;
506		}
507		}
508		if ($in['change_pass'] eq '管理者パスワードを変更' && $init_line =~ /^\$pass\s=\s/) {
509		$crypt_pass = &encrypt($in['new_pass']);
510		@tmp = split(/;/,$init_line);
511		$com = pop(@tmp);
512		$init_line = '$pass = ' . "'" . $crypt_pass . "';" . $com;
513		$new_pass = $in['new_pass'];
514		}
515		push(@new_line, $init_line);
516		$line_count++;
517		}
518		my $comment;
519		if ($in['modify'] eq 'do') {
520
521		# init.cgi書き込み前にバックアップ作成
522		use File::Copy;
523		copy './init.cgi', './init_bck.cgi';
524		unlink 'init.bck' if -e 'init.bck'; # 以前のバックアップが残っていたら削除
525
526		open(NEW,">./init.cgi") \|\| &error("./init.cgiが開けません。");
527		print NEW @new_line;
528		close(NEW);
529
530		# パスワードを変更した場合は$in['pass']に新しいパスワードを入れてリダイレクトする。クッキーも新パスワードに更新される。
531		if ($new_pass) {
532		$in['pass'] = $new_pass;
533		# $comment = &url_encode('パスワードを変更しました。');
534		$comment = 'パスワードを変更しました。';
535		$add = qq(&pass_change=1&comment=$comment);
536		} elsif ($in['config'] eq 'category_color') {
537		$comment = 'カテゴリーを編集しました。';
538		if ($add_comment) {
539		$comment .= "\n" . $add_comment;
540		}
541		# $comment = &url_encode($comment);
542		$add = qq(&comment=$comment);
543		} else {
544		$com = qq(設定を編集しました。);
545		if (!$in['permission'] && $in['use_tag']) {
546		$com .= qq(\n管理者のみ編集可でないと、タグを有効にできません。);
547		}
548		# $comment = &url_encode($com);
549		$comment = $com;
550		$add = qq(&comment=$comment);
551		}
552		# if ($ENV[PERLXS] eq "PerlIS") {
553		# print "HTTP/1.0 302 Temporary Redirection\r\n";
554		# print "Content-type: text/html\n";
555		# }
556		# print "Location: $script?mode=config&pass=$in['pass']$add\n\n";
557		# exit;
558		}
559		&header;
560		print qq(<div style="padding:0.5em 1em 0.5em 1em;">\n);
561		print qq(<div style="margin-bottom:0.5em">[<a href="$script">戻る</a>]</div>\n);
562		if (length($in['pass']) > 8 && length($pass) == 13 && ! $in['new_pass']) {
563		print qq(<div style="line-height:1.5em;color:red;margin-bottom:0.5em">9文字以上のパスワードを使用されていますが、現在8文字目までしか有効になっていません。<br>9文字目以降も有効にするには、お手数ですが「管理者パスワードを変更」ボタンを押して再度登録してください。</div>\n);
564
565		}
566		print qq(<table border="$frame_border" cellpadding="$frame_padding" cellspacing="$frame_spacing" border=0><tr>\n);
567		$today = sprintf("%04d-%s-%s", $tyear,$tmon,$tmday);
568		my $yy = $tyear;
569		my $mm = $tmon;
570		for ($m = $mm - 1; $m <= $mm + 1; $m++) {
571		if ($m < 1) {
572		$mmm = $m + 12;
573		$yyy = $yy - 1;
574		} elsif ($m > 12) {
575		$mmm = $m - 12;
576		$yyy = $yy + 1;
577		} else {
578		$mmm = $m;
579		$yyy = $yy;
580		}
581		if ($tyear == $yyy && $tmon == $mmm) {
582		print qq(<td valign="top" bgcolor="$tomon_col">);
583		} else {
584		print qq(<td valign="top">);
585		}
586		&create_calen($yyy,$mmm);
587		print qq(</td>\n);
588		}
589		print qq(</tr></table>\n);
590		# print qq(<div style="color:red;padding-top:0.5em">$in['comment']</div>) if $in['comment'];
591		print qq(<div style="color:red;padding-top:0.5em">$comment</div>) if $comment;
592		print qq(<table cellpadding="4"><tr><td valign="top">\n);
593		print qq(<form action="$script" method="post">\n);
594		print qq(<input type="hidden" name="mode" value="config">\n);
595		print qq(<input type="hidden" name="modify" value="do">\n);
596		print qq(<input type="hidden" name="pass" value="$in['pass']">\n);
597		print qq(<table border="1">\n);
598		print qq(<tr><td colspan="3"><input type="submit" value="　修　正　"> 変更する部分のみ修正して「修正」ボタンを押してください。</td></tr>\n);
599		print qq(<tr><td colspan="3"><input type="submit" name="change_pass" value="管理者パスワードを変更"> 新しいパスワード <input type="text" name="new_pass">\n);
600		print qq(</td></tr>\n);
601		foreach (@config) {
602		$enc = $$_;
603		if ($in["$_"] ne '') {
604		$enc = $in["$_"];
605		}
606		$enc =~ s/</</g;
607		$enc =~ s/>/>/g;
608		$enc =~ s/"/"/g;
609		$length = length($enc) + 2;
610		if ($length > 110) {
611		$length = 110;
612		}
613		if ($length > 20) {
614		$size_op = qq( size="$length");
615		if ($length > 50) {
616		$size_op = qq( size="50");
617		}
618		} else {
619		$size_op = '';
620		}
621		if ($enc =~ /#[a-fA-F\d]/) {
622		$tx_col = &text_color($enc);
623		$ime_op = qq( style="ime-mode:inactive;background-color:$enc;color:$tx_col");
624
625		} else {
626		$ime_op = qq( style="ime-mode:inactive");
627		}
628		$popup["$_"] =~ s/\n/<br>/g;
629		if ($popup["$_"]) {
630		$exp = $popup["$_"];
631		} else {
632		$exp = " ";
633		}
634		if ($size_op) {
635		print qq(<tr><td align="right" valign="top">\$$_ = </td><td colspan="2"><input type="text" name="$_" value="$enc"$size_op$ime_op><br>$exp</td></tr>\n);
636		} else {
637		print qq(<tr><td align="right">\$$_ = </td><td><input type="text" name="$_" value="$enc"$size_op$ime_op></td><td>$exp</td></tr>\n);
638		}
639		}
640		print qq(</table>\n);
641		print qq(</form>\n);
642		print qq(</td>\n<td valign="top">\n);
643		#-----------カテゴリー色------------
644		print qq(<form action="$script" method="post">\n);
645		print qq(<input type="hidden" name="mode" value="config">);
646		print qq(<input type="hidden" name="config" value="category_color">);
647		print qq(<input type="hidden" name="modify" value="do">);
648		print qq(<input type="hidden" name="pass" value="$in['pass']">\n);
649		print qq(<table>\n);
650		print qq(<tr><td colspan="2"><input type="submit" value="カテゴリー編集"></td></tr>\n);
651		print qq(<tr><td>カテゴリー</td><td>色</td></tr>\n);
652		print qq(<tr style="background-color:$memo_col;"><td>なし</td><td><input type="text" name="memo_col" value="$memo_col" size="8" style="background-color:$memo_col;"></td></tr>\n);
653		$count = 0;
654		foreach (@category) {
655		my $txt_col = &text_color($cat_col["$_"]);
656		print qq(<tr style="background-color:$cat_col["$_"];"><td><input type="text" name="cat$count" value="$_" style="background-color:$cat_col["$_"];color:$txt_col"></td>);
657		print qq(<td><input type="text" name="col$count" value="$cat_col["$_"]" size="8" style="background-color:$cat_col["$_"];color:$txt_col;ime-mode:disabled;"></td></tr>\n);
658		$count++;
659		}
660		print qq(<tr><td><input type="text" name="cat$count" value=""></td>);
661		print qq(<td><input type="text" name="col$count" value="" size="8"></td></tr>\n);
662		print qq(<tr><td colspan="2">↑カテゴリーを追加する場合は<br>ここに入力してください</td></tr>\n);
663		print qq(</table></form>\n);
664		#-------------------------
665		print qq(</td></tr></table>);
666		print qq(</div>\n);
667		&footer;
668		exit;
669		}
670
671
672		# スクリプトの設定を復元する
673		sub load_config {
674		# my $ref_config_value = $_[0];
675		# my @config_value = @{ $ref_config_value };
676		my %val;
677		foreach (@config_value) {
678		my ($name,$value) = split(/<>/);
679		chomp $value;
680		if ($name) {
681		my $tmp = '$' . $name . '=\'' . $value . '\';';
682		eval $tmp;
683		$val["$name"] = $value;
684		}
685		}
686		@config_value = ();
687		if (! open(SCR,"./init.cgi")) {
688		&dbg(qq(./init.cgiオープンエラー));
689		return;
690		}
691		my ($chg_com, $config_start, $config_end);
692		my @scr = <SCR>;
693		close(SCR);
694		my @new_scr = ();
695		foreach my $line (@scr) {
696		# if ($line =~ /^# config_start/) { $config_start = 1; }
697		# if ($line =~ /^# config_end/) { $config_end = 1; }
698		# if ($config_end \|\| ! $config_start) {
699		# push(@new_scr, $line);
700		# next;
701		# }
702		foreach my $cfg ('pass',@config) {
703		if ($cfg && exists $val["$cfg"] && $line =~ /^\s\$$cfg\s=\s*/) {
704		my ($value,$val);
705		if ($val["$cfg"] =~ /^\d+$/) {
706		$value = $val["$cfg"];
707		} else {
708		$val = $val["$cfg"];
709		$val =~ s/</</g;
710		$val =~ s/>/>/g;
711		$val =~ s/"/"/g;
712		$val =~ s/\\$//;
713		$value = "'" . $val . "'";
714		}
715		my($frm,$com);
716		$frm = $line;
717		$frm =~ s/;([^;]*$)//;
718		$com = $1;
719		my($var,$oval) = split(/=/,$frm);
720		$oval =~ s/\s//;
721		$oval =~ s/^['"]//;
722		$oval =~ s/['"]$//;
723		if ($oval ne $val["$cfg"]) {
724		$chg_com .= qq(${frm} → ) . '$' . $cfg . " = " . $value . qq(\n);
725		}
726		chomp $com;
727		$line = '$' . $cfg . " = " . $value . ";" . $com . "\n";
728		push(@config_value,qq($cfg<>) . $val["$cfg"] . qq(\n));
729		last;
730		}
731		}
732		push(@new_scr, $line);
733		}
734		open(NEW,">init.cgi") \|\| &error("init.cgiが開けません。");
735		print NEW @new_scr;
736		close(NEW);
737
738		# open(CFG,">$config_file") \|\| &error("${config_file}が開けません。");
739		# print CFG @config_value;
740		# close(CFG);
741
742		my $message = "設定を復元しました";
743		my $jump = qq($script?comment=) . &url_encode($message);
744		&redirect($jump);
745		exit;
746		}
747
748
749		sub del_file {
750		my $file = &url_encode($in['file']);
751		$file =~ s/%2e/\./g;
752		my $del_file = $data_dir . $in['date'] . '/' . $file;
753		if ($in['del_file'] eq 'do') {
754		if ($permission) {
755		if (&decrypt($in['pass'], $pass) eq 'no') {
756		&error("パスワードが違います");
757		}
758		}
759		if (unlink $del_file) {
760		if ($action) {
761		$jump = qq($script);
762		} else {
763		$comment = qq($in['file']を削除しました);
764		$comment = &url_encode($comment);
765		$jump = qq($script?mode=write&date=$in['date']&comment=$comment);
766		}
767		&redirect($jump);
768		} else {
769		&error("$del_fileを削除できませんでした。");
770		}
771		}
772		$title .= '－削除－';
773		&header;
774		print qq(<div style="margin:1em">\n);
775		$in['file'] =~ /.\.(.)/;
776		$tail = lc $1;
777		if ($tail eq 'jpg' \|\| $tail eq 'gif' \|\| $tail eq 'png') {
778
779		# 画像サイズ取得
780		if ($tail eq "jpg") { ($w, $h) = &j_size($del_file); }
781		elsif ($tail eq "gif") { ($w, $h) = &g_size($del_file); }
782		elsif ($tail eq "png") { ($w, $h) = &p_size($del_file); }
783		($w,$h) = &small_size($w,$h);
784		if ($w && $h) {
785		$wh = qq( width="$w" height="$h");
786		} else {
787		$wh = '';
788		}
789		$del_file =~ s/%/%25/g;
790		print qq(<img src="$del_file"$wh><div style="margin:0.5em">このファイルを削除しますか？);
791		} else {
792		print qq(<img src="./clip.gif">$in['file']を削除しますか？);
793		}
794		if ($permission) {
795		if ($pass_cookie) {
796		($cpass) = &get_cookie;
797		}
798		$pass_com = qq(パスワード <input type="password" name="pass" value="$cpass"><br>\n);
799		}
800		print <<"EOF";
801		<form action="$script" method="post" style="margin:0">
802		<input type="hidden" name="mode" value="del_file">
803		<input type="hidden" name="date" value="$in['date']">
804		<input type="hidden" name="file" value="$in['file']">
805		<input type="hidden" name="del_file" value="do">
806		$pass_com
807		<input type="submit" value="削除する"> <input type="submit" value="キャンセル" onclick="history.back(); return false;">
808		</form>
809		EOF
810		print qq(</div>\n);
811		&footer;
812		}
813
814
815
816		# 書き込みする場合
817		sub write {
818		$data_file = $data_dir . '/' . $in['date'] . '.cgi';
819
820		# 書き込み実行した場合
821		if ($in['write'] eq 'do') {
822		if ($permission) {
823		if (&decrypt($in['pass'], $pass) eq 'no') {
824		&error("パスワードが違います");
825		}
826		}
827		if ($in['upfile']) { &upload; }
828		my $lock_file = $lock_dir . $in['date'];
829		&lock($lock_file);
830		$in['memo'] =~ s/<br>/\n/g;
831		$in['memo'] =~ s/<br>/\n/g;
832		open(FILE, ">$data_file");
833		print(FILE $in['category'] . qq(<!-!>) . $in['memo']); # カテゴリーと本文はあまり使いそうもない文字<!-!>で区切っておく
834		close(FILE);
835
836		# メモの内容がないのに、ファイルだけある場合(メモを削除した場合など)はファイルを削除
837		if (!$in['memo'] && -e $data_file) {
838		unlink $data_file;
839		}
840
841		# Agendaと連携する場合
842		if ($coop_agenda) {
843		my $agen_file = join('/',$agenda_dir, $in['date'] . '.dat');
844		if ($in['memo']) {
845		my $str = $in['memo'];
846		&jcode::convert(\$str, "sjis");
847		open(NEW,">$agen_file") \|\| &error("$agen_fileが開けません。");
848		print NEW $str;
849		close(NEW);
850		}
851		if (!$in['memo'] && -e $agen_file) {
852		unlink $agen_file;
853		}
854		}
855		&unlock($lock_file);
856		if ($action) {
857		$jump = qq($script);
858		} else {
859		$comment = qq(編集しました);
860		$comment = &url_encode($comment);
861		$jump = qq($script?mode=write&date=$in['date']&comment=$comment);
862		}
863		&redirect($jump);
864		}
865		if (-e $data_file) {
866		$modify_time = (stat($data_file))[9];
867		if (!open(IN,$data_file)) { &error('データベース読取エラー','復旧をお待ちください.'); }
868		@memo = <IN>;
869		close(IN);
870		} else {
871		@memo = '';
872		}
873		$memo = '';
874		foreach (@memo) {
875		$memo .= $_;
876		}
877		($category,$memo) = split(/<!-!>/,$memo,2);
878		if (!$memo) {
879		$memo = $category;
880		$category = '';
881		}
882		&header;
883		&write_form;
884		&footer;
885		}
886
887
888		# フォームを表示する
889		sub write_form {
890		$memo =~ s/<br>/\n/g;
891		$yy = substr($in['date'], 0,4);
892		$mm = substr($in['date'], 4,2);
893		$dd = substr($in['date'], 6,2);
894		$week = &holiday::get_week($yy, $mm, $dd);
895		$holiday = &holiday::holiday($yy, $mm, $dd);
896		$holiday = '' if (!$holiday);
897		$holiday = qq\|<span style="color:$holCol;">\| . $holiday . qq\|</span>\| if ($holiday);
898		if (!$holiday) {
899		$w_w = $week;
900		} else {
901		$w_w = 7;
902		}
903		$week_com = qq\|<span style="color:$col[$w_w];">\| . $week_list[$week] . qq\|</span>\|;
904		print qq(<div style="padding:1em">\n);
905		my %param = ('type'=>'month','year'=>$yy,'month'=>$mm,'before_year'=>$in['before_year'],'show_year'=>$in['show_year']);
906		print qq(<a href="$script) . &url_param(%param) . qq(">$yy年$mm月</a>$dd日($week_com) $holiday のメモ );
907		$param['type'] = $in['type'];
908		$param['year'] = $in['year'];
909		$param['month'] = $in['month'];
910		print qq( <a href="$script) . &url_param(%param) . qq(">予定表に戻る</a>);
911		print qq(<form action="$script" method="post" enctype="multipart/form-data" style="margin:1em 0 0 0;">\n);
912		print qq(<input type="hidden" name="mode" value="write">\n);
913		print qq(<input type="hidden" name="write" value="do">\n);
914		print qq(<input type="hidden" name="date" value="$in['date']">\n);
915		print qq(<input type="hidden" name="type" value="$in['type']">\n);
916		print qq(<input type="hidden" name="year" value="$in['year']">\n);
917		print qq(<input type="hidden" name="month" value="$in['month']">\n);
918		print qq(<table>\n);
919		print qq(<tr><td>\n);
920		print qq(カテゴリー <select name="category" size="1">\n);
921		if ($category) {
922		print qq(<option value="">なし</option>);
923		} else {
924		print qq(<option value="" selected>なし</option>);
925		}
926		foreach (@category) {
927		if ($category eq $_) {
928		print qq(<option value="$_" selected>$_</option>);
929		} else {
930		print qq(<option value="$_">$_</option>);
931		}
932		}
933		print qq(</select>\n);
934		my ($sec, $min, $hour, $mday, $month, $year) = localtime($modify_time);
935		$year += 1900;
936		$month++;
937		if ($modify_time) {
938		print qq(<span style="font-size:80%">$year年$month月$mday日$hour:$min 更新</span>\n);
939		}
940		print qq(</td></tr>\n);
941		print qq(<tr><td>\n);
942		print qq(<textarea name="memo" rows="20" cols="100">$memo</textarea>\n);
943		print qq(</td></tr>\n);
944		if ($upload) {
945		print qq(<tr><td>\n);
946		print qq(ファイル添付 <input type="file" name="upfile" size="40"><br>\n);
947		print qq(</td></tr>\n);
948		}
949		if ($permission) {
950		if ($pass_cookie) {
951		($cpass) = &get_cookie;
952		}
953		print qq(<tr><td>\n);
954		print qq(パスワード <input type="password" name="pass" value="$cpass"><br>\n);
955		print qq(</td></tr>\n);
956		}
957		print qq(<tr><td>\n);
958		print qq(<input type="submit" value="送信する"><input type="reset" value="リセット">\n);
959		print qq(</td></tr>\n);
960		print qq(</table>\n);
961		print qq(</form>\n);
962		print qq(</div>\n);
963		# $memo =~ s/</</g if !$permission; # 現在は不要
964		$memo =~ s/\n/<br>/g;
965		if ($in['comment']) {
966		print qq(<div style="margin:0 1em 0 1em;color:red">$in['comment']</div>\n);
967		}
968		print qq(<div style="background-color:$memo_back_col;padding:0.5em 1em 0.5em 1em;margin-bottom:0.5em;">);
969
970		if ($use_tag && $permission) {
971		# タグを使用する設定で管理者のみ編集の場合だけタグを有効にする
972		$memo =~ s/</</g;
973		$memo =~ s/>/>/g;
974		$memo =~ s/"/"/g;
975		} else {
976		$memo =~ s/</</g;
977		$memo =~ s/>/>/g;
978		$memo =~ s/<br>/<br>/g;
979		$memo =~ s/"/"/g;
980		}
981		print $memo;
982		$attach_dir = $data_dir . $in['date'];
983		if (-e $attach_dir) {
984		opendir(DIR,"$attach_dir");
985		while (my $file = readdir(DIR)) {
986		next if $file eq '.' \|\| $file eq '..';
987		my $link = join('/',$attach_dir,$file);
988		$file =~ /.\.(.)/;
989		$tail = lc $1;
990		my ($d,$d,$d,$d,$d,$d,$d,$fsize,$d,$mtime) = stat($link);
991		$mtime["$link"] = $mtime;
992		$file["$link"] = $file;
993		if ($fsize < 2000) {
994		$fsize["$link"] = $fsize . 'byte';
995		} elsif ($fsize > 2000) {
996		$fsize["$link"] = sprintf( "%.1f", ($fsize / 1024)) . 'KB';
997		}
998		if ($tail eq 'jpg' \|\| $tail eq 'gif' \|\| $tail eq 'png') {
999
1000		# 画像サイズ取得
1001		if ($tail eq "jpg") { ($w, $h) = &j_size($link); }
1002		elsif ($tail eq "gif") { ($w, $h) = &g_size($link); }
1003		elsif ($tail eq "png") { ($w, $h) = &p_size($link); }
1004		($w,$h) = &small_size($w,$h);
1005		if ($w && $h) { $wh["$link"] = qq(width="$w" height="$h"); }
1006		else { $wh["$link"] = ""; }
1007		}
1008		}
1009		closedir(DIR);
1010		foreach $key (sort { $mtime[$b] <=> $mtime[$a] } keys %mtime) {
1011		my $tmp = $key;
1012		$tmp =~ s/%/%25/g;
1013		my $decode_name = &url_decode($file["$key"]);
1014		if ($wh["$key"]) {
1015		print qq(<div style="margin:0.5em"><a href="$tmp"><img src="$tmp" $wh["$key"] border="0" alt="decode_name" title="$decode_name\n$fsize["$key"]"></a>  <a href="$script?mode=del_file&date=$in['date']&file=$file["$key"]">削除</a></div>);
1016		} else {
1017		print qq(<div style="margin:0.5em"><a href="$tmp" title="$decode_name\n$fsize["$key"]"><img src="./clip.gif" border="0" alt="$decode_name">$decode_name</a>  <a href="$script?mode=del_file&date=$in['date']&file=$file["$key"]">削除</a></div>);
1018		}
1019		}
1020		}
1021		print qq(</div>\n);
1022		}
1023
1024		sub small_size {
1025		my ($w,$h,$mw,$mh) = @_;
1026		my $maxw = $MaxW;
1027		my $maxh = $MaxH;
1028		$maxw = $mw if $mw;
1029		$maxh = $mh if $mh;
1030		if ($w > 0 && $w > $maxw) {
1031		my $ratio = $maxw / $w;
1032		$w = $maxw;
1033		$h = int($h * $ratio);
1034		}
1035		if ($h > 0 && $h > $maxh) {
1036		my $ratio = $maxh / $h;
1037		$h = $maxh;
1038		$w = int($w * $ratio);
1039		}
1040		return($w,$h);
1041		}
1042
1043
1044		# 検索する
1045		sub search {
1046		&header;
1047		&search_form;
1048		$cond = $in['cond'];
1049		$key = $in['keyword'];
1050		$key =~ s/　/ /g;
1051		$key =~ s/\t/ /g;
1052		@key_list = split(/ /,$key);
1053		@hit_list = ();
1054		print qq(<div style="padding:1em">);
1055		my %param = ('before_year'=>$in['before_year'],'show_year'=>$in['show_year'],'type'=>$in['type'],'year'=>$in['year'],'month'=>$in['month']);
1056		print qq(<a href="$script) . &url_param(%param) . qq(">予定表に戻る</a>\n);
1057		$result = qq(<table>\n);
1058		opendir(DIR, $data_dir);
1059		@logfile_list = grep { /\.cgi$/i } readdir(DIR);
1060		closedir(DIR);
1061		@logfile_list = sort {$b <=> $a} @logfile_list;
1062		$total_file = scalar(@logfile_list);
1063		$hit_count = 0;
1064		my $ascii = '[\x00-\x7F]';
1065		my $twoBytes = '[\x8E\xA1-\xFE][\xA1-\xFE]';
1066		my $threeBytes = '\x8F[\xA1-\xFE][\xA1-\xFE]';
1067		foreach $file (@logfile_list) {
1068		$file_path = join('/',$data_dir, $file);
1069		open(FILE,$file_path) \|\| &error("Can't open $file_path");
1070		@cont = <FILE>;
1071		close(FILE);
1072		$cont = '';
1073		foreach (@cont) { $cont .= $_; }
1074		($category,$cont) = split(/<!-!>/,$cont,2);
1075		if (!$cont) {
1076		$cont = $category;
1077		$category = '';
1078		}
1079		$flag = 0;
1080		foreach $key (@key_list){
1081		if ($cont =~ /^(?:$ascii\|$twoBytes\|$threeBytes)*?(?:$key)/) {
1082		$flag = 1;
1083		if ($cond eq 'or') { last; }
1084		} else {
1085		if ($cond eq 'and'){ $flag = 0; last; }
1086		}
1087		}
1088		if ($flag == 1) {
1089		$result .= qq(<tr>);
1090		$yy = substr($file, 0,4);
1091		$mm = substr($file, 4,2);
1092		$dd = substr($file, 6,2);
1093		$week = &holiday::get_week($yy, $mm, $dd);
1094		$holiday = &holiday::holiday($yy, $mm, $dd);
1095		if ($holiday) {
1096		$wk_c = $col[7];
1097		} else {
1098		$wk_c = $col[$week];
1099		}
1100		$result .= qq\|<td nowrap valign="top">$yy年$mm月$dd日(<span style="color:$wk_c">$week_list[$week]</span>)</td>\n\|;
1101		$hit = 0;
1102		@cont = split(/\n/,$cont);
1103		foreach (@cont) {
1104		foreach $key (@key_list){
1105		if (/^(?:$ascii\|$twoBytes\|$threeBytes)*?(?:$key)/) {
1106		$hit_line = $_;
1107		$hit = 1;
1108		last;
1109		}
1110		}
1111		if ($hit) { last; }
1112		}
1113		$catcol = $cat_col["$category"];
1114		if (!$catcol) {
1115		$catcol = $memo_col;
1116		}
1117		$result .= qq(<td><a href="$script?mode=write&date=$yy$mm$dd" target="_blank" style="color:$catcol;text-decoration:none">■</a>) . &keyword_coloring($hit_line, @key_list) . qq(</td>);
1118		$result .= qq(</tr>\n);
1119		$hit_count++;
1120		}
1121		}
1122		if (!$hit_count) {
1123		print qq(<div>該当項目はありません</div>\n);
1124		} else {
1125		print qq(<div style="margin:0.3em;color:red;">) . $hit_count . qq(件ヒット!</div>\n);
1126		}
1127		$result .= qq(</table>\n);
1128		print $result;
1129		print qq(</div>\n);
1130		&footer
1131		}
1132
1133		# 検索フォームを表示
1134		sub search_form {
1135		print qq(<div style="margin:0.5em 1em 0.5em 1em;">\n);
1136		print qq(<table width="100%"><tr><td>);
1137		print qq(<form action="$script" method="post" style="margin:0">\n);
1138		print qq(<input type="hidden" name="mode" value="search">\n);
1139		print qq(<input type="hidden" name="type" value="$in['type']">\n);
1140		print qq(<input type="hidden" name="year" value="$in['year']">\n);
1141		print qq(<input type="hidden" name="month" value="$in['month']">\n);
1142		print qq(<input type="hidden" name="before_year" value="$in['before_year']">\n);
1143		print qq(<input type="hidden" name="show_year" value="$in['show_year']">\n);
1144		print qq( キーワード <input type="text" name="keyword" value="$in['keyword']" size="20">\n);
1145		foreach ('and','or') {
1146		if ($in['cond'] eq $_ \|\| (!$in['cond'] && $_ eq 'and')) {
1147		print qq(<input type="radio" name="cond" value="$_" checked>) . uc($_) . qq( \n);
1148		} else {
1149		print qq(<input type="radio" name="cond" value="$_">) . uc($_) . qq( \n);
1150		}
1151		}
1152		print qq(<input type="submit" value="検索する"><input type="reset" value="リセット">\n);
1153		print qq(</form></td>);
1154		if ($in['comment']) {
1155		print qq(<td><span style="color:red">$in['comment']</span></td>);
1156		}
1157		print qq(<td align="right">\n);
1158		print qq(<form action="$script" method="post" style="margin:0;padding:0">\n);
1159		print qq(<input type="hidden" name="change_show_year" value="1">\n);
1160		print qq(<input type="hidden" name="_pass" value="$in['_pass']">\n);
1161		print qq(<input type="hidden" name="type" value="$in['type']">\n);
1162		my ($bef_mon,$after_mon,$start_year,$end_year);
1163		$start_year = $tyear - $before_year;
1164		$end_year = $tyear + $show_year;
1165		if ($january_top) {
1166		$bef_mon = 1;
1167		$after_mon = 12;
1168		} else {
1169		$bef_mon = $tmon - 1;
1170		if ($bef_mon < 1) {
1171		$bef_mon = 12;
1172		$start_year--;
1173		}
1174		$after_mon = $tmon +10;
1175		if ($after_mon > 12) {
1176		$after_mon -= 12;
1177		$end_year++;
1178		}
1179		}
1180		# print qq(</select>年${bef_mon}月から);
1181		print qq(<input type="text" name="start_year" value="$start_year" size="4" style="ime-mode:disabled;">年${bef_mon}月から);
1182		# print qq(<input type="text" name="before_year" value="$before_year" size="2" style="ime-mode:disabled">年前から );
1183		print qq(<input type="hidden" name="before_year" value="$before_year">\n);
1184		# print qq(<input type="text" name="show_year" value="$show_year" size="2" style="ime-mode:disabled">年先まで表示 );
1185		print qq(<input type="hidden" name="show_year" value="$show_year">\n);
1186		print qq(<input type="text" name="end_year" value="$end_year" size="4" style="ime-mode:disabled;">年${after_mon}月まで);
1187		print qq(<input type="submit" value="送信する"><input type="submit" name="year" value="リセット">\n);
1188		print qq(</form></td>\n);
1189		print qq(<td><a href="$script?mode=config">設定</a></td>);
1190		print qq(</tr></table>);
1191		print qq(</div>\n);
1192		}
1193
1194		sub calen {
1195		local($next_y,$next_m,$back_y,$back_m,$today,
1196		$last,$week,$md,$f,$i,$mkey,$holi,$flag,@col);
1197
1198		$year = $tyear;
1199		$mon = $tmon;
1200		$mday = $tmday;
1201		$today = sprintf("%04d-%s-%s", $year,$mon,$mday);
1202		&search_form;
1203		$sc_st = 0;
1204		$sc_count = 0;
1205		@sc_com = ();
1206		if ($in['type'] eq 'month') {
1207		if (!$in['year']) {
1208		$in['year'] = $year;
1209		}
1210		if (!$in['month']) {
1211		$in['month'] = $mon;
1212		}
1213		$y_stt = $y_end = $year = $in['year'];
1214		$mon = $in['month'];
1215		$m_stt = $mon - 1;
1216		$m_end = $mon + 1;
1217		} else {
1218		$y_stt = $year - $before_year;
1219		$y_end = $year+$show_year;
1220		$m_stt = $mon - 1;
1221		$m_end = $mon + 10;
1222		}
1223		if ($january_top && $in['type'] ne 'month') {
1224		$m_stt = 1;
1225		$m_end = 12;
1226		}
1227		print qq(<div style="margin:0 1em 0 1em;">);
1228		print qq(<a href="$script?type=year">標準モードに戻る</a>) if $in['type'] eq 'month';
1229		# print qq(<a href="$script?before_year=$in['before_year']&show_year=$in['show_year']">標準モードに戻る</a>) if $in['type'] eq 'month';
1230		print qq(<table border="$frame_border" cellpadding="$frame_padding" cellspacing="$frame_spacing" style="margin-top:0.5em">\n);
1231		for ($y = $y_stt; $y <= $y_end; $y++) {
1232		print qq(<tr>\n);
1233		for ($m = $m_stt; $m <= $m_end; $m++) {
1234		if ($in['type'] eq 'month') {
1235		if ($m == $mon) {
1236		$sc_st = 1;
1237		} else {
1238		$sc_st = 0;
1239		}
1240		}
1241		if ($m < 1) {
1242		$mm = $m + 12;
1243		$yy = $y - 1;
1244		} elsif ($m > 12) {
1245		$mm = $m - 12;
1246		$yy = $y + 1;
1247		} else {
1248		$mm = $m;
1249		$yy = $y;
1250		}
1251		if ($tyear == $yy && $tmon == $mm) {
1252		print qq(<td valign="top" style="background-color:$tomon_col">);
1253		} elsif ($m == $mon && $in['type'] eq 'month') {
1254		print qq(<td valign="top" style="background-color:$memo_back_col">);
1255		} else {
1256		print qq(<td valign="top">);
1257		}
1258
1259		# 当月の末日を求める
1260		$last = (31,28,31,30,31,30,31,31,30,31,30,31) [$mm-1]
1261		+ ($mm == 2 && (($yy % 4 == 0 && $yy % 100 != 0) \|\|
1262		$yy % 400 == 0));
1263
1264		# 当月１日の週を求める
1265		$week = &getweek(1, $yy, $mm);
1266		@col = ($sunCol,$norCol,$norCol,$norCol,$norCol,$norCol,$satCol,$holCol);
1267		&create_calen($yy,$mm);
1268		print qq(</td>\n);
1269		}
1270		print qq(</tr>\n);
1271		}
1272		print qq(</table>\n</div>\n);
1273		print qq(<div style="margin:1em 1em 0.5em 1em;background-color:$memo_back_col">);
1274		if ($in['type'] eq 'month') {
1275		if ($view_past) {
1276		$sch_title = qq($year年$mon月のメモ);
1277		} else {
1278		$sch_title = qq($year年$mon月の予定);
1279		}
1280		} else {
1281		if ($view_past) {
1282		$sch_title = qq(過去のメモ$sc_number件);
1283		} else {
1284		$sch_title = qq(これからの予定$sc_number件);
1285		}
1286		}
1287		my $txt_col = &text_color($title_back_col);
1288		print qq(<div style="color:$txt_col; background:$title_back_col;padding:2px;font-weight:bold;">$sch_title</div>\n);
1289		print qq(<div style="margin:0.4em;">\nカテゴリー：<span style="font-size:100%;color:$memo_col;">■</span>なし);
1290		foreach(@category) {
1291		print qq(  <span style="font-size:100%;color:$cat_col["$_"];">■</span>$_);
1292		}
1293		print qq(</div>\n);
1294		print qq(<table cellpadding="2" style="line-heigft:1.2em;">) if @sc_com;
1295		if ($view_past) {
1296		@sc_com = reverse(@sc_com);
1297		@sc_com = @sc_com[0 .. ($sc_number-1)];
1298		}
1299		foreach (@sc_com) {
1300		if ($use_tag && $permission) {
1301		# タグを使用する設定で管理者のみ編集の場合だけタグを有効にする
1302		s/</</g;
1303		s/>/>/g;
1304		s/"/"/g;
1305		}
1306		print $_;
1307		}
1308		print qq(</table>\n) if @sc_com;
1309		print qq(</div>\n);
1310		print qq(<div style="text-align:right;margin-right:1em">\n);
1311		print qq(<form action="$script" method="post">\n);
1312		print qq(<input type="hidden" name="csize_edit" value="1">);
1313		print qq(<input type="hidden" name="type" value="$in['type']">);
1314		print qq(<input type="hidden" name="year" value="$in['year']">);
1315		print qq(<input type="hidden" name="month" value="$in['month']">);
1316		print qq(<table style="margin-left:auto;margin-right:1em"><tr><td><span style="font-size:80%">カレンダーのサイズ調整</span></td></tr>\n);
1317		print qq(<tr><td><span style="font-size:80%">フォントサイズ</span> );
1318		print qq(<input type="submit" name="cfsize" value="＋"> <input type="submit" name="cfsize" value="－"> );
1319		print qq(<span style="font-size:80%">幅</span> <input type="submit" name="ccsize" value="＋"> <input type="submit" name="ccsize" value="－"></td></tr></table>\n</form>\n);
1320		print qq(</div>\n);
1321		}
1322
1323
1324		sub create_calen {
1325		my ($yy,$mm,) = @_;
1326
1327		# 当月の末日を求める
1328		$last = (31,28,31,30,31,30,31,31,30,31,30,31) [$mm-1]
1329		+ ($mm == 2 && (($yy % 4 == 0 && $yy % 100 != 0) \|\|
1330		$yy % 400 == 0));
1331		my $week = &getweek(1, $yy, $mm);
1332		my $txt_col = &text_color($month_back_col);
1333		my %param = ('type'=>'month','year'=>$yy,'month'=>$mm,'before_year'=>$in['before_year'],'show_year'=>$in['show_year']);
1334		my $url = $script . &url_param(%param);
1335		print <<EOM;
1336		<table border="$cal_border" cellpadding="$cal_padding" cellspacing="$cal_spacing" width="100%">
1337		<tr>
1338		<th colspan=7 style="background-color:$month_back_col;padding:0.2em 0 0.2em 0;" class="month"><a href="$url" title="$yy年$mm月の予定を見る" style="color:$txt_col;">$yy年$mm月</a></th>
1339		</tr>
1340		<tr>
1341		EOM
1342
1343		# 週を記述
1344		foreach $i (0 .. 6) {
1345		print "<td align=center style=\"color:$col[$i]; font-size:$cal_fsize;\" width=\"$cal_cwidth\">$week_list[$i]</td>\n";
1346		}
1347		print "</tr>\n<tr>";
1348
1349		# 月初のブランクを記述
1350		foreach $i (0 .. 6) {
1351		last if ($i == $week);
1352		print "<td> </td>\n";
1353		}
1354
1355		# 日テーブルをループする
1356		$flag=0;
1357		$mkey=0;
1358		foreach $i (1 .. $last) {
1359
1360		# 週を認識
1361		if ($week > 0 && $week % 7 == 0) {
1362		print "</tr>\n<tr>";
1363		$week=0;
1364		}
1365
1366		# 第何月曜日か
1367		if ($week == 1) { $mkey++; }
1368		$md = sprintf("%02d%02d", $mm,$i);
1369		$w = &holiday::get_week($yy, $mm, $i);
1370		if ($today eq "$yy-$mm-$i") {
1371		$today_border = qq(border-style:solid;border-color:red; border-width:1px);
1372		$sc_st = 1;
1373		} else {
1374		$today_border = '';
1375		}
1376		$holiday = &holiday::holiday($yy, $mm, $i);
1377		$date = sprintf("%04d%02d%02d",$yy, $mm, $i);
1378
1379		# メモ有りの場合
1380		$data_file = join('/',$data_dir, "${date}.cgi");
1381		if (-e $data_file) {
1382		if (!open(IN,$data_file)) { &error('データベース読取エラー','復旧をお待ちください.'); }
1383		@memo = <IN>;
1384		close(IN);
1385		$memo = '';
1386		my $count = 0;
1387		foreach (@memo) {
1388		if ($count > $max_line) {
1389		last;
1390		}
1391		$memo .= $_;
1392		$count++;
1393		}
1394		($category,$memo) = split(/<!-!>/,$memo,2);
1395		$catcol = $cat_col["$category"];
1396		if (!$memo) {
1397		$memo = $category;
1398		$category = '';
1399		}
1400		if (!$catcol) {
1401		$catcol = $memo_col;
1402		}
1403		$new_time = (stat $data_file)[10];
1404		$up_time = (stat $data_file)[9];
1405		if ($new_time < $up_time && $up_time + $new_memo * 24 * 3600> time) {
1406		$show_new = qq(<span style="color:red;font-size:90%;">up!</span> );
1407		} elsif ($new_time + $new_memo * 24 * 3600> time) {
1408		$show_new = qq(<span style="color:red;font-size:90%;">new!</span> );
1409		} else {
1410		$show_new = ' ';
1411		}
1412		$memo_flag = 0;
1413		if ($memo && !$view_past) {
1414		if ($in['type'] eq 'month') {
1415		if ($in['year'] == $yy && $in['month'] == $mm) {
1416		$memo_flag = 1;
1417		}
1418		} else {
1419		if ($sc_st && $sc_count < $sc_number) {
1420		$memo_flag = 1;
1421		}
1422		}
1423		}
1424		if ($memo && $view_past) {
1425		if ($in['type'] eq 'month') {
1426		if ($in['year'] == $yy && $in['month'] == $mm) {
1427		$memo_flag = 1;
1428		}
1429
1430		} else {
1431		if (!$sc_st \|\| $today_border) {
1432		$memo_flag = 1;
1433		}
1434		}
1435		}
1436		if ($memo_flag) {
1437		if ($holiday) {
1438		$wk_c = $col[7];
1439		} else {
1440		$wk_c = $col[$w];
1441		}
1442		$br_memo = $memo;
1443		$br_memo =~ s/</</g if !$permission;
1444		$br_memo =~ s/\n/<br>/g;
1445		$sc_date = sprintf("%02d月%02d日", $mm, $i);
1446		my %param = ('mode'=>'write','date'=>$date,'before_year'=>$in['before_year'],'show_year'=>$in['show_year']);
1447		$url = $script . &url_param(%param);
1448		if ($in['type']) {
1449		$param['type'] = $in['type'];
1450		$param['year'] = $in['year'];
1451		$param['month'] = $in['month'];
1452		$url = $script . &url_param(%param);
1453		}
1454		$sc = qq(<tr><td valign="top" align="right" nowrap>$show_new
1455		) . $sc_date . qq\|(<span style="color:$wk_c">\| . $week_list[$w] . qq\|</span>)</td>\n
1456		<td valign="top"><a href="$url" style="text-decoration:none;"><span style="font-size:120%;color:$catcol;">■</span></a></td><td>\|;
1457		my $tmp = $data_dir . '/' . $date;
1458		if (-d $tmp) {
1459		opendir(DIR,"$tmp");
1460		while (my $file=readdir(DIR)) {
1461		next if $file eq '.' \|\| $file eq '..';
1462		$file !~ /.\.(.)/;
1463		$tail = lc $1;
1464		my $path = join('/',$tmp,$file);
1465		$path =~ s/%/%25/g;
1466		my $decode_name = &url_decode($file);
1467		if ($tail eq 'jpg' \|\| $tail eq 'gif' \|\| $tail eq 'png') {
1468		$sc .= qq(<a href="$path"><img src="./img.gif" alt="$decode_name" title="$decode_name" border="0"></a> );
1469		} else {
1470		$sc .= qq(<a href="$path"><img src="./clip.gif" alt="$decode_name" title="$decode_name" border="0"></a> );
1471		}
1472		}
1473		closedir(DIR);
1474		}
1475		$sc .= $br_memo . qq(</td>\n</tr>\n);
1476		push(@sc_com,$sc);
1477		$sc_count++;
1478		}
1479		} else {
1480		$memo = '';
1481		}
1482		my %param = ('mode'=>'write','date'=>$date,'before_year'=>$in['before_year'],'show_year'=>$in['show_year']);
1483		my $url = $script . &url_param(%param);
1484		if ($in['type']) {
1485		$param['type'] = $in['type'];
1486		$param['year'] = $in['year'];
1487		$param['month'] = $in['month'];
1488		$url = $script . &url_param(%param);
1489		}
1490		if ($memo) {
1491		$memo =~ s/<br>/\n/g;
1492		$memo =~ s/<.*?>//g;
1493		$memo =~ s/&/&/g;
1494		$memo =~ s/</</g;
1495		$memo =~ s/>/>/g;
1496		$memo =~ s/"/"/g;
1497		$day_col = $col[$w];
1498		if (!$day_col) {$day_col = '#000000';}
1499		if ($holiday) {
1500		$memo = qq(--) . $holiday . qq(--\n) . $memo;
1501		$day_col = $col[7];
1502		}
1503		if ($cat_col["$category"] ne '') {
1504		$bgc = $cat_col["$category"];
1505		} else {
1506		$bgc = $memo_col;
1507		}
1508		my $txt_col = &text_color($bgc);
1509		print qq(<td align=right class="cal" style="background-color:$bgc;color:$txt_col;$today_border">\n);
1510		print qq(<a href="$url" style="color:$day_col;text-decoration:none;" title="$memo">$i</a>);
1511		} else {
1512		if (!$holiday) {
1513		if ($col[$w]) {
1514		print qq(<td align=right class=cal style="$today_border"><a href="$url" style="color:$col[$w];text-decoration:none;">$i</a>);
1515		} else {
1516		print qq(<td align=right class=cal style="$today_border"><a href="$url" style="color:#000000;text-decoration:none;">$i</a>);
1517		}
1518		} else {
1519		print qq(<td align=right class=cal style="$today_border"><strong><a href="$url" title="--$holiday--" style="color:$holCol;text-decoration:none;">$i</a></strong>);
1520		}
1521		}
1522		print "</td>\n";
1523		$week++;
1524		}
1525
1526		# 月末のブランクを記述
1527		while ( $week < 7 ) {
1528		print "<td> </td>\n";
1529		$week++;
1530		}
1531		print qq(</tr></table>\n);
1532		}
1533
1534
1535		#-------------------------------------------------
1536		# パスワード暗号処理
1537		#-------------------------------------------------
1538		sub encrypt_old {
1539		local($inpw) = $_[0];
1540		local(@SALT, $salt, $encrypt);
1541
1542		@SALT = ('a'..'z', 'A'..'Z', '0'..'9', '.', '/');
1543		srand;
1544		$salt = $SALT[int(rand(@SALT))] . $SALT[int(rand(@SALT))];
1545		$encrypt = crypt($inpw, $salt) \|\| crypt ($inpw, '$1$' . $salt);
1546		$encrypt;
1547		}
1548
1549		sub encrypt {
1550		my($inpw) = $_[0];
1551		my $encrypt;
1552		if ($code == 2) {
1553		use Digest::MD5 qw/md5_hex/;
1554		my @str = ('a' .. 'f', 0 .. 9);
1555		my $salt;
1556		for (1 .. 8) {
1557		$salt .= $str[int(rand(@str))];
1558		}
1559		$encrypt = $salt . md5_hex($salt . $inpw);
1560		} else {
1561		my(@SALT, $salt);
1562		@SALT = ('a'..'z', 'A'..'Z', '0'..'9');
1563		srand(int(rand(100000)));
1564		$salt = $SALT[int(rand(@SALT))] . $SALT[int(rand(@SALT))];
1565		$encrypt = crypt($inpw, $salt) \|\| crypt ($inpw, '$1$' . $salt);
1566		if (length($inpw) > 8) {
1567		my $inpw2 = substr($inpw,8,8);
1568		srand(int(rand(100000)));
1569		my $salt2 = $SALT[int(rand(@SALT))] . $SALT[int(rand(@SALT))];
1570		my $encrypt2 = crypt($inpw2, $salt2) \|\| crypt ($inpw2, '$1$' . $salt2);
1571		$encrypt .= $encrypt2;
1572		}
1573		}
1574		$encrypt;
1575		}
1576
1577		#-------------------------------------------------
1578		# パスワード照合処理
1579		#-------------------------------------------------
1580		sub decrypt_old {
1581		local($inpw, $logpw) = @_;
1582		local($salt, $check);
1583
1584		$salt = $logpw =~ /^\$1\$(.*)\$/ && $1 \|\| substr($logpw, 0, 2);
1585		$check = "no";
1586		if (crypt($inpw, $salt) eq $logpw \|\| crypt($inpw, '$1$' . $salt) eq $logpw)
1587		{ $check = "yes"; }
1588		$check;
1589		}
1590
1591
1592		sub decrypt {
1593		my($inpw, $logpw) = @_;
1594		my($salt, $check);
1595		if (length($logpw) == 40) {
1596		# saltは先頭の8文字を抜き出す
1597		my $salt = substr($logpw, 0, 8);
1598		$check = "no";
1599		# 照合
1600		if ($logpw eq ($salt . md5_hex($salt . $inpw))) {
1601		$check = "yes";
1602		}
1603		} else {
1604		my $logpw1 = substr($logpw,0,13);
1605		my $inpw1 = substr($logpw,0,8);
1606		$salt = $logpw1 =~ /^\$1\$(.*)\$/ && $1 \|\| substr($logpw1, 0, 2);
1607		$check = "no";
1608		if (crypt($inpw, $salt) eq $logpw1 \|\| crypt($inpw1, '$1$' . $salt) eq $logpw1) {
1609		$check = "yes";
1610		}
1611		if ($check eq "yes" && length($logpw) == 26) {
1612		my $logpw2 = substr($logpw,13,13);
1613		my $inpw2 = substr($inpw,8,8);
1614		my $salt2 = $logpw2 =~ /^\$1\$(.*)\$/ && $1 \|\| substr($logpw2, 0, 2);
1615		if (crypt($inpw2, $salt2) eq $logpw2 \|\| crypt($inpw2, '$1$' . $salt2) eq $logpw2) {
1616		$check = "yes";
1617		} else {
1618		$check = "no";
1619		}
1620		}
1621		}
1622		$check;
1623		}
1624
1625
1626		#---------------------------------------
1627		# フォームデコード
1628		#---------------------------------------
1629		sub decode {
1630		local($key,$val);
1631		undef(%in);
1632		&ReadParse;
1633		while ( ($key,$val) = each(%in) ) {
1634		next if ($key =~ /^upfile/);
1635
1636		# シフトJISコード変換
1637		&jcode'convert(*val, 'euc');
1638
1639		# エスケープ
1640		$val =~ s/<>/&LT;&GT;/g;
1641		$val =~ s/&/&/g;
1642		$val =~ s/"/"/g;
1643		$val =~ s/</</g;
1644		$val =~ s/>/>/g;
1645		$val =~ s/\r\n/<br>/g;
1646		$val =~ s/\r/<br>/g;
1647		$val =~ s/\n/<br>/g;
1648		$val =~ s/\,/,/g;
1649		$in[$key] = $val;
1650		}
1651		}
1652
1653
1654		sub url_param {
1655		my %param = @_;
1656		my $count = 0;
1657		my $url;
1658		foreach (sort keys %param) {
1659		if ($param["$_"]) {
1660		if (! $count) {
1661		$url .= "?" . $_ . qq(=$param["$_"]);
1662		$count++;
1663		} else {
1664		$url .= "&" . $_ . qq(=$param["$_"]);
1665		}
1666		}
1667		}
1668		return $url;
1669		}
1670
1671
1672		#-------------------------------------------------
1673		# クッキー発行
1674		#-------------------------------------------------
1675		sub set_cookie {
1676		local(@cook) = @_;
1677		local($gmt, $cook, @t, @m, @w);
1678
1679		$cookie_day = 30 if !$cookie_day;
1680		@t = gmtime(time + $cookie_day2460*60);
1681		@m = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
1682		@w = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
1683
1684		# 国際標準時を定義
1685		$gmt = sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT",
1686		$w[$t[6]], $t[3], $m[$t[4]], $t[5]+1900, $t[2], $t[1], $t[0]);
1687
1688		# 保存データをURLエンコード
1689		foreach (@cook) {
1690		s/(\W)/sprintf("%%%02X", unpack("C", $1))/eg;
1691		$cook .= "$_<>";
1692		}
1693
1694		# 格納
1695		print "Set-Cookie: CALENDAR=$cook; expires=$gmt\n";
1696		}
1697
1698		#-------------------------------------------------
1699		# クッキー取得
1700		#-------------------------------------------------
1701		sub get_cookie {
1702		local($key, $val, *cook);
1703
1704		# クッキーを取得
1705		$cook = $ENV['HTTP_COOKIE'];
1706
1707		# 該当IDを取り出す
1708		foreach ( split(/;/, $cook) ) {
1709		($key, $val) = split(/=/);
1710		$key =~ s/\s//g;
1711		$cook[$key] = $val;
1712		}
1713
1714		# データをURLデコードして復元
1715		foreach ( split(/<>/, $cook['CALENDAR']) ) {
1716		s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C", hex($1))/eg;
1717
1718		push(@cook,$_);
1719		}
1720		return (@cook);
1721		}
1722
1723
1724		sub header {
1725		if ($head_flag) {
1726		return;
1727		}
1728		$head_flag = 1;
1729		%color = ('bgcolor'=>'#ffffff','text'=>'black','link'=>'blue','vlink'=>'purple','alink'=>'#cc0000');
1730		foreach $key (keys %color) {
1731		if (!$$key) { $$key = $color[$key]; }
1732		}
1733		print "Content-type: text/html\n\n";
1734		$calFont =~ s/,/,/g;
1735		my $text_color = &text_color($month_back_col);
1736		($bright,$dark) = &bright_dark($month_back_col);
1737		my $mh_back;
1738		if ($text_color eq '#ffffff') {
1739		$mh_back = $dark;
1740		} else {
1741		$mh_back = $bright;
1742		}
1743		print <<"EOM";
1744		<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
1745		<html lang="ja">
1746		<head>
1747		<META HTTP-EQUIV="Content-type" CONTENT="text/html; charset=euc-jp">
1748		<META HTTP-EQUIV="Content-Style-Type" content="text/css">
1749		<title>$title</title>
1750		<style type="text/css">
1751		<!--
1752		body {
1753		margin-left:0px;
1754		margin-right:0px;
1755		margin-top:0px;
1756		margin-bottom:0px;
1757		}
1758		table {
1759		font-size:90%;
1760		}
1761		a:link { color:$link_col }
1762		a:visited { color:$visited_col }
1763		a:hover {
1764		background:$hover_background_col;
1765		color:$hover_col;
1766		}
1767		a:active { color:$active_col }
1768
1769		.cal {
1770		font-size:$cal_fsize;
1771		font-family:$calFont;
1772		}
1773
1774		.month a {
1775		font-size:110%;
1776		color:$text_color;
1777		text-decoration:none;
1778		}
1779
1780		.month a:hover {
1781		background:$mh_back;
1782		font-size:110%;
1783		color:$text_color;
1784		text-decoration:none;
1785		}
1786
1787		-->
1788		</style>
1789		</head>
1790		<body bgcolor="$bgcolor" text="$text_col" link="$link" vlink="$vlink" alink="$alink">
1791		EOM
1792		&headline;
1793		}
1794
1795
1796		sub headline {
1797		if ($_[0]) {
1798		$title = $_[0];
1799		}
1800		my $txt_col = &text_color($title_back_col);
1801		print <<"EOM";
1802		<div style="text-align:center;background-color:$title_back_col;color:$txt_col;padding:0.2em 0.2em 0.2em 0.2em;font-size:$title_font_size;font-weight:bold;margin-bottom:0em">$title</div>
1803		EOM
1804		}
1805
1806
1807		sub footer {
1808		if ($dbg_mode) {
1809		foreach (keys %in) {
1810		print qq(\$in["$_"]=$in["$_"]<br>\n) if $in["$_"];
1811		}
1812		}
1813		print qq(<div style="text-align:right;padding:1em">$title <a href="$script?mode=history" title="更新履歴">ver.$ver</a> © <a href="http://shade-search.com/sts/fsw/" target="_blank">hirayama</a></div>);
1814		print "</body></html>\n";
1815		}
1816
1817
1818
1819		sub lock {
1820		$lockfile = $_[0] if $_[0];
1821		if (!-e $lock_dir) { mkdir $lock_dir; }
1822		# 古いロックは削除する
1823		if (-e $lockfile) {
1824		local($mtime) = (stat($lockfile))[9];
1825		if ($mtime < time - 30) { &unlock; }
1826		}
1827		local($retry) = 5;
1828		# symlink関数式ロック
1829		if ($lockkey == 1) {
1830		while (!symlink(".", $lockfile)) {
1831		if (--$retry <= 0) { &error('LOCK is BUSY'); }
1832		sleep(1);
1833		}
1834		# mkdir関数式ロック
1835		} elsif ($lockkey == 2) {
1836		while (!mkdir($lockfile, 0755)) {
1837		if (--$retry <= 0) { &error('LOCK is BUSY'); }
1838		sleep(1);
1839		}
1840		}
1841		$lockflag=1;
1842		}
1843
1844
1845		sub unlock {
1846		$lockfile = $_[0] if $_[0];
1847		if ($lockkey == 1) { unlink($lockfile); }
1848		elsif ($lockkey == 2) { rmdir($lockfile); }
1849
1850		$lockflag=0;
1851		}
1852
1853		sub error {
1854		if ($lockflag) { &unlock; }
1855		&header;
1856		print qq(<div style="margin:1em">\n);
1857		print "<h1>$_[0]</h1>\n";
1858		print "<h3>$_[1]</h3><p>\n";
1859		print "ブラウザの[戻る]ボタンを押して前の画面に移動してください.<p>\n";
1860		print qq(</div>\n);
1861		&footer;
1862		exit;
1863		}
1864
1865
1866
1867		#-------------------------------------------------
1868		# ツェラーの公式
1869		#-------------------------------------------------
1870		sub getweek {
1871		local($day,$year,$month) = @_;
1872		# $year = 年; # 4桁
1873		# $month = 月; # 1-12 → 1月は1
1874
1875		if ($month == 1 \|\| $month == 2) {
1876		$year--;
1877		$month += 12;
1878		}
1879		int ($year + int ($year/4) - int ($year/100) + int ($year/400) + int ((13*$month+8)/5) + $day) % 7;
1880		}
1881
1882		#---------------------------------------
1883		# 指定したキーワードの色を変える
1884		# &keyword_coloring(文字列,色を変えるキーワード)
1885		#---------------------------------------
1886		sub keyword_coloring {
1887		$key_tex_col = '#dd3000';
1888		$key_bg_col = '#F0F0D0';
1889		my $ascii = '[\x00-\x7F]';
1890		my $twoBytes = '[\x8E\xA1-\xFE][\xA1-\xFE]';
1891		my $threeBytes = '\x8F[\xA1-\xFE][\xA1-\xFE]';
1892		my ($string, @keys) = @_;
1893		$string .= "\r";
1894		foreach $key (@keys) {
1895		if (length $key > 1) {
1896		$new_split = qq(<span style="color:$key_tex_col;background-color:$key_bg_col">) . $key . qq(</span>);
1897		$string =~ s/\G((?:$ascii\|$twoBytes\|$threeBytes)*?)(?:$key)/$1$new_split/g;
1898		}
1899		}
1900		chomp $string;
1901		return $string;
1902		}
1903
1904		sub url_encode {
1905		$encoded = $_[0];
1906		$encoded =~ s/([^\w ])/'%' . unpack('H2', $1)/eg;
1907		$encoded =~ tr/ /+/;
1908		return $encoded;
1909		}
1910
1911		sub url_decode {
1912		$value = $_[0];
1913		$value =~ tr/+/ /;
1914		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
1915		return $value;
1916		}
1917
1918		sub text_color {
1919		$base_color = $_[0];
1920		if ($_[0] !~ /#[a-zA-Z0-9]{6}/) {
1921		return '#000000';
1922		}
1923		$base_color =~ s/#//;
1924		$r = substr($base_color,0,2);
1925		$g = substr($base_color,2,2);
1926		$b = substr($base_color,4,2);
1927		$r_hex = hex($r);
1928		$g_hex = hex($g);
1929		$b_hex = hex($b);
1930		$meido = $r_hex * 0.299 + $g_hex * 0.587 + $b_hex * 0.114;
1931		if ($meido < 128) {
1932		$txt_color = '#ffffff';
1933		} else {
1934		$txt_color = '#000000';
1935		}
1936		return $txt_color;
1937		}
1938
1939		sub bright_dark {
1940		my $base = $_[0];
1941		if ($base !~ /^#[0-9abcdef]{6}$/i) {
1942		# $base = &color_name($base);
1943		$base = '#aaaaaa' if !$base;
1944		}
1945		my $sa = 48;
1946		$base =~ s/#//;
1947		$r = hex(substr($base,0,2));
1948		$g = hex(substr($base,2,2));
1949		$b = hex(substr($base,4,2));
1950		$r_b = $r + $sa;
1951		if ($r_b > 255) { $r_b = 255; }
1952		$g_b = $g + $sa;
1953		if ($g_b > 255) { $g_b = 255; }
1954		$b_b = $b + $sa;
1955		if ($b_b > 255) { $b_b = 255; }
1956		$r_d = $r - $sa;
1957		if ($r_d < 0) { $r_d = 0; }
1958		$g_d = $g - $sa;
1959		if ($g_d < 0) { $g_d = 0; }
1960		$b_d = $b - $sa;
1961		if ($b_d < 0) { $b_d = 0; }
1962		$r_b = sprintf("%02x",$r_b);
1963		$g_b = sprintf("%02x",$g_b);
1964		$b_b = sprintf("%02x",$b_b);
1965		$r_d = sprintf("%02x",$r_d);
1966		$g_d = sprintf("%02x",$g_d);
1967		$b_d = sprintf("%02x",$b_d);
1968		$bb = '#' . $r_b .$g_b . $b_b;
1969		$dd = '#' . $r_d .$g_d . $b_d;
1970		return($bb,$dd);
1971		}
1972
1973
1974		#---------------------------------------
1975		# 画像アップロード
1976		#---------------------------------------
1977		sub upload {
1978		local($macbin,$fname,$flag,$upfile);
1979
1980		# 画像処理
1981		$macbin=0;
1982		foreach (@in) {
1983		if (/(.)Content-type:(.)/i) { $tail=$2; }
1984		if (/(.)filename=\"(.)\"/i) { $fname=$2; }
1985		if (/application\/x-macbinary/i) { $macbin=1; } #"
1986		}
1987		$tail =~ s/\r//g;
1988		$tail =~ s/\n//g;
1989
1990		# ファイル形式を認識
1991		$flag=0;
1992		if ($tail =~ /image\/gif/i && $gif) { $tail=".gif"; $flag=1; }
1993		if ($tail =~ /image\/p?jpeg/i && $jpeg) { $tail=".jpg"; $flag=1; }
1994		if ($tail =~ /image\/x-png/i && $png) { $tail=".png"; $flag=1; }
1995		if ($tail =~ /text\/plain/i && $text) { $tail=".txt"; $flag=1; }
1996		if ($tail =~ /lha/i && $lha) { $tail=".lzh"; $flag=1; }
1997		if ($tail =~ /zip/i && $zip) { $tail=".zip"; $flag=1; }
1998		if ($tail =~ /pdf/i && $pdf) { $tail=".pdf"; $flag=1; }
1999		if ($tail =~ /audio\/.*mid/i && $midi) { $tail=".mid"; $flag=1; }
2000		if ($tail =~ /msword/i && $word) { $tail=".doc"; $flag=1; }
2001		if ($tail =~ /ms-excel/i && $excel) { $tail=".xls"; $flag=1; }
2002		if ($tail =~ /ms-powerpoint/i && $ppt) { $tail=".ppt"; $flag=1; }
2003		if ($tail =~ /audio\/.*realaudio/i && $ram) { $tail=".ram"; $flag=1; }
2004		if ($tail =~ /application\/.*realmedia/i && $rm) { $tail=".rm"; $flag=1; }
2005		if ($tail =~ /video\/.*mpeg/i && $mpeg) { $tail=".mpg"; $flag=1; }
2006		if ($tail =~ /audio\/.*mpeg/i && $mp3) { $tail=".mp3"; $flag=1; }
2007		if ($tail =~ /shockwave\-flash/i && $swf) { $tail=".swf"; $flag=1; }
2008
2009		if (!$flag) {
2010		if ($fname =~ /\.gif$/i && $gif) { $tail=".gif"; $flag=1; }
2011		if ($fname =~ /\.jpe?g$/i && $jpeg) { $tail=".jpg"; $flag=1; }
2012		if ($fname =~ /\.png$/i && $png) { $tail=".png"; $flag=1; }
2013		if ($fname =~ /\.lzh$/i && $lha) { $tail=".lzh"; $flag=1; }
2014		if ($fname =~ /\.txt$/i && $text) { $tail=".txt"; $flag=1; }
2015		if ($fname =~ /\.zip$/i && $zip) { $tail=".zip"; $flag=1; }
2016		if ($fname =~ /\.pdf$/i && $pdf) { $tail=".pdf"; $flag=1; }
2017		if ($fname =~ /\.mid$/i && $midi) { $tail=".mid"; $flag=1; }
2018		if ($fname =~ /\.doc$/i && $word) { $tail=".doc"; $flag=1; }
2019		if ($fname =~ /\.xls$/i && $excel) { $tail=".xls"; $flag=1; }
2020		if ($fname =~ /\.ppt$/i && $ppt) { $tail=".ppt"; $flag=1; }
2021		if ($fname =~ /\.ram$/i && $ram) { $tail=".ram"; $flag=1; }
2022		if ($fname =~ /\.rm$/i && $rm) { $tail=".rm"; $flag=1; }
2023		if ($fname =~ /\.mpe?g$/i && $mpeg) { $tail=".mpg"; $flag=1; }
2024		if ($fname =~ /\.mp3$/i && $mp3) { $tail=".mp3"; $flag=1; }
2025		if ($fname =~ /\.swf$/i && $swf) { $tail=".swf"; $flag=1; }
2026		}
2027
2028		# アップロード失敗処理
2029		if (!$flag \|\| !$fname) {
2030		if (!$clip_err) { return; }
2031		else { &error("アップロードできません"); }
2032		}
2033		$upfile = $in['upfile'];
2034
2035		# マックバイナリ対策
2036		if ($macbin) {
2037		$length = substr($upfile,83,4);
2038		$length = unpack("%N",$length);
2039		$upfile = substr($upfile,128,$length);
2040		}
2041
2042		# 添付データを書き込み
2043		$attach_dir = $data_dir . $in['date'];
2044		if (!-d $attach_dir) {
2045		mkdir $attach_dir;
2046		}
2047		opendir(ATT,"$attach_dir");
2048		while ($file = readdir(ATT)) {
2049		next if $file eq '.' \|\| $file eq '..';
2050		if ($file =~ /^(\d+)/) {
2051		$no = $1;
2052		$last_no = $no if $no > $last_no;
2053		}
2054		}
2055		$no = $last_no + 1;
2056		closedir(ATT);
2057		if ($attach_name) {
2058		$imgfile = join('/', $attach_dir, "${no}$tail");
2059		} else {
2060		my @tmp = split(/[\/\\]/,$fname);
2061		my $name = pop @tmp;
2062		my $head = $name;
2063		$head =~ s/\..{1,4}$//;
2064		$name = &url_encode($head) . $tail; # 日本語のファイル名に対応するためアップロードする前にURLエンコードする
2065		# 拡張子前の.もURLエンコードされてしまうので、.より前だけをURLエンコードしたあと拡張子をつける。
2066		$imgfile = join('/', $attach_dir, "$name");
2067		}
2068		if (!open(OUT,"> $imgfile")) {
2069		if ($clip_err) { &error("画像のアップロードに失敗しました\$imgfile=$imgfile"); }
2070		}
2071		binmode(OUT);
2072		binmode(STDOUT);
2073		print OUT $upfile;
2074		close(OUT);
2075		chmod(0666,$imgfile);
2076
2077		# 画像サイズ取得
2078		if ($tail eq ".jpg") { ($W, $H) = &j_size($imgfile); }
2079		elsif ($tail eq ".gif") { ($W, $H) = &g_size($imgfile); }
2080		elsif ($tail eq ".png") { ($W, $H) = &p_size($imgfile); }
2081
2082		# 画像表示縮小
2083		if ($W > $MaxW \|\| $H > $MaxH) {
2084		$W2 = $MaxW / $W;
2085		$H2 = $MaxH / $H;
2086		if ($W2 < $H2) { $key = $W2; }
2087		else { $key = $H2; }
2088		$W = int ($W * $key) \|\| 1;
2089		$H = int ($H * $key) \|\| 1;
2090		}
2091		}
2092
2093		#---------------------------------------
2094		# JPEGサイズ認識
2095		#---------------------------------------
2096		sub j_size {
2097		local($jpeg) = @_;
2098		local($t, $m, $c, $l, $W, $H);
2099
2100		open(JPEG, "$jpeg") \|\| return (0,0);
2101		binmode JPEG;
2102		read(JPEG, $t, 2);
2103		while (1) {
2104		read(JPEG, $t, 4);
2105		($m, $c, $l) = unpack("a a n", $t);
2106
2107		if ($m ne "\xFF") { $W = $H = 0; last; }
2108		elsif ((ord($c) >= 0xC0) && (ord($c) <= 0xC3)) {
2109		read(JPEG, $t, 5);
2110		($H, $W) = unpack("xnn", $t);
2111		last;
2112		} else {
2113		read(JPEG, $t, ($l - 2));
2114		}
2115		}
2116		close(JPEG);
2117		return ($W, $H);
2118		}
2119
2120		#---------------------------------------
2121		# GIFサイズ認識
2122		#---------------------------------------
2123		sub g_size {
2124		local($gif) = @_;
2125		local($data);
2126
2127		open(GIF,"$gif") \|\| return (0,0);
2128		binmode(GIF);
2129		sysread(GIF,$data,10);
2130		close(GIF);
2131
2132		if ($data =~ /^GIF/) { $data = substr($data,-4); }
2133
2134		$W = unpack("v",substr($data,0,2));
2135		$H = unpack("v",substr($data,2,2));
2136		return ($W, $H);
2137		}
2138
2139		#---------------------------------------
2140		# PNGサイズ認識
2141		#---------------------------------------
2142		sub p_size {
2143		local($png) = @_;
2144		local($data);
2145
2146		open(PNG, "$png") \|\| return (0,0);
2147		binmode(PNG);
2148		read(PNG, $data, 24);
2149		close(PNG);
2150
2151		$W = unpack("N", substr($data, 16, 20));
2152		$H = unpack("N", substr($data, 20, 24));
2153		return ($W, $H);
2154		}
2155
2156		#---------------------------------------
2157		# BMPサイズ
2158		#---------------------------------------
2159		sub b_size {
2160		local($png) = @_;
2161		local($data);
2162
2163		open(BMP, "$png") \|\| return (0,0);
2164		binmode(BMP);
2165		seek(BMP, 0, 0);
2166		read(BMP, $buf, 6);
2167		seek(BMP, 12, 1);
2168		read(BMP, $buf, 8);
2169		($W, $H) = unpack("VV", $buf);
2170
2171		return ($W, $H);
2172		}
2173
2174		sub redirect {
2175		if ($ENV[PERLXS] eq "PerlIS") {
2176		print "HTTP/1.0 302 Temporary Redirection\r\n";
2177		print "Content-type: text/html\n";
2178		}
2179		print "Location: $_[0]" ."\n\n";
2180		exit;
2181		}

	上のディレクトリへ
	calendar.cgi
	multiupload.cgi
	subdir


パターン	'/	/'	'//'
置換	'	'	''