VPF::Докачка файла - Форум программистов

ежик

Дата 6.5.2007, 06:20 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 115
Регистрация: 19.9.2005
Где: Южно-Сахалинск

Репутация: нет
Всего: 1

Apache2
mod_perl2
Win-да

Пользователю надо выдать файл используя mod_perl2:

Код


package Download;

use strict;
use warnings FATAL => 'all';
use locale;
use POSIX 'locale_h';
setlocale(LC_CTYPE, "ru_RU.CP1251");

use mod_perl2;

use Apache2::RequestRec ();
use Apache2::RequestIO ();
use Apache2::RequestUtil ();
use APR::UUID ();
use APR::Pool ();
use Apache2::Log ();
use Apache2::Const -compile => qw(OK DECLINED);
use APR::Const    -compile => 'SUCCESS';


 sub handler {
         my $r = shift;

     $r->content_type('text/plain');

     my $status;
     if (defined($r->subprocess_env('HTTP_RANGE'))) {

       my @size = split('=',$r->subprocess_env('HTTP_RANGE'));
       $size[1] =~ s/-//;
       $status = $r->sendfile('D:\\tmp\\Video.avi',$size[1]);
     }
     else {
       $status = $r->sendfile('D:\\tmp\\Video.avi');
     }

     die "sendfile has failed" unless $status == APR::Const::SUCCESS;

 $r->pool->cleanup_register(\&cleanup);

     return Apache2::Const::OK;
 }

 sub cleanup {
     my $file = shift;

     return Apache2::Const::OK;
 }

sub DESTROY {
  my $self = shift;
}
1;
__END__

Настройки Apache

Код


  <Location /download>
    SetHandler modperl
    PerlResponseHandler Download
    PerlOptions +ParseHeaders +SetupEnv
    Options None
  </Location>

Все нормально файл он выдает, но вот только при попытке докачать файл опера начинает закачивать его поновой.

Подскажите может я забыл указать еще чтото????

Цитата

Content-Length

--------------------

Прежде чем задать вопрос прочитай инфу!!!

ежик

Дата 6.5.2007, 12:49 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 115
Регистрация: 19.9.2005
Где: Южно-Сахалинск

Репутация: нет
Всего: 1

После долгих изысканий по инету.
брал за основу

Цитата

http://xpoint.ru/know-how/Perl/GotovyieResheniya/CGI

Я натворил следующее smile

Код


package Download;

use strict;
use warnings FATAL => 'all';
use locale;
use POSIX 'locale_h';
setlocale(LC_CTYPE, "ru_RU.CP1251");

use mod_perl2;

use File::Spec::Functions qw(catfile);

use Apache2::RequestRec ();
use Apache2::RequestIO ();
use Apache2::RequestUtil ();
use APR::UUID ();
use APR::Pool ();
use Apache2::Log ();
use Apache2::Const -compile => qw(OK DECLINED HTTP_PARTIAL_CONTENT);
use APR::Const    -compile => 'SUCCESS';

sub handler {
  my $r = shift;
  # $filepath - полный путь к файлу на диске
  my $filepath = catfile('D:/tmp/', 'Video.avi');


  # Получаем размер файла
  my $size = -s $filepath;

  my $range = 0;
  # Нижняя граница
  my $rlow = 0;
  # Верхняя граница
  my $rhigh = $size - 1;
  my $lens = $size - 1;
# Проверяем наличие заголовка Range и пытаемся его обработать.
# Вот примеры заголовка из RFC (пример для сущности размером 10000):
# o Первые 500 байт (смещения 0-499, включительно):
# bytes=0-499
# o Вторые 500 байт (смещения 500-999, включительно):
# bytes=500-999
# o Последние 500 байт (смещения 9500-9999, включительно):
# bytes=-500
# o или
# bytes=9500-

# Если размер неизвестен, пропускаем обработку заголовка Range
  if (defined($size) && defined($r->subprocess_env('HTTP_RANGE'))) {
    my @input = split('=',$r->subprocess_env('HTTP_RANGE'));
    my ($offset,$len) = split('-',$input[1]);
    Apache2::ServerRec::warn("zap = $offset,$len.");
    $range = 1;
    if ($len eq '' && $offset > 0) {
    $rlow = $offset;
    }
    elsif ($offset eq '' && $size - $len > 0) {
      $rlow = $size - $len;
    }
    elsif ($offset <= $len) {
      $rlow = $offset;
      $rhigh = $len;
      $lens = $len - $offset;
      $range = 2;
    }
    else {
      $range = 0;
    }
  }



  # Выводим заголовки
  if ($range) {
    Apache2::ServerRec::warn('range');
    $r->headers_out->set('Content-Range'=>"bytes $rlow-$rhigh/$size");
    Apache2::ServerRec::warn("$rlow-$rhigh/$size");
    $size = $rhigh - $rlow + 1;
  }
  Apache2::ServerRec::warn("size = $size");
  $r->headers_out->set('Accept-Ranges'=>'bytes');
  $r->headers_out->set('Content-Length'=>$size) if ($size > 0);
  $r->content_type('application/zip; name=kiss.zip');
  $r->headers_out->set('Content-Disposition'=>'attachment; filename=kiss.zip');
  my $status;
  if ($range == 1) {
    Apache2::ServerRec::warn("offset = $rlow");
    $status = $r->sendfile($filepath,$rlow);
  }
  elsif ($range == 2) {
    Apache2::ServerRec::warn("offset = $rlow, len = $lens");
    $status = $r->sendfile($filepath,$rlow,$lens);
  }
  else {
    Apache2::ServerRec::warn('send');
    $status = $r->sendfile($filepath);
  }

  die "sendfile has failed" unless $status == APR::Const::SUCCESS;

  $r->pool->cleanup_register(\&cleanup);
  if ($range) {
    Apache2::ServerRec::warn('206');
    $r->status(Apache2::Const::HTTP_PARTIAL_CONTENT);
    return Apache2::Const::HTTP_PARTIAL_CONTENT;
  }
  else {
    Apache2::ServerRec::warn('OK');
    $r->status(Apache2::Const::OK);
    return Apache2::Const::OK;
  }
 }

 sub cleanup {
     my $file = shift;
     return Apache2::Const::OK;
 }

sub DESTROY {
  my $self = shift;
  #Apache2::ServerRec::warn($size);
}
1;
__END__

Если использовать FleshGet то все нормуль качает по частям и докачка идет на ура.
Вот если Оперой пытаюсь докачать, то начинает каждый раз по новому и общий размер каждый раз все меньше и меньше.

Я уже обкурился этими мануалами.............. smile

Просто незнаю где еще рыть?!?!?!?!?!?!?!?!?!?!?
smile

--------------------

Прежде чем задать вопрос прочитай инфу!!!

nitr

Дата 6.5.2007, 14:27 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 2543
Регистрация: 10.2.2006
Где: Россия :)

Репутация: 12
Всего: 84

ежик, честно этим не занимался, но что-что, а Опера (последний билд) у меня так и недокачивает ничего, всегда заново начинала, когда любой качалкой (FlashGet, ReGet, wget и т.д. и т.п.) все нормально.
Может не стоит смотреть в сторону Оперы?
Но вроде статья нормальная...

--------------------

I love ArchLinux

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Perl: разработка для Web \| Следующая тема »