package stdio;
;###############################################################
;#
;# <stdio.pl> CGI STandarD Input Output - Perl Library.
;#   Version 8.04 (Updated at Nov 1, 2002)
;#   Copyright(C)1998-2002 WEB POWER. All Rights Reserved.
;#   The latest programs are found at <http://www.webpower.jp/>
;#
;#  - 著作権は放棄していませんが、配布・転載・改造は自由です。
;#  - このライブラリの文字コードは、呼出元のCGIの文字コードと
;#    同じ文字コードにしてください。
;#  - 改造物を配布する場合、必ず改造物のファイル名とパッケージ
;#    名を変更して、改造物であることを明記してください。
;#  - 関数のリファレンス等は上記URIを参照してください。
;#  - ライブラリの一切の動作保証はしません。また、運用結果につ
;#    いていかなる責任も負いません。
;#
;###############################################################

;$version  = 'stdio.pl/8.04';     # Version information about 'stdio.pl'.
;$max_byte = 131072;              # Maximum bytes to accept via 'POST' method.
;$sendmail = '/usr/lib/sendmail'; # Path of 'sendmail' program.

;$inet     = 2;                   # AF_INET (Socket connection)
;$stream   = 1;                   # SOCK_STREAM (Socket connection)

srand(time^($$+($$<<15))||time);  # Set 'srand' function.

;# ============================
;# Set/Get Cookie.
;# ============================

sub setCookie #(*cookie_body, $cookie_name, $expires, $path, $domain, $secure, $return_value)
{
  local(*cookie_body, $cookie_name, $expires, $path, $domain, $secure, $return_value) = @_;
  local($cookie);

  $cookie_name = $1 if ($cookie_name eq "" && $ENV{'SCRIPT_NAME'} =~ /([^\\\/]+)$/);
  if (%cookie_body) {
    local(@cookie);
    while(($key, $val) = each %cookie_body) {
      &urlencode(*key);
      &urlencode(*val);
      push @cookie, "$key=$val";
    }
    $cookie = join "&", @cookie;
  } elsif ($cookie_body) {
    $cookie = $cookie_body;
  }
  if ($expires == -1) {
    $expires = '; expires=Mon, 01-Jan-1990 00:00:00 GMT';
  } elsif ($expires =~ /^\d+$/) {
    local(@gmtime) = split / +/, scalar gmtime(time + $expires);
    $expires = "; expires=$gmtime[0], $gmtime[2]-$gmtime[1]-$gmtime[4] $gmtime[3] GMT";
  } elsif ($expires) {
    $expires = "; expires=$expires";
  }
  $domain = "; domain=$domain" if ($domain);
  $path   = "; path=$path" if ($path);
  $secure = "; secure"  if ($secure);

  return "$cookie_name=$cookie$expires$path$domain$secure" if ($return_value && $cookie_name && $cookie);
  print "Set-Cookie: $cookie_name=$cookie$expires$path$domain$secure\n" if ($cookie_name && $cookie);
  return;
}

sub getCookie #(*COOKIE, $cookie_name)
{
  local(*COOKIE, $cookie_name) = @_;
  local(@array);

  $cookie_name = $1 if ($cookie_name eq "" && $ENV{'SCRIPT_NAME'} =~ /([^\\\/]+)$/);
  foreach (split /;/o, $ENV{'HTTP_COOKIE'}) {
    local($key, $val) = split /=/, $_, 2;
    $key =~ tr/ \a\b\f\r\n\t//d;
    if ($key eq $cookie_name) {
      foreach (split /&/, $val) {
        local($key, $val) = split /=/o, $_, 2;
        &urldecode(*key);
        &urldecode(*val);
        $COOKIE{$key} = $val;
        push @array, $key;
      }
      return @array;
    }
  }
  return;
}

;# ============================
;# Session Manage.
;# ============================

sub setSession #($ses_file, *hash, $ses_id, $expires)
{
  local($ses_file, *hash, $ses_id, $expires) = @_;
  local($tmp_file) = $ses_file . ".$$.tmp";
  local($flag) = 0;
  local($data);

  $ses_id = $ENV{'REMOTE_ADDR'} if ($ses_id eq "");
  if (%hash) {
    local(@data);
    while (($key, $val) = each %hash) {
      &urlencode(*key);
      &urlencode(*val);
      push @data, "$key=$val";
    }
    $expires = $expires ? $expires + time : 3600 + time;
    $data = "$ses_id\t$expires\t" . join("\t", @data) . "\n";
  }

  if (!open OUT, ">$tmp_file") {
    return 0;
  }
  if (open IN, $ses_file) {
    while (<IN>) {
      tr/\x0D\x0A//d;
      local($ses_id2, $expires2, @field) = split /\t/;
      if ($expires2 - time > 0) {
        if (!$flag && $ses_id2 eq $ses_id) {
          $flag = 1;
          print OUT $data if ($data ne "");
        } else {
          print OUT "$_\n";
        }
      }
    }
    close IN;
  }
  print OUT $data if (!$flag && $data ne "");
  close OUT;

  if (-s $tmp_file) {
    local($i) = 0;
    while (rename $tmp_file, $ses_file) {
      if ($i ++ >= 3) {
        unlink $tmp_file;
        return 0;
      }
    }
  } else {
    unlink $ses_file, $tmp_file;
  }

  return 1;
}

