Аплоад картинок, также легко становится аплоадом других файлв в бинарном режиме...
Код:
#!/usr/bin/perl
use CGI qw/param/;
$upload_dir=\'../../fimg\';
if (param(\'action\') eq \'upload\') {
($check,$filename,$size)=upload();
&showform;
} else {
&showform;
}
sub showform {
print "Content-type:text/html;Charset:windows-1251\\n\\n";
print <
HTML
if (defined $check) {
print "Успешность операции: $check
\\nИмя файла: $filename
\\nРазмер(ошибка, если операция не успешна): $size\\n";
}
}
sub upload {
local $buffer;
local $check=1;
local $errmes=\'\';
local $file=param(\'filename\');
local $filename=$file;
local $size=0;
$filename=~s/^.*\\\\//igs;
$filename=~s/\\|//gs;
if (!$filename) {$errmes="Невозможное имя файла!"; $check=0;}
if ($filename!~/(\\.jpg)|(\\.gif)|(\\.png)|(\\.bmp)|(\\.tif)|(\\.tiff)/i) {$errmes=\'Неизвестный формат!\'; $check=0;}
if (-e "$upload_dir/$filename") {$errmes="Файл \'$filename\' уже существует!"; $check=0;}
if ($check==1) {
binmode($file);
open(IF, ">$upload_dir/$filename") or die $!;
binmode IF;
while (read($file,$buffer,1024)) {print IF $buffer; $size++;}
close(IF);
chmod 0744, "$upload_dir/$filename";
$size.=\'кб\';
}
if ($check==1) {return ($check,$filename,$size);} else {return ($check,$filename,$errmes);}
}