|
ru.cgi.perl
- RU.CGI.PERL ------------------------------------------------------------------
From : Alan Long 2:5030/1082.72 10 Oct 2002 02:40:34
To : All
Subject : Upload file form
--------------------------------------------------------------------------------
Hello All!
Вот тут столкнулся с проблемой - не работает upload ;-(
То есть он как-то избирательно работает - в Mozilla и Opera работает, а вот в
MSIE - облом.
Вот кусок кода ответственный за все это хозяйство, выдрано с мязом из одного
класса, так что сильно не пинать, так как полностью все это хозяйство приводить
- достаточно длинно.
Вот:
use strict;
my %MimeTypes = (
'image/gif' => 'gif',
'image/jpeg' => 'jpg',
'image/png' => 'png',
'image/tiff' => 'tif',
'image/x-xbitmap' => 'xbm',
'image/x-xpixmap' => 'xpm',
'video/x-mng' => 'mng',
'image/x-ms-bmp' => 'bmp',
'application/x-shockwave-flash' => 'swf',
);
sub uniq {
# возврщает уникальный номер ~ 32 символа
}
sub dir {
# Возвращает директорию куда нужно складывать принятые файлы
}
sub base {
# Добавляет базовый путь
# oчень похоже на join('/', $self->{BASE}, @_ );
}
sub debase {
# Убираеь базовый путь,
# очень похоже на s%^\Q$self->{BASE}\E/%%;
}
sub save_file {
my $self = shift;
my $type = shift;
my $in = shift;
my $out;
my $ext;
local *OUT;
return undef
if( not defined $type or not defined $in );
$ext = $MimeTypes{ lc $type };
return undef
if( not defined $ext );
do {
my $uniq = $self->uniq;
$out = $self->base( $self->dir, join('.', $uniq, $ext ) );
} while( -e $out );
open( OUT, "> $out" ) and do {
local $_;
binmode( OUT );
binmode( $in );
if( ref $in ) {
local $_;
while( <$in> ) {
print OUT $_;
}
} else {
print OUT $in;
}
close( OUT );
};
return $out;
}
sub upload {
my $self = shift;
my $q = shift; # CGI.pm object
my $param = shift; # имя <input type="file" name="..." ...>
my $rc;
if( defined $param and $q ) {
my $info = $q->uploadInfo( $q->param( $param ) );
my $in = $q->upload( $param );
$rc = $self->save_file( $info->{'Content-Type'}, $in )
if( defined $in );
$rc = $self->debase( $rc );
}
return $rc;
}
__END__
--
With best,
Ъ-· Ъ
Е-ЧLaі\і <alan@x-rays.eu.org>
--- timEd/386 1.10+
* Origin: X - Rays Station (2:5030/1082.72)
Вернуться к списку тем, сортированных по: возрастание даты уменьшение даты тема автор
|