sub getSession #($ses_file, *hash, $ses_id, $expires)
{
  local($ses_file, *hash, $ses_id, $expires) = @_;
  local($tmp_file) = $ses_file . ".$$.tmp";
  local($flag, $time_out) = 0;

  $ses_id = $ENV{'REMOTE_ADDR'} if ($ses_id eq "");
  if (!open IN, $ses_file) {
    return 0;
  } elsif (!open OUT, ">$tmp_file") {
    return 0;
  }
  while (<IN>) {
    tr/\x0D\x0A//d;
    local($ses_id2, $expires2, @field) = split /\t/;
    if ($expires2 - time > 0) {
      if (!$flag && $ses_id2 eq $ses_id) {
        $flag = 1;
        foreach (@field) {
          local($key, $val) = split /=/, $_, 2;
          &urldecode(*key);
          &urldecode(*val);
          $hash{$key} = $val;
        }
        next if ($expires == -1);
        $expires2 = time + $expires if ($expires);
        print OUT "$ses_id2\t$expires2\t" . join("\t", @field) . "\n";
      } else {
        print OUT "$_\n";
      }
    } else {
      $time_out = 1;
    }
  }
  close OUT;
  close IN;

  if ($time_out || $expires) {
    if (-s $tmp_file) {
      local($i) = 0;
      while(rename $tmp_file, $ses_file) {
        if ($i ++ >= 3) {
          unlink $tmp_file;
          return 0;
        }
      }
    } else {
      unlink $ses_file, $tmp_file;
    }
  } else {
    unlink $tmp_file;
  }

  return $flag;
}

;# ============================
;# Get STDIN Data & Decode.
;# ============================

sub getFormData #(*IN, $tr_tags, $jcode, $multi_keys, $file_dir)
{
  return &getMultipartFormData(@_) if ($ENV{'CONTENT_TYPE'} =~ /^multipart\/form-data;/i);
  return &getUrlencodedFormData(@_);
}

sub getUrlencodedFormData #(*IN, $tr_tags, $jcode, $multi_keys)
{
  local(*IN, $tr_tags, $jcode, $multi_keys) = @_;
  local($buffer, @array, $h2z);

  if ($ENV{'CONTENT_LENGTH'} > $max_byte || $ENV{'CONTENT_TYPE'} =~ /^multipart\/form-data;/i) {
    return;
  } elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
    read STDIN, $buffer, $ENV{'CONTENT_LENGTH'};
  } else {
    $buffer = $ENV{'QUERY_STRING'};
  }
  return if ($buffer eq "");
  $h2z = $jcode =~ tr/A-Z/a-z/ ? "z" : "";
  foreach (split /[&;]/o, $buffer) {
    local($key, $val) = split /=/, $_, 2;
    &urldecode(*key);
    &urldecode(*val);
    if ($jcode && $jcode'version) {
      &jcode'convert(*key, $jcode, "", $h2z);
      &jcode'convert(*val, $jcode, "", $h2z);
    }
    $key =~ s/\x0D\x0A|\x0D|\x0A/\n/g;
    $key =~ tr/\t\a\b\e\f\0//d;
    $val =~ s/\x0D\x0A|\x0D|\x0A/\n/g;
    $val =~ tr/\t\a\b\e\f\0//d;
    if ($tr_tags) {
      $key =~ s/&/&amp;/g;
      $key =~ s/"/&quot;/g;
      $key =~ s/</&lt;/g;
      $key =~ s/>/&gt;/g;
      $val =~ s/&/&amp;/g;
      $val =~ s/"/&quot;/g;
      $val =~ s/</&lt;/g;
      $val =~ s/>/&gt;/g;
      if ($tr_tags == 2) {
        $key =~ s/\n/<br>/g;
        $val =~ s/\n/<br>/g;
      }
    }
    if ($multi_keys ne "") {
      $IN{$key} .= $IN{$key} ne "" ? "$multi_keys$val" : $val;
    } else {
      $IN{$key} = $val;
    }
    push @array, $key;
  }
  return @array;
}

