Модераторы: korob2001, ginnie
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Докачка файла, mod_perl2 
:(
    Опции темы
ежик
  Дата 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

--------------------
Прежде чем задать вопрос прочитай инфу!!!
PM MAIL ICQ   Вверх
ежик
  Дата 6.5.2007, 12:49 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


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

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



После долгих изысканий по инету.
брал за основу 
Я натворил следующее 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 
--------------------
Прежде чем задать вопрос прочитай инфу!!!
PM MAIL ICQ   Вверх
nitr
Дата 6.5.2007, 14:27 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


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

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



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


--------------------
PM   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Perl: CGI программирование"
korob2001
sharq
  • В этом разделе обсуждаются вопросы относящиеся только к CGI программированию
  • Если ваш вопрос не относится к системному или CGI программированию, задавайте его в общем разделе
  • Если ваш вопрос относится к системному программированию, задавайте его здесь
  • Интерпретатор Perl можно скачать здесь ActiveState, O'REILLY, The source for Perl
  • Справочное руководство "Установка perl-модулей", качать здесь


Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, korob2001, sharq.

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


 




[ Время генерации скрипта: 0.0734 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.