$http_URL_regex =
	q{\b(?:https?|shttp)://(?:(?:[-_.!~*'()a-zA-Z0-9;:&=+$,]|%[0-9A-Fa-f} .
	q{][0-9A-Fa-f])*@)?(?:(?:[a-zA-Z0-9](?:[-a-zA-Z0-9]*[a-zA-Z0-9])?\.)} .
	q{*[a-zA-Z](?:[-a-zA-Z0-9]*[a-zA-Z0-9])?\.?|[0-9]+\.[0-9]+\.[0-9]+\.} .
	q{[0-9]+)(?::[0-9]*)?(?:/(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f]} .
	q{[0-9A-Fa-f])*(?:;(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-} .
	q{Fa-f])*)*(?:/(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f} .
	q{])*(?:;(?:[-_.!~*'()a-zA-Z0-9:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*)*)} .
	q{*)?(?:\?(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])} .
	q{*)?(?:#(?:[-_.!~*'()a-zA-Z0-9;/?:@&=+$,]|%[0-9A-Fa-f][0-9A-Fa-f])*} .
	q{)?};

%encode = (
	"s" => "sjis"
	,"e" => "euc"
	,"u" => "utf8"
);

sub getItemName{
	my $file = shift;
	open(ITEM, "<$file") or error("$item_conf_file");
	while(<ITEM>){
		chomp $_;
		push @ItemConf, $_;
	}
	close ITEM;

	return(@ItemConf);

}

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 = <FILE>) {
		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 = <FILE>) {
		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/,<FILE>) ){
			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/&/&amp;/g;
		$value =~ s/</&lt;/g;
		$value =~ s/>/&gt;/g;
		$value =~ s/\x0D\x0A/<br>/g;
		$value =~ tr/\t/ /;

	#	$value =~ s/\\/\\\\/g;

		$value =~ s/"/#double#/g;
		$param{$key} = $value;
	}
	return(%param);
}

sub de_code{
	my $value = shift;

	$value =~ s/&amp;/&/g;
	$value =~ s/&lt;/</g;
	$value =~ s/&gt;/>/g;
	$value =~ s/\x0D\x0A/<br>/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 getItemData{
	my $refArray = shift;
	my $i = 0;
	my $Item;

	foreach(@$refArray){
		open(DATA, "<$conf{ItemListDIR}/$_") or &error("$conf{ItemListDIR}/$_");
			my $n = 0;
			foreach(split(/\t/,<DATA>) ){
				$Item->[$i]->{ $ItemConf[$n] } = $_;
				$n++;
			}
		close DATA;
		$i++;
	}

	open(CHE, ">check.txt");
		print CHE @ItemConf;
	close CHE;

	return $Item;
}

# ひとつの商品のデータを抜き出す
sub aItemData{
	my $file = shift;
	my $Item;

	open(DATA, "<$file") or &error("$file");
		my $n = 0;
		foreach(split(/\t/,<DATA>) ){
			$Item->{ $ItemConf[$n] } = $_;
			$n++;
		}
	close DATA;

	return $Item;
}

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 GoSendMail {
	my ($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($param{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 <<END;
Content-type: text/html; charset=$CHARSET

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN">
<head>
<title>エラー</title>
<meta http-equiv="Content-Type" content="text/html; charset=euc-jp">
<link rel="stylesheet" href="./tmpl/style-bosyu.css" type="text/css">
<meta name="robots" content="noindex,nofollow">
</head>
<body>
<div id="container">
<p style="color:red;">以下のエラー内容をご確認の上、ブラウザの「戻る」ボタンで前の画面へ戻り、再度情報を送信してください</p>

<p>$mes</p>

</body>
</html>
END


  exit;

}

1;