sub getMultipartFormData #(*IN, $tr_tags, $jcode, $multi_keys, $file_dir)
{
  local(*IN, $tr_tags, $jcode, $multi_keys, $file_dir) = @_;
  local($boundary, $key, $val, $buffer, $path, $flag, $file, $text, $type, $open, $h2z, $i, @array);

  if ($ENV{'CONTENT_LENGTH'} > $max_byte) {
    return;
  } elsif ($ENV{'CONTENT_TYPE'} =~ /^multipart\/form-data; *boundary=(.+)/) {
    $boundary = $1;
  } else {
    return;
  }
  $h2z = $jcode =~ tr/A-Z/a-z/ ? "z" : "";
  binmode STDIN;
  while (<STDIN>) {
    if ($flag == 2) {
      if (/^--$boundary/) {
        $val =~ s/\r\n$//;
        if ($text) {
          if ($jcode && $jcode'version) {
            &jcode'convert(*key, $jcode, "", $h2z);
            &jcode'convert(*val, $jcode, "", $h2z);
          }
          $key =~ s/\x0D\x0A|\x0D|\x0A/\n/g;
          $key =~ tr/\t\a\b\e\f\0//d;
          $val =~ s/\x0D\x0A|\x0D|\x0A/\n/g;
          $val =~ tr/\t\a\b\e\f\0//d;
          if ($tr_tags) {
            $key =~ s/&/&amp;/g;
            $key =~ s/"/&quot;/g;
            $key =~ s/</&lt;/g;
            $key =~ s/>/&gt;/g;
            $val =~ s/&/&amp;/g;
            $val =~ s/"/&quot;/g;
            $val =~ s/</&lt;/g;
            $val =~ s/>/&gt;/g;
            if ($tr_tags == 2) {
              $key =~ s/\n/<br>/g;
              $val =~ s/\n/<br>/g;
            }
          }
        }
        push @array, $key;
        if ($text && $multi_keys ne "") {
          $IN{$key} .= $IN{$key} ne "" ? "$multi_keys$val" : $val;
        } else {
          if ($open) {
            $buffer =~ s/\r\n$//;
            print OUT $buffer;
            close OUT;
            push @file, $file;
            $IN{"$key->size"} = (-s $file);
            $IN{$key} = $file;
          } else {
            $IN{$key} = $val;
            $IN{"$key->size"} = length $val;
          }
          $IN{"$key->path"} = $path;
          $IN{"$key->name"} = $1 if ($path =~ /([^\\\/]+)$/);
          $IN{"$key->type"} = $type;
        }
        ($text, $type, $flag, $path, $open, $file, $key, $val, $buffer) = undef;
        last if (/--\r\n$/);
      } elsif ($open) {
        print OUT $buffer if ($buffer ne "");
        $buffer = $_;
      } else {
        $val .= $_;
      }
    } elsif ($flag && !$text && /^Content-Type: *([^\s]+)/i) {
      $type = $1;
    } elsif ($flag && /^\r\n$/) {
      $flag = 2;
    } elsif (/^Content-Disposition: *([^;]*); *name="([^;]*)"; *filename="([^;]*)"/i) {
      $key  = $2;
      $path = $3;
      $flag = 1;
      if ($path ne "" && $file_dir ne "" && $IN{"$key->path"} eq "") {
        $i ++;
        $file = sprintf "$file_dir%d-$i.tmp", $$+time;
        if (open OUT, ">$file") {
          binmode OUT;
          $open = 1;
        }
      }
    } elsif (/^Content-Disposition: *([^;]*); *name="([^;]*)"/i) {
      $key  = $2;
      $flag = 1;
      $text = 1;
    }
  }
  return @array;
}

;# ============================
;# Set Form Data.
;# ============================

sub setQueryString #(*hash, *array, $separator, $cut_blank)
{
  local(*hash, *array, $separator, $cut_blank) = @_;
  local(@query);

  $separator = ";" if ($separator eq "");
  @array = sort keys %hash if (!@array);
  foreach (@array) {
    local($val) = $hash{$_};
    next if ($cut_blank && $val eq "");
    &urlencode(*val);
    push @query, "$_=$val";
  }
  return join $separator, @query;
}

sub setHiddenForm #(*hash, *array, $separator, $cut_blank)
{
  local(*hash, *array, $separator, $cut_blank) = @_;
  local(@query);

  @array = sort keys %hash if (!@array);
  foreach (@array) {
    local($key, $val) = ($_, $hash{$_});
    next if ($cut_blank && $val eq "");
    $key =~ s/&/&amp;/g;
    $key =~ s/"/&quot;/g;
    $key =~ s/</&lt;/g;
    $key =~ s/>/&gt;/g;
    $key =~ s/\r/&#13;/g;
    $key =~ s/\n/&#10;/g;
    $val =~ s/&/&amp;/g;
    $val =~ s/"/&quot;/g;
    $val =~ s/</&lt;/g;
    $val =~ s/>/&gt;/g;
    $val =~ s/\r/&#13;/g;
    $val =~ s/\n/&#10;/g;
    push @query, qq|<input type="hidden" name="$key" value="$val">|;
  }
  return join $separator, @query;
}

;# ============================
;# Get day & time.
;# ============================

