@koumoku = ( "site_name", "site_url", "endpoint", "blog_id", "user_id", "blog_pass", "link_cat" ); $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{)?}; 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/
/\n/g; $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; my $dir_name = pop @$all_dir; $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 delete_ftp{ my $delete_dir = shift; if (rmtree($delete_dir)) { $mess = "OK"; } else { $mess = "NG"; } return $mess; } sub error { my ($mes) = @_; print < エラー

ERROR

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

$mes

END exit; } 1;