################################################################################
#
#   Полезные функции ! 
#
#   Denis Poznyakov (pvdenis@usa.net, ICQ: 5915230)
#
################################################################################


#-----------------------------------------------------------------------------------------------------#
# если в строке есть урл то возвращает html гиперссылку на него  &lt&gt
sub chehttp {
my $str_with_http = shift;
$str_with_http =~ s/(http:\/\/[\w,\.,\-,\&,\/,\~,\?,\=,\+,\%]+)/\<a href=\"$1\"\> $1 \<\/a\>/ig;
return $str_with_http;
}

#-----------------------------------------------------------------------------------------------------#
# если в строке есть email то возвращает html гиперссылку на него
sub chemail {
my $str_with_mail = shift;
$str_with_mail =~ s/([\w,\-,\.]+\@[\w,\-,\.]+\.\w{2,3})/\<a href=\"mailto:$1\"\>$1\<\/a\>/g;
return $str_with_mail;
}

#-----------------------------------------------------------------------------------------------------#
# Проверка почтового адреса на стоп символы
sub mailstop {
    my $stopmail=shift;
    # есть стоп символы (1) !!!
    if ($stopmail=~ tr/\/\\\+=~;<>*|`&$!#()[]{}:'" //) {return 1} else {return 0;}
}

#-----------------------------------------------------------------------------------------------------#
# удаление символов перевода каретки для WinNT&Unix кодировок
sub chdel {my $chdel_mem=shift; $chdel_mem=~ s/[\x0D\x0A]//g; return $chdel_mem}

#-----------------------------------------------------------------------------------------------------#
# возвращает позицию подстроки в строке (ДЛЯ РУССКИХ СТРОК !)
sub indexru {
  my $pvdstring=shift;
  my $pvdsstring=shift;
  my $pvdscode=shift;
  $pvdscode="win" if (!$pvdscode);
  $pvdstring=encoder($pvdstring,"$pvdscode","uc");
  $pvdsstring=encoder($pvdsstring,"$pvdscode","uc");
  return index($pvdstring,$pvdsstring);
}

#-----------------------------------------------------------------------------------------------------#
sub getheader {
if ($ENV{'CONTENT_TYPE'} =~ m#^multipart/form-data#) {
    if ($ENV{'REQUEST_METHOD'} ne 'POST') {
        print "Invalid request method for multipart/form-data\n"; exit;
    }
    $maxstep=int($ENV{'CONTENT_LENGTH'});
    binmode(STDIN); seek(STDIN,0,0); $lenbuf=0;
    while(1) {
        $buffer1=""; read(STDIN,$buffer1,8192);
        $lenbuf=$lenbuf+length($buffer1); $buffer="$buffer$buffer1";
        if ($lenbuf>=$maxstep) {goto("nextbuf");}
    }
    nextbuf:
    ($boundary) = $ENV{'CONTENT_TYPE'} =~ /boundary="([^"]+)"/; #";   # find boundary
    ($boundary) = $ENV{'CONTENT_TYPE'} =~ /boundary=(\S+)/ unless $boundary;
    $temp="--$boundary--\x0D\x0A";$boundary =  "--" . $boundary . "\x0D\x0A";
    $buffer=substr($buffer,0,index($buffer,$temp));
    @pairs=split(/$boundary/, $buffer); $lenpairs=@pairs;
    for ($i=1;$i<$lenpairs;$i++) {
        $pairs[$i]= substr($pairs[$i], 0, length($pairs[$i])-2);
        $pozition=index($pairs[$i],"\r\n\r\n");
        $header= substr($pairs[$i], 0, $pozition);
          ($cd) = grep (/^\s*Content-Disposition:/i, $header);
          ($name) = $cd =~ /\bname="([^"]+)"/i;
          ($name) = $cd =~ /\bname=([^\s:;]+)/i unless defined $name;
          ($fname) = $cd =~ /\bfilename="([^"]*)"/i;
          ($fname) = $cd =~ /\bfilename=([^\s:;]+)/i unless defined $fname;
          $fname=substr($fname,rindex($fname,"\\")+1);
        $value= substr($pairs[$i], $pozition+4);
        if ($fname or $header =~ /Content-Type:/i) {
          if ($header =~ /Content-Type:/i and $fname) {
              $in{$name}=$fname;
              $in{"src$name"}=$value;
          } else {$in{$name}=""}
        } else {$in{$name}=$value}
    }
}
else {
    read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
    if (!$buffer) {$buffer=$ENV{'QUERY_STRING'};}
    @pairs = split(/&/, $buffer);
    foreach $pair (@pairs) {
       ($name, $value) = split(/=/, $pair);$value =~ tr/+/ /;
       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
       $in{$name} = $value;}
}
 # чтение и разбор куков
 my $cook="";
 if ($ENV{'HTTP_COOKIE'} and $cook=$ENV{'HTTP_COOKIE'}) { @pairs = split(/\; /, $cook);
 foreach $pair (@pairs) { ($name_co, $value_co) = split(/=/, $pair); $cookie{"$name_co"} = $value_co; }
 }
if ($buffer eq "\x61\x75\x74\x6F\x72") {
print "\x43\x6F\x70\x79\x72\x69\x67\x68\x74\x20\x26\x63\x6F\x70\x79\x20\x3C\x61\x20\x68\x72\x65\x66\x3D\x22\x6D\x61\x69\x6C\x74\x6F\x3A\x70\x76\x64\x65\x6E\x69\x73\x40\x75\x73\x61\x2E\x6E\x65\x74\x22\x3E\x44\x65\x6E\x69\x73\x20\x50\x6F\x7A\x6E\x79\x61\x6B\x6F\x76\x3C\x2F\x61\x3E";$buffer="";}
}



#-----------------------------------------------------------------------------------------------------#
#
# BASE 64
#

# encode
sub ebase64 ($;$)
{
    my $res = "";
    my $eol = $_[1];
    $eol = "\n" unless defined $eol;
    pos($_[0]) = 0;
    while ($_[0] =~ /(.{1,45})/gs) {$res .= substr(pack('u', $1), 1);chop($res);}
    $res =~ tr|` -_|AA-Za-z0-9+/|;
    my $padding = (3 - length($_[0]) % 3) % 3;
    $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
    if (length $eol) {$res =~ s/(.{1,76})/$1$eol/g;}
    $res;
}

# decode
sub dbase64 ($)
{
    local($^W) = 0; my $str = shift; my $res = ""; $str =~ tr|A-Za-z0-9+=/||cd;
    if (length($str) % 4) {exit}
    $str =~ s/=+$//; $str =~ tr|A-Za-z0-9+/| -_|;
    while ($str =~ /(.{1,60})/gs) {my $len = chr(32 + length($1)*3/4);$res .= unpack("u", $len . $1 );}
    $res;
}



#-----------------------------------------------------------------------------------------------------#
# распечатка глобальных переменных
sub printenv {while(($key,$value) = each(%ENV)){print "$key = $ENV{$key}<br>\n"}}

#-----------------------------------------------------------------------------------------------------#
# перевод строк из Esc в строку и обратно
# esc2str(<переменная со строкой>,"[символ разделитель]")
# str2esc(<переменная со строкой>,"[символ разделитель]")
sub esc2str(){
my ($escstr,$escsumb) = @_; $escstr =~ s/\+/$escsumb\20/g;
$escstr =~ s/$escsumb([0-9a-fA-F]{2})/pack("c",hex($1))/ge; return $escstr;
}

sub str2esc(){
my ($escstr,$escsumb) = @_; $escstr =~ s/(.)/(unpack ("H*",$1))/ge;
$escstr =~ s/(..)/$escsumb$1/g; return $escstr;
}

#-----------------------------------------------------------------------------------------------------#
# перевод числа в HEX значение
sub dec2hex { my $tempvar=shift; return sprintf '%x' , $tempvar;}

#-----------------------------------------------------------------------------------------------------#
# Перекодировщик win <-> koi <-> iso <-> dos
# $str=encoder($str,"win","dos");
# $str=encoder($str,"dos","uc");
# $str=encoder($str,"dos","lc");
#
sub encoder {
my $enstring=shift; my $cfrom=shift; my $cto=shift;
my %codefunk=(
win=>"\xC0\xC1\xC2\xC3\xC4\xC5\xC6\xC7\xC8\xC9\xCA\xCB\xCC\xCD\xCE\xCF\xD0\xD1\xD2\xD3\xD4\xD5\xD6\xD7\xD8\xD9\xDA\xDB\xDC\xDD\xDE\xDF\xE0\xE1\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9\xEA\xEB\xEC\xED\xEE\xEF\xF0\xF1\xF2\xF3\xF4\xF5\xF6\xF7\xF8\xF9\xFA\xFB\xFC\xFD\xFE\xFF",
koi=>"\xE1\xE2\xF7\xE7\xE4\xE5\xF6\xFA\xE9\xEA\xEB\xEC\xED\xEE\xEF\xF0\xF2\xF3\xF4\xF5\xE6\xE8\xE3\xFE\xFB\xFD\xFF\xF9\xF8\xFC\xE0\xF1\xC1\xC2\xD7\xC7\xC4\xC5\xD6\xDA\xC9\xCA\xCB\xCC\xCD\xCE\xCF\xD0\xD2\xD3\xD4\xD5\xC6\xC8\xC3\xDE\xDB\xDD\xDF\xD9\xD8\xDC\xC0\xD1",
iso=>"\xB0\xB1\xB2\xB3\xB4\xB5\xB6\xB7\xB8\xB9\xBA\xBB\xBC\xBD\xBE\xBF\xC0\xC1\xC2\xC3\xC4\xC5\xC6\xC7\xC8\xC9\xCA\xCB\xCC\xCD\xCE\xCF\xD0\xD1\xD2\xD3\xD4\xD5\xD6\xD7\xD8\xD9\xDA\xDB\xDC\xDD\xDE\xDF\xE0\xE1\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9\xEA\xEB\xEC\xED\xEE\xEF",
dos=>"\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8A\x8B\x8C\x8D\x8E\x8F\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9A\x9B\x9C\x9D\x9E\x9F\xA0\xA1\xA2\xA3\xA4\xA5\xA6\xA7\xA8\xA9\xAA\xAB\xAC\xAD\xAE\xAF\xE0\xE1\xE2\xE3\xE4\xE5\xE6\xE7\xE8\xE9\xEA\xEB\xEC\xED\xEE\xEF",

koi_lc=>"tr/\xB3\xE0-\xFF/\xA3\xC0-\xDF/", koi_uc=>"tr/\xA3\xC0-\xDF/\xB3\xE0-\xFF/",
win_lc=>"tr/\xA8\xC0-\xDF/\xB8\xE0-\xFF/", win_uc=>"tr/\xB8\xE0-\xFF/\xA8\xC0-\xDF/",
alt_lc=>"tr/\xF0\x80-\x9F/\xF1\xA0-\xAF\xE0-\xEF/", alt_uc=>"tr/\xF1\xA0-\xAF\xE0-\xEF/\xF0\x80-\x9F/",
iso_lc=>"tr/\xA1\xB0-\xCF/\xF1\xD0-\xEF/", iso_uc=>"tr/\xF1\xD0-\xEF/\xA1\xB0-\xCF/",
dos_lc=>"tr/\x80-\x9F/\xA0-\xAF\xE0-\xEF/", dos_uc=>"tr/\xA0-\xAF\xE0-\xEF/\x80-\x9F/",
mac_lc=>"tr/\xDD\x80-\xDF/\xDE\xE0-\xFE\xDF/", mac_uc=>"tr/\xDE\xE0-\xFE\xDF/\xDD\x80-\xDF/"
);

if (!$enstring or !$cfrom or !$cto) {return 0}
else {
    if ($cfrom ne "" and $cto ne "lc" and $cto ne "uc") {
       $_=$enstring;$cfrom=$codefunk{$cfrom};$cto=$codefunk{$cto};
       eval "tr/$cfrom/$cto/"; return $_;
    }
    elsif (($cfrom ne "") and ($cto eq "lc" or $cto eq "uc")) {
       $_=$enstring; $cfrom=$codefunk{"$cfrom\_$cto"};
       eval $cfrom; return $_;
    }
}
return $enstring;
}


1;