sub getTime #($time_format, $time_difference, $base_time)
{
  local($_, $time_difference, $base_time) = @_;
  local(@time);

  $base_time = time if ($base_time eq "");
  if ($_ ne "") {
    @time = gmtime($base_time + $time_difference);
  } else {
    return scalar gmtime($base_time + $time_difference);
  }
  s/%%/%\a/g;
  s/%mm/sprintf("%02d",$time[4]+1)/eg;
  s/%m/$time[4]+1/eg;
  s/%yyyy/$time[5]+1900/eg;
  s/%yyy/$time[5]-88/eg;
  s/%yy/substr($time[5]+1900, 2, 2)/eg;
  s/%y/substr($time[5]+1900, 3, 1)/eg;
  s/%dd/sprintf("%02d",$time[3])/eg;
  s/%d/$time[3]/g;
  s/%hh/sprintf("%02d",$time[2])/eg;
  s/%h/$time[2]/g;
  s/%nn/sprintf("%02d",$time[1])/eg;
  s/%n/$time[1]/eg;
  s/%ss/sprintf("%02d",$time[0])/eg;
  s/%s/$time[0]/eg;
  s/%ww4/$time[6]/g;
  if ($time[2] < 12) {
    $time[7] = $time[2];
    s/%ap3/午前/gi;
    s/%ap2/am/gi;
    s/%ap/AM/gi;
  } else {
    $time[7] = $time[2] == 12 ? 12 : $time[2] - 12;
    s/%ap3/午後/gi;
    s/%ap2/pm/gi;
    s/%ap/PM/gi;
  }
  s/%HH/sprintf("%02d",$time[7])/eg;
  s/%H/$time[7]/g;
  if (/%ww2/) {
    local(@week) = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
    s/%ww2/$week[$time[6]]/g;
  }
  if (/%ww3/) {
    local(@week) = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
    s/%ww3/$week[$time[6]]/g;
  }
  if (/%ww/) {
    local(@week) = ('日','月','火','水','木','金','土');
    s/%ww/$week[$time[6]]/g;
  }
  if (/%MM2/) {
    local(@month) = ('January','Februay','March','April','May','June','July','August','September','October','November','December');
    s/%MM2/$month[$time[4]]/g;
  }
  if (/%MM/) {
    local(@month) = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
    s/%MM/$month[$time[4]]/g;
  }
  s/%\a/%/g;
  return $_;
}

;# ============================
;# Get UTC Serial Time.
;# ============================

sub getSerialTime #($time_zone, $year, $month, $day, $hour, $min, $sec)
{
  local($time_zone, $year, $month, $day, $hour, $min, $sec) = @_;
  local(@day_month, $age, $leap, $time);

  return if (!$year);
  $month = 1 if (!$month);
  $day   = 1 if (!$day);
  @day_month = (0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334);
  $age  = $year - 1970;
  if (1970 <= $year) {
    $leap = &getLeapYearTimes(1970, $year);
  } else {
    $leap = &getLeapYearTimes($year, 1970);
  }
  $leap -- if ($year % 4 == 0 && ($year % 400 == 0 || $year % 100 != 0));
  $time  = ($age - $leap) * 31536000;
  $time += $leap * 31622400;
  $time += $day_month[$month-1] * 86400;
  $time += 86400 if ($month >= 3 && $year % 4 == 0 && ($year % 400 == 0 || $year % 100 != 0));
  $time += ($day - 1)  * 86400;
  $time += $hour * 3600;
  $time += $min  * 60;
  $time += $sec;

  return $time - $time_zone;
}

sub getLeapYearTimes #($year1, $year2)
{
  local($year1, $year2) = @_;
  local($year1x, $year2x, $leap);

  return if ($year2 - $year1 < 0);
  while ($year1 % 4 != 0) {
    $year1 ++;
  }
  $year1 += 4 if ($year1 % 100 == 0 && $year1 % 400 != 0);
  while ($year2 % 4 != 0) {
    $year2 --;
  }
  $year2 -= 4 if ($year2 % 100 == 0 && $year2 % 400 != 0);
  $leap = ($year2 - $year1) / 4 + 1;

  $year1x = int($year1 / 100);
  $year2x = int($year2 / 100);
  if ($year2x - $year1x > 0) {
    local($i) = 0;
    for ($year1x .. $year2x) {
      $i ++ if ($_ % 4 == 0);
    }
    $leap -= $year2x - $year1x - $i;
  }
  return $leap;
}

;# ============================
;# Encode / Decode.
;# ============================

sub base64encode #(*data, $ins_lf)
{
  local(*data, $ins_lf) = @_;
  local($length, $result, $i, $j);
  local($base) = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";

  $data = unpack "B*", $data;
  for ($i = 0, $j = 1; $length = substr($data, $i, 6); $i += 6, $j ++) {
    $result .= substr($base, ord(pack("B*", "00" . $length)), 1);
    if (length $length == 2) {
      $result .= "==";
    } elsif (length $length == 4) {
      $result .= "=";
    }
    $result .= "\n" if ($ins_lf && $j % $ins_lf == 0);
  }
  $data = $result;
}

sub base64decode #(*data)
{
  local(*data) = $_[0];
  local($result, $length);

  $data =~ tr|A-Za-z0-9+=/||cd;
  return if (length($data) % 4);

  $data =~ s/=+$//;
  $data =~ tr|A-Za-z0-9+/| -_|;
  while ($data =~ /(.{1,60})/g) {
    $length  = pack("C", 32 + int length($1) * 3 / 4);
    $result .= unpack "u", $length . $1;
  }
  $data = $result;
}

sub urlencode #(*data)
{
  local(*data) = @_;

  $data =~ s/([^\w\-.* ])/sprintf('%%%02X', ord $1)/eg;
  $data =~ tr/ /+/;
}

sub urldecode #(*data)
{
  local(*data) = @_;

  $data =~ tr/+/ /;
  $data =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex $1)/eg;
}

;# ============================
;# Transfer String.
;# ============================

sub trString #(*str, $html, $lc, $z2h, $k2h, $rmstr)
{
  local(*str, $html, $lc, $z2h, $k2h, $rmstr) = @_;

  if ($html) {
    if ($html == 2) {
      $str =~ s/&gt;/>/g;
      $str =~ s/&lt;/</g;
      $str =~ s/&quot;/"/g;
      $str =~ s/&amp;/&/g;
    } else {
      $str =~ s/&/&amp;/g;
      $str =~ s/"/&quot;/g;
      $str =~ s/</&lt;/g;
      $str =~ s/>/&gt;/g;
    }
  }
  if ($jcode'version) {
    local($from, $to);
    if ($k2h) {
      $from = 'アイウエオカキクケコサシスセソタチツテトナニヌネノハヒフヘホマミムメモヤユヨラリルレロワヲンガギグゲゴザジズゼゾダヂヅデドバビブベボパピプペポゐゑァィゥェォャュョッ';
      $to   = 'あいうえおかきくけこさしすせそたちつてとなにぬねのはひふへほまみむめもやゆよらりるれろわをんがぎぐげござじずぜぞだぢづでどばびぶべぼぱぴぷぺぽヰヱぁぃぅぇぉゃゅょっ';
      if ($k2h == 2) {
        local($tmp_var) = $to;
        $to = $from;
        $from = $tmp_var;
      }
    }
    if ($z2h) {
      $from .= '０１２３４５６７８９ＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰＱＲＳＴＵＶＷＸＹＺａｂｃｄｅｆｇｈｉｊｋｌｍｎｏｐｑｒｓｔｕｖｗｘｙｚ＋＝／＾〜＿｜＊！？”＃＄￥％＆＠：；　−';
      $to   .= '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+=/^~_|*!?"#$\%&@:; -';
      if ($z2h == 2) {
        local($tmp_var) = $to;
        $to = $from;
        $from = $tmp_var;
      }
    }
    if ($rmstr) {
      $from .= $rmstr;
      $to   .= "\a";
    }
    if ($from ne "" && $to ne "") {
      &jcode'tr(*str, $from, $to);
      $str =~ tr/\a//d if ($rmstr);
    }
  }
  if ($lc) {
    if ($lc == 2) {
      $str =~ tr/a-z/A-Z/;
    } else {
      $str =~ tr/A-Z/a-z/;
    }
  }
}

;# ============================
;# Search String.
;# ============================

sub searchString #($str, $key, $mhmode)
{
  local($str, $key, $mhmode) = @_;

  return 0 if ($str eq "" || $key eq "");
  if ($mhmode == 5 || $mhmode =~ /^BOOLEAN$/i || $mhmode =~ /^BLN$/i) {
    local($i) = 0;
    local(@str, $eval);
    $key =~ s/ +OR +/ | /gi;
    $key =~ s/ +AND +/ & /gi;
    $key =~ s/ *NOT +/ ! /gi;
    $key =~ s/\( +/(/g;
    $key =~ s/ +\)/)/g;
    foreach (split /( & | \| )/, $key) {
      $str[$i] .= $_;
      $i ++ unless ($_ eq ' & ' || $_ eq ' | ')
    }
    for ($i = 0; $i <= $#str; $i ++) {
      local($option, $open, $close, $find, $not, $key);
      $key = $str[$i];
      if ($str[$i] =~ /^( & | \| )/) {
        $option = substr $key, 0, 3;
        $key    = substr $key, 3;
      }
      $open  = $1 if ($key =~ /^(\(+)/g);
      $close = $1 if ($key =~ /(\)+)$/g);
      $key   =~ s/\(|\)//g;
      if ($key =~ /^ *! +/) {
        $key =~ s/^ *! +//g;
        $not = 1;
      }
      $find  = index($str, $key) >= 0 ? 1 : 0;
      $find  = $find ? 0 : 1 if ($not);
      $eval .= "$option$open$find$close";
    }
    $eval =~ s/ & /*/g;
    $eval =~ s/ \| /+/g;
    return (eval $eval >= 1) ? 1 : 0;
  } elsif ($mhmode == 4 || $mhmode =~ /^NOR$/i) {
    foreach (split / +/, $key) {
      return 1 if (index($str, $_) == -1);
    }
    return 0;
  } elsif ($mhmode == 3 || $mhmode =~ /^EOR$/i) {
    local($flag) = 0;
    foreach (split / +/, $key) {
      if (index($str, $_) >= 0) {
        return 0 if ($flag);
        $flag = 1;
      }
    }
    return 1;
  } elsif ($mhmode == 2 || $mhmode =~ /^OR$/i) {
    foreach (split / +/, $key) {
      return 1 if (index($str, $_) >= 0);
    }
    return 0;
  } elsif ($mhmode == 1 || $mhmode =~ /^NAND$/i) {
    foreach (split / +/, $key) {
      return 0 if (index($str, $_) >= 0);
    }
    return 1;
  } else { 
    foreach (split / +/, $key) {
      return index($str, substr($_, 1)) >= 0 ? 0 : 1 if (/^!/);
      return 0 if (index($str, $_) == -1);
    }
    return 1;
  }
}

;# ============================
;# Make Random String.
;# ============================

sub getRandomString #($len, $str)
{
  local($len, $str) = @_;
  local(@str) = $str ? split //, $str : ('A'..'Z','a'..'z','0'..'9');

  $str = "";
  $len = 8 if (!$len);
  for (1 .. $len) {
    $str .= $str[int rand($#str+1)];
  }
  return $str;
}

;# ============================
;# Set Link.
;# ============================

sub setLink #(*data, $attribute, $uri_str, $mail_str)
{
  local(*data, $attribute, $uri_str, $mail_str) = @_;
  local($element, $new_data);

  foreach (split /(<[^>]*>)/, $data) {
    if (/^<(a|button|textarea|script|head)/i) {
        $element = $1;
    } elsif ($element && /^<\/$element/) {
        $element = "";
    } elsif (!$element && ! /^</) {
      tr/\a//d;
      s/&amp;/\a/g;
      if ($uri_str) {
        s/((https?|ftp|gopher|telnet|news|wais|nntp):\/\/[-+:.@\w]{4,60}(\/[-.?+:;!#%=@~^\$\a\w\/\[\]]{0,150})?)/<a href=\"$1\" $attribute>$uri_str<\/a>/g;
      } else {
        s/((https?|ftp|gopher|telnet|news|wais|nntp):\/\/[-+:.@\w]{4,60}(\/[-.?+:;!#%=@~^\$\a\w\/\[\]]{0,150})?)/<a href=\"$1\" $attribute>$1<\/a>/g;
      }
      if ($mail_str) {
        s/(mailto:[-+.\w]{1,30}@[-+.\w]*[-A-Za-z0-9]{2,30}\.[A-Za-z]{1,6}(\?[-.?+:;!#%=@~^\$\a\w\/\[\]]{0,150})?)\b/<a href="$1">$mail_str<\/a>/g;
      } else {
        s/(mailto:[-+.\w]{1,30}@[^+:;!#%=@~^\$\a\/\[\]]{2,50}\.[A-Za-z]{1,6}(\?[-.?+:;!#%=@~^\$\a\w\/\[\]]{0,150})?)\b/<a href="$1">$1<\/a>/g;
      }
      s/\a/&amp;/g;
    }
    $new_data .= $_;
  }
  $data = $new_data;
}

;# ============================
;# Set Comma per 3 figures.
;# ============================

sub setComma #($str)
{
  local($str) = $_[0];

  return $str if ($str =~ /[^\dA-Fa-f]/);
  1 while $str =~ s/([\dA-Fa-f]+)([\dA-Fa-f]{3})/$1,$2/;
  return $str;
}

;# ============================
;# Lock Check / Lock / Unlock
;# ============================

sub lock #($lock_dir)
{
  local($lock_dir) = $_[0] . ".lock";
  local($lock_dir2)= $lock_dir . "2";
  local($i) = 0;

  if ((-M $lock_dir) * 86400 > 180) {
    rmdir $lock_dir;
    rmdir $lock_dir2;
    return 0;
  }
  while(!mkdir $lock_dir, 0755) {
    sleep 1;
    if (++ $i >= 3) {
      if (mkdir $lock_dir2, 0755) {
        if ((-M $lock_dir) * 86400 > 60) {
          return 1 if (rename $lock_dir2, $lock_dir);
        }
        rmdir $lock_dir2;
        return 0;
      }
      if ((-M $lock_dir2) * 86400 > 30) {
        if ((-M $lock_dir) * 86400 > 60) {
          return 1 if (rename $lock_dir2, $lock_dir);
        }
        rmdir $lock_dir2;
      }
      return 0;
    }
  }
  return 1;
}

sub unlock #($lock_dir)
{
  local($lock_dir) = @_;

  rmdir "$lock_dir.lock" if (-d "$lock_dir.lock");
}

sub lockCheck #($lock_dir)
{
  local($lock_dir) = $_[0] . ".lock";
  local($i) = 0;

  return 1 if ((-M $lock_dir) * 86400 > 60);
  while (-d $lock_dir) {
    sleep 1;
    return 0 if (++ $i >= 3);
  }
  return 1;
}

;# ============================
;# (HTTP) Socket Connection.
;# ============================

sub openSocket #($SOCK, $url, $method, *header, $stdin, $content_type)
{
  local($SOCK, $url, $method, *header, $stdin, $content_type) = @_;
  local($host, $path, $addr, $http, $port, $proc);

  $SOCK = "main'$SOCK";
  $http = $url =~ s/^http\:\/\///i;
  ($host, $path) = split /[ \/]/, $url, 2;
  ($host, $port) = split /:/, $host, 2;
  $path = $path =~ /^http:/ ? " $path" : "/$path";
  $port = 80 if (!$port);
  $method = "GET" if (!$method);
  if ($host =~ /^[0-9]+(\.[0-9]+)+$/) {
    $addr = pack('C4', (split /\./, $host)[0..3]);
  } else {
    return 0 unless ($addr = gethostbyname $host);
  }
  if ($INC{'Socket.pm'}) {
    $inet   = &main'AF_INET;
    $stream = &main'SOCK_STREAM;
  }
  $proc = pack('S n a4 x8', $inet, $port, $addr);
  return 0 if (!socket $SOCK, $inet, $stream, getprotobyname("tcp"));
  return 0 if (!connect $SOCK, $proc);
  select((select($SOCK), $| = 1)[0]);
  if ($http) {
    print $SOCK "$method $path HTTP/1.1\x0D\x0A"
              . "Host: $host\x0D\x0A";
    while (($key, $val) = each %header) {
      next if ($val =~ /^[\r\n]+$/);
      print $SOCK "$key: $val\x0D\x0A";
    }
    if ($method ne "GET" && $stdin ne "") {
      $content_type = "application/x-www-form-urlencoded" if ($content_type eq "");
      print $SOCK "Content-Type: $content_type\x0D\x0A"
                . "Content-Length: ", length $stdin, "\x0D\x0A"
                . "\r\n"
                . $stdin;
    } else {
      print $SOCK "\x0D\x0A";
    }
  }
  return 1;
}

sub closeSocket #($SOCK)
{
  local($SOCK) = @_;

  $SOCK = "main'$SOCK";
  return close $SOCK;
}

;# ============================
;# Send Email.
;# ============================

sub sendmail #(*header, $body, $html_body, $mime_encode, @attachment_files)
{
  local(*header, $body, $html_body, $mime_encode, @attachment_files) = @_;
  local($boundary, $text);

  return 0 if (!open ML, "| $sendmail -t -i");
  while (($key, $val) = each %header) {
    local($val2);
    $val =~ tr/\x0D\x0A//d;
    foreach (split /( +|")/, $val) {
      if (/[^\x20-\x7e]/) {
        &jcode'convert(*_, 'jis') if ($jcode'version);
        &base64encode(*_);
        $val2 .= "=?ISO-2022-JP?B?$_?=";
      } else {
        $val2 .= $_;
      }
    }
    $val = $val2;
    print ML "$key: $val\n";
  }
  if (@attachment_files) {
    $boundary = '===' . time . $$ . time . '===';
    print ML "Content-Type: multipart/mixed;\n"
           . qq(\tboundary="$boundary"\n\n)
           . "This is a multipart message in MIME format.\n\n"
           . "--$boundary\n";
  } elsif ($body && $html_body) {
    $boundary = '===' . time . $$ . time . '===';
    print ML "Content-Type: multipart/alternative;\n"
           . qq(\tboundary="$boundary"\n\n)
           . "This is a multipart message in MIME format.\n\n"
           . "--$boundary\n";
  }
  $text = !$body && $html_body ? 'html' : 'plain';
  $body = $html_body if ($text eq "html");
  &jcode'convert(*body, 'jis') if ($jcode'version);
  print ML "Content-Type: text/$text"
         . qq(; charset="ISO-2022-JP"\n)
         . "Content-Transfer-Encoding: 7bit\n\n"
         . "$body\n";
  if ($text eq "plain" && $html_body) {
    print ML "--$boundary\n"
           . qq(Content-Type: text/html; charset="ISO-2022-JP"\n)
           . "Content-Transfer-Encoding: 7bit\n\n";
    &jcode'convert(*html_body, 'jis') if ($jcode'version);
    print ML "$html_body\n";
    print ML "--$boundary--\n" if (!@attachment_files);
  }
  if (@attachment_files) {
    foreach $file (@attachment_files) {
      local($file, $type, $name, $encode) = split / *; */, $file;
      if (open IN, $file) {
        local($file_size) = (-s $file);
        binmode IN;
        $encode = $mime_encode if ($encode eq "");
        $name = (!$name && $file =~ /([^\/]+$)/) ? $1 : $name;
        $type = &getMimeType($file) if (!$type);
        print ML "--$boundary\n";
        print ML qq(Content-Type: $type; name="$name"\n);
        if ($encode eq "1" || $encode =~ /^uu(encode)?$/i) {
          local($read, $buffer);
          print ML "Content-Transfer-Encoding: X-uuencode\n";
          print ML qq(Content-Disposition: attachment; filename="$name"\n\n);
          print ML "begin 666 $name\n";
          while ($read = read IN, $buffer, 1035) {
            local($data);
            while ($buffer =~ s/^((.|\n|\r){45})//) {
              $data .= pack("u", $&);
            }
            if ($read == 1035) {
              print ML $data;
              next;
            }
            print ML $data;
            print ML pack("u", $buffer) if ($buffer ne "");
          }
          print ML "`\n"
                 . "end\n";
        } else {
          local($base, $read, $buffer, $j);
          $base = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
          $j = 1;
          print ML "Content-Transfer-Encoding: Base64\n";
          print ML qq(Content-Disposition: attachment; filename="$name"\n\n);
          while ($read = read IN, $buffer, 1026) {
            local($data, $length, $i);
            $i = $length = 0;
            $buffer = unpack "B*", $buffer;
            while ($length = substr($buffer, $i, 6)) {
              $data .= substr($base, ord pack("B*", "00".$length), 1);
              if ($read != 1026 || tell(IN) == $file_size) {
                if (length $length == 2) {
                  $data .= "==";
                } elsif (length $length == 4) {
                  $data .= "=";
                }
              }
              $data .= "\n" if ($j++ % 76 == 0);
              $i += 6;
            }
            print ML $data;
          }
        }
        close IN;
        print ML "\n";
      }
    }
    print ML "--$boundary--\n";
  }
  close ML;
  return 1;
}

;# ============================
;# Shuffle Array.
;# ============================

sub shuffleArray #(@array)
{
  local(@array) = @_;
  local(@new_array);

  while (@array) {
    push @new_array, splice(@array, int(rand $#array + 1), 1);
  }
  return @new_array;
}

;# ============================
;# Get Image Pixel Size.
;# ============================

sub getImageSize #($file_name)
{
  local($file_name) = @_;
  local($head);

  return if (!open IN, $file_name);
  binmode IN;
  read IN, $head, 8;
  if ($head eq "\x89\x50\x4e\x47\x0d\x0a\x1a\x0a") {
    local($width, $height);
    if (read(IN, $head, 4) != 4 || read(IN, $head, 4) != 4 || $head ne 'IHDR') {
      close IN;
      return "PNG", 0;
    }
    read IN, $head, 8;
    close IN;
    $width = unpack "N", substr($head, 0, 4);
    $height = unpack "N", substr($head, 4, 4);
    return "PNG", $width, $height;
  }
  $head = substr $head, 0, 3;
  if ($head eq "\x47\x49\x46") {
    local($head, $width, $height);
    seek IN, 6, 0;
    read IN, $head, 4;
    close IN;
    ($width, $height) = unpack "vv", $head;
    return "GIF", $width, $height;
  }
  $head = substr $head, 0, 2;
  if ($head eq "\xff\xd8") {
    local($head, $width, $height, $w1, $w2, $h1, $h2, $l1, $l2, $length);
    seek IN, 2, 0;
    while (read IN, $head, 1) {
      last if ($head eq "");
      if ($head eq "\xff") {
        $head = getc IN;
        if ($head =~ /^[\xc0-\xc3\xc5-\xcf]$/) {
          seek IN, 3, 1;
          last if (read(IN, $head, 4) != 4);
          close IN;
          ($h1, $h2, $w1, $w2) = unpack "C4", $head;
          $height = $h1 * 256 + $h2;
          $width  = $w1 * 256 + $w2;
          return "JPG", $width, $height;
        } elsif ($head eq "\xd9" || $head eq "\xda") {
          last;
        } else {
          last if (read(IN, $head, 2) != 2);
          ($l1, $l2) = unpack "CC", $head;
          $length = $l1 * 256 + $l2;
          seek IN, $length - 2, 1;
        }
      }
    }
    close IN;
    return "JPG", 0;
  }
  return 0;
}

;# ============================
;# Get MIME Type.
;# ============================

sub getMimeType #($file_name)
{
  local($file_name) = @_;

  local(%mime_type) = (
    'shtml' => 'text/html',     'stm'   => 'text/html',   'hdml'  => 'text/hdml',     'html'  => 'text/html',
    'htm'   => 'text/html',     'xml'   => 'text/xml',    'csv'   => 'text/plain',    'txt'   => 'text/plain',
    'vcf'   => 'text/x-vcard',  'rtf'   => 'text/rtf',    'rtx'   => 'text/richtext', 'css'   => 'text/css',

    'gif'   => 'image/gif',     'jpeg'  => 'image/jpeg',  'jpg'   => 'image/jpeg',    'png'   => 'image/png',
    'bmp'   => 'image/bmp',     'tiff'  => 'image/tiff',  'tif'   => 'image/tiff',    'ico'   => 'image/x-icon',

    'midi'  => 'audio/midi',    'mid'   => 'addio/midi',  'mp2'   => 'audio/mpeg',    'mp3'   => 'audio/mpeg',
    'wav'   => 'audio/x-wav',   'au'    => 'audio/basic', 'wma'   => 'audio/x-ms-wma',

    'doc'   => 'application/msword',                      'xls'   => 'application/vnd.ms-excel',

    'mpg'   => 'video/mpeg',    'mpeg'  => 'video/mpeg',  'mov'   => 'video/quicktime',
    'avi'   => 'video/x-msvideo',                         'qt'    => 'video/quicktime',

    'zip'   => 'application/zip',                         'lzh'   => 'application/x-lzh',
    'lha'   => 'application/x-lzh',                       'tar'   => 'application/x-tar',
    'gz'    => 'application/x-gzip',

    'swf'   => 'application/x-shockwave-flash',           'js'    => 'application/x-javascript',
    'pdf'   => 'application/pdf'
  );

  $file_name =~ tr/A-Z/a-z/;
  $file_name = ($file_name =~ /\.(\w+)$/) ? $1 : "";

  return defined $mime_type{$file_name} ? $mime_type{$file_name} : 'application/octet-stream';
}

1;