sub lock{ $retry = 5; # リトライ回数セット while (!mkdir($conf{LockDIR}, 0755)) { # 作成。出来なければ待つ if (--$retry <= 0) { &error("BUSY"); } # 5回ダメならあきらめる sleep(1); # 1秒待つ } } sub unlock{ rmdir($conf{LockDIR}); } sub get_conf{ my $file = shift; my ($data, %data); open(FILE, "<$file") or error("設定ファイルが開けません"); while(my $line = ) { chomp $line; if($line =~ /^([^\t]+)\t(.*)/) { $data{$1} = $2; } } close FILE; return (%data); } sub print_conf{ my $data = shift; open(OUT,">$conf_file") or error("設定ファイルが開けません"); while (($key, $value) = each %$data){ print OUT $key . "\t" . $value . "\n"; } close OUT; } sub get_param_conf{ my $file = shift; my @data; my $data; my $data2; my %data; open(FILE, "<$file") or error("設定ファイルが開けません"); while(my $line = ) { chomp $line; if($line =~ /^([^\t]+)\t(.*)\t(.*)/) { if(!$1){ next; } $data{$1} = $3; $data2{$3} = $2; } } close FILE; @data = (\%data,\%data2); return(@data); } sub get_member_data{ my $file = shift; my @data; open(FILE, "<$file") or error("$fileが開けません"); foreach my $line (split(/\t/,) ){ push @data, $line; } close FILE; return(@data); } sub get_param{ @param = @_; foreach $key (@param){ $value = $q->param($key); $value =~ s/%([0-9a-fA-F][0-9a-fA-F])/chr(hex($1))/eg; $value =~ s/&/&/g; $value =~ s//>/g; $value =~ s/\x0D\x0A/
/g; $value =~ tr/\t/ /; # $value =~ s/\\/\\\\/g; $value =~ s/"/#double#/g; $param{$key} = $value; } return(%param); } sub de_code{ my $value = shift; $value =~ s/&/&/g; $value =~ s/<//g; $value =~ s/\x0D\x0A/
/g; $value =~ tr/\t/ /; $value =~ s/#double#/"/g; return($value); } sub sort_dir{ my $all_dir = shift; @alldir = sort {$a <=> $b} @$all_dir; my $dir_name = pop @alldir; $dir_name += 1; return($dir_name); } sub open_dir{ my $dir = shift; my @alldir; opendir DIR,"$dir"; @alldir = grep(!/^\.+/,readdir DIR); close DIR; @alldir = sort {$a <=> $b} @alldir; return(@alldir); } sub getToday { my @ts=localtime(time); my $year = $ts[5]=$ts[5]+1900; my $mon = sprintf("%02.d", $ts[4] + 1); my $mday = sprintf("%02.d", $ts[3]); my $ret = $year."-".$mon."-".$mday; return $ret; } ## 日時取得 ---------------------------------------- sub get_date{ ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time); $year_day = sprintf("%04d%02d%02d", $year + 1900, $mon +1, $mday); $hour_minit = sprintf("%02d%02d", $hour, $min); $date = "$year_day" . "$hour_minit"; return($date); } sub GoSendMail { ($usr_name, $mail_mess, $subject, $ToMailadd, $ad_name, $author_mail) = @_; $ad_name = mimeencode($ad_name); my $SendmailCmnd = '/usr/sbin/sendmail -t'; my $FromMailadd = "$ad_name<$author_mail>"; #======================================================== # # メール送信 # #======================================================== my $mail_subject = mimeencode($subject); my $name = mimeencode($usr_name); &jcode::convert(*mail_mess,'sjis'); &jcode::convert(*mail_mess,'jis'); #　送信メール open(SMTP,"| $SendmailCmnd") or &error("SMTP接続に失敗しました"); print SMTP qq(To: $FromMailadd\n) .qq(From: $ToMailadd\n) .qq(Subject: $mail_subject\n) .qq(Mime-Version: 1.0\n) .qq(Content-Type: text/plain; charset=iso-2022-jp\n) .qq(Content-Transfer-Encoding: 7bit\n\n) .qq($mail_mess); close SMTP; # 自動返信メール送信 open(SMTP,"| $SendmailCmnd") or &error("SMTP接続に失敗しました"); print SMTP qq(To: $ToMailadd\n) .qq(From: $FromMailadd\n) .qq(Subject: $mail_subject\n) .qq(Mime-Version: 1.0\n) .qq(Content-Type: text/plain; charset=iso-2022-jp\n) .qq(Content-Transfer-Encoding: 7bit\n\n) .qq($mail_mess); close SMTP; } sub error { my ($mes) = @_; print < エラー

ERROR

以下のエラー内容をご確認の上、ブラウザの「戻る」ボタンで前の画面へ戻り、再度情報を送信してください

$mes

END exit; } 1;