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

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> fork, системные вызовы и kill 
:(
    Опции темы
cerberon
Дата 29.6.2010, 16:37 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 4
Регистрация: 15.4.2010

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



Есть код, который порождает child'ов, которые в свою очередь вызывают команду через system/exec/``. Родитель в некоторый момент убивает потомков, при этом вызванная команда продолжает работать, что не есть хорошо.
Ближе к коду, задача скрипта: считать урлы из файла и запустить рекурсивную скачку wget'ом, по достижении лимита загруженных страниц - прервать закачку, сам код (извиняюсь за комменты в С-стиле, решетку ставить неудобно):
Код

my $file=$ARGV[0]; //в качестве аргумента получаем файл со списком урлов

open URLS, "<$file" or terminate("Can't open URL file $file: $!");

my @threads=();

while (my $url=<URLS>)
{
    chomp $url;
    next if $url=~/^#/;

    my $sitename;
    $sitename=($url=~/^http:\/\/([^\/]+)/)?$1:$url;
    mkdir "$cfg{save_dir}/$sitename" or terminate("Can't create directory $cfg{save_dir}/$sitename") if !(-d "$cfg{save_dir}/$sitename");

    while(scalar @threads>=$cfg{thread}) //если превышен лимит потомков, проверяем потомки на предмет возможности их завершения
    {
        check_thread();
        sleep(1);
    }
    my @files=`find $cfg{save_dir}/$sitename -type f`; //ищем загруженные файлы
    if (scalar @files<$cfg{limit}) 
    {
        my $th=fork();  //порождаем потомка если лимит страниц не достигнут
        if ($th==0)
        {
            start_wget($url); //в потомке запускаем wget
            exit(1);
        }
        elsif (!defined($th))
        {
            terminate("Can't fork child: $!");
        }
        else
        {
            push @threads,[$th,$sitename]; //в родителе сохраняем pid 
        }
    }
}

while (scalar(@threads)) //пока есть живой потомок, проверяем
{
    check_thread();
    sleep(1);         
}

exit(0);

sub start_wget
{
    my $url=shift;
    my $sitename;
    $sitename=($url=~/^http:\/\/([^\/]+)/)?$1:$url;
    $url='http://'.$url if $url!~/^http/;
    system("wget","$url","-nv","-nc","-np","-nH","-rl0","-t5","$cfg{wget}","-P$cfg{save_dir}/$sitename"); 
}

sub check_thread
{
    for (my $i=0; $i<scalar @threads;++$i) 
    {
        my $sitename=$threads[$i]->[1];
        my @files=`find $cfg{save_dir}/$sitename -type f`;
        my $nfiles=scalar(@files);
        debug("Download $nfiles files");
        if ($nfiles>=$cfg{limit}||!(kill 0,$threads[$i]->[0])) //проверяем завершились ли потомки, или достигли лимита загруженных страниц
        {
            debug("Downloading $sitename finished with $nfiles files");
            kill TERM => $threads[$i]->[0]; //убиваем 
            splice(@threads,$i,1);
            $i--;        
        }        
    }
}

В итоге имеем, что потомок убит, родитель завершился, а wget продолжает закачку. Пробовал и обратные кавычки, результат тот же.
PM MAIL   Вверх
cerberon
Дата 30.6.2010, 12:08 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 4
Регистрация: 15.4.2010

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



пока ничего лучше:
Код

my $ps=`ps -ef | awk '{print \$2,\$3}' | grep ' $threads[$i]->[0]'`;
my $wget_pid=(split ' ',$ps)[0];
kill TERM => $wget_pid if defined $wget_pid;

не придумалось, но хоть работает
PM MAIL   Вверх
DurRandir
Дата 30.6.2010, 17:42 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 335
Регистрация: 27.9.2009

Репутация: 14
Всего: 17



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


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

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


 




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


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

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