※機能制限した見本版です。(このディレクトリから移動できません。置換ファイルはphpではなく、txtファイルになります。ファイルや置換パターンを編集しても10分で元に戻ります。)
ファイル一覧を隠す
上のディレクトリへ上のディレクトリへ
ファイルcalendar.cgi
ファイルmultiupload.cgi
サブディレクトリsubdir
 calendar.cgiを選択中
SJIS EUC-JP UTF-8 JIS 
EUC-JPと判定しましたが、文字化けしている場合は手動で選択してください。
--------------------------------------------------------------------------------------------------
■以下の変数名はスカラーや配列で重複して使用されています。変数のタイプが違う場合、別名に変更してください。
一括で変換
変数名スカラー配列ハッシュ 
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/^\s*my\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(パスワード&nbsp;<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/&lt;/</g;
486                     $val =~ s/&gt;/>/g;
487                     $val =~ s/&quot;/"/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=" 修 正 ">&nbsp;変更する部分のみ修正して「修正」ボタンを押してください。</td></tr>\n);
599     print qq(<tr><td colspan="3"><input type="submit" name="change_pass" value="管理者パスワードを変更">&nbsp;新しいパスワード&nbsp;<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/</&lt;/g;
607         $enc =~ s/>/&gt;/g;
608         $enc =~ s/"/&quot;/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 = "&nbsp;";
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/&lt;/</g;
710                     $val =~ s/&gt;/>/g;
711                     $val =~ s/&quot;/"/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&amp;date=$in['date']&amp;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(パスワード&nbsp;<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="削除する">&nbsp;<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/&lt;br&gt;/\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&amp;date=$in['date']&amp;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)&nbsp;$holiday&nbsp;のメモ&nbsp;);
907     $param['type'] = $in['type'];
908     $param['year'] = $in['year'];
909     $param['month'] = $in['month'];
910     print qq(&nbsp;<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(カテゴリー&nbsp;<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&nbsp;更新</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(ファイル添付&nbsp;<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(パスワード&nbsp;<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/</&lt;/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/&lt;/</g;
973         $memo =~ s/&gt;/>/g;
974         $memo =~ s/&quot;/"/g;
975     } else {
976         $memo =~ s/</&lt;/g;
977         $memo =~ s/>/&gt;/g;
978         $memo =~ s/&lt;br&gt;/<br>/g;
979         $memo =~ s/"/&quot;/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>&nbsp;&nbsp;<a href="$script?mode=del_file&amp;date=$in['date']&amp;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>&nbsp;&nbsp;<a href="$script?mode=del_file&amp;date=$in['date']&amp;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(&nbsp;キーワード&nbsp;<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(&nbsp;\n);
1148         } else {
1149             print qq(<input type="radio" name="cond" value="$_">) . uc($_) . qq(&nbsp;\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">年前から&nbsp;);
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">年先まで表示&nbsp;);
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']&amp;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             # 当月1日の週を求める
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(&nbsp;&nbsp;<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/&lt;/</g;
1303             s/&gt;/>/g;
1304             s/&quot;/"/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>&nbsp;);
1318     print qq(<input type="submit" name="cfsize" value="+">&nbsp;<input type="submit" name="cfsize" value="−">&nbsp;);
1319     print qq(<span style="font-size:80%">幅</span>&nbsp;<input type="submit" name="ccsize" value="+">&nbsp;<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>&nbsp;</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>&nbsp;);
1407             } elsif ($new_time + $new_memo * 24 * 3600> time) {
1408                 $show_new = qq(<span style="color:red;font-size:90%;">new!</span>&nbsp;);
1409             } else {
1410                 $show_new = '&nbsp;';
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/</&lt;/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>&nbsp;);
1469                         } else {
1470                             $sc .= qq(<a href="$path"><img src="./clip.gif" alt="$decode_name" title="$decode_name" border="0"></a>&nbsp;);
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/&/&amp;/g;
1494             $memo =~ s/</&lt;/g;
1495             $memo =~ s/>/&gt;/g;
1496             $memo =~ s/"/&quot;/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>&nbsp;</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/&/&amp;/g;
1642         $val =~ s/"/&quot;/g;
1643         $val =~ s/</&lt;/g;
1644         $val =~ s/>/&gt;/g;
1645         $val =~ s/\r\n/<br>/g;
1646         $val =~ s/\r/<br>/g;
1647         $val =~ s/\n/<br>/g;
1648         $val =~ s/\,/&#x2c;/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 .= "&amp;" . $_ . 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_day*24*60*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/&#x2c;/,/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> &copy; <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 }
perlからPHPへの書き換え補助 perl2php.php ver.1.2