[PERL] ускорить скрипт

И всё прочее, что касается HTML
Правила форума
Убедительная просьба юзать теги [code] при оформлении листингов.
Сообщения не оформленные должным образом имеют все шансы быть незамеченными.
Аватара пользователя
Alex Keda
стреляли...
Сообщения: 35462
Зарегистрирован: 2004-10-18 14:25:19
Откуда: Made in USSR
Контактная информация:

[PERL] ускорить скрипт

Непрочитанное сообщение Alex Keda » 2009-03-14 20:01:04

есть несложный скрипт на перл.
достаёт юзеров ispmanager, вызывает ps - снять статистику по процессам, записывает результаты в файл.
смущает время работы:

Код: Выделить всё

0.82 real         0.50 user         0.17 sys
многовато... 500 процессов, 193 юзера

Код: Выделить всё

srv$ cat /root/scripts/work/resource.usage.pl
#!/usr/bin/perl -w
# пеерписываение одноменнёого срипта на шелле.
# начато 2009-03-12 в 20:44
# цель - ускорить работу и уточнить статистику.
# от rrd, пока отказываюсь, перл с ним работать умеет, но я - нет =)

$txt_bases_preffix="/var/db/resusage/txt/" . print_year(time()) . "/" . print_month(time()) . "/" . print_day(time());

# проверяем наличие директории, если надо - создаём.
if ( -d $txt_bases_preffix ){ # есть директория
}else{  # есть директория --> нет директории
        `/bin/mkdir -m 0751 -p $txt_bases_preffix`
}

# /bin/ps -axo user,%cpu,%mem | /usr/bin/awk '{print $1, $2, $3}' | /usr/bin/sort
# дёргаем список процессов
open (MYPS, "/bin/ps -axo user,%cpu,%mem |");
# сохраняем список процессов в массив
@list_proc = <MYPS>;
# закрываем
close MYPS;

#foreach $stroka ( @list_proc ){ print "строка = $stroka\n";}
#exit;

# grep Account /usr/local/ispmgr/etc/ispmgr.conf | awk '{print $2}' | sed 's/"//g'
# дёргаем список юзеров
open (MYTMP, "/usr/local/ispmgr/etc/ispmgr.conf");
# сохраняем в массив содержимое - построчно
@tmp = <MYTMP>;
# закрываем
close MYTMP;

#my @user_list;
# перебираем массив строк из MYTMP. Надо достать зверьков
# # в отдельный массив
foreach $stroka ( @tmp )
{
        ($tmp1,$user_name) = split('\s', $stroka);
        if($tmp1 eq "Account"){
                if($user_name =~ /^"h\d+"$/){
                        # имя пользователя
                        $user_name =~ s/\"//g;
                        # время ЦПУ
                        my $cpu = 0;
                        # сколько процентов рамы
                        my $ram = 0;
                        # Сколько процессов запущщено
                        my $proc = 0;
                        # запускаем перебор массива процессов.
                        foreach $line ( @list_proc ){
                                ($tmp_user, $tmp_cpu, $tmp_ram) = split('\s+', trim($line));
                                if($tmp_user eq $user_name){
                                        #print "$line = $tmp_user ; $tmp_cpu ; $tmp_ram\n";
                                        $cpu = $cpu + $tmp_cpu;
                                        $ram = $ram + $tmp_ram;
                                        $proc = $proc + 1;
                                }       # закрытие - в строке данные по пользователю
                        }       # закрытие перебора процессов по данному зверьку
                        #print "$user_name = $cpu $ram $proc\n";
                        # открываем файл со статистикой на дозапись
                        open (LOGFILE, ">>$txt_bases_preffix/$user_name.all.txt");
                        print LOGFILE $cpu . "  " . $ram . "    " . $proc . "\n";
                        close LOGFILE;
                }       # закрытие имя юзера попадает под шаблон
        }       # закрытие - строка описания аккаунта
}       # закрытие перебора конфига ispmgr.conf

# functions
sub trim {
        my($string)=@_;
        return $string unless $string;
        for ($string) {
                s/^\s+//;
                s/\s+$//;
        }
        return $string;
}

sub print_date {
        my ($date) = @_;
        my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime ($date);
        return (1900 + $year) . "-" . sprintf("%02u", ++$mon) . "-" . sprintf("%02u", $mday);
}

sub print_year {
        my ($date) = @_;
        my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime ($date);
        return (1900 + $year);
}

sub print_month {
        my ($date) = @_;
        my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime ($date);
        return sprintf("%02u", ++$mon);
}

sub print_day {
        my ($date) = @_;
        my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime ($date);
        return sprintf("%02u", $mday);
}


srv$   
Убей их всех! Бог потом рассортирует...

Хостинговая компания Host-Food.ru
Хостинг HostFood.ru
 

Услуги хостинговой компании Host-Food.ru

Хостинг HostFood.ru

Тарифы на хостинг в России, от 12 рублей: https://www.host-food.ru/tariffs/hosting/
Тарифы на виртуальные сервера (VPS/VDS/KVM) в РФ, от 189 руб.: https://www.host-food.ru/tariffs/virtualny-server-vps/
Выделенные сервера, Россия, Москва, от 2000 рублей (HP Proliant G5, Intel Xeon E5430 (2.66GHz, Quad-Core, 12Mb), 8Gb RAM, 2x300Gb SAS HDD, P400i, 512Mb, BBU):
https://www.host-food.ru/tariffs/vydelennyi-server-ds/
Недорогие домены в популярных зонах: https://www.host-food.ru/domains/

paradox
проходил мимо
Сообщения: 11620
Зарегистрирован: 2008-02-21 18:15:41

Re: ускорить скрипт

Непрочитанное сообщение paradox » 2009-03-14 20:06:49

регекспы наверное много кушают
переписать его на С
))))

Аватара пользователя
Alex Keda
стреляли...
Сообщения: 35462
Зарегистрирован: 2004-10-18 14:25:19
Откуда: Made in USSR
Контактная информация:

Re: ускорить скрипт

Непрочитанное сообщение Alex Keda » 2009-03-14 20:07:17

paradox писал(а):регекспы наверное много кушают
переписать его на С
))))
ниасилю...
Убей их всех! Бог потом рассортирует...

paradox
проходил мимо
Сообщения: 11620
Зарегистрирован: 2008-02-21 18:15:41

Re: [PERL] ускорить скрипт

Непрочитанное сообщение paradox » 2009-03-14 20:08:54

упростить герекспы

Аватара пользователя
Alex Keda
стреляли...
Сообщения: 35462
Зарегистрирован: 2004-10-18 14:25:19
Откуда: Made in USSR
Контактная информация:

Re: [PERL] ускорить скрипт

Непрочитанное сообщение Alex Keda » 2009-03-14 20:34:22

например?
Убей их всех! Бог потом рассортирует...

paradox
проходил мимо
Сообщения: 11620
Зарегистрирован: 2008-02-21 18:15:41

Re: [PERL] ускорить скрипт

Непрочитанное сообщение paradox » 2009-03-14 20:46:54

ну я перл не очень знаю
а тем более его и вообщем регекспы)
но грузят именно они

я почти уверен на все 95 8)

zg
полковник
Сообщения: 5845
Зарегистрирован: 2007-12-07 13:51:33
Откуда: Верх-Нейвинск

Re: [PERL] ускорить скрипт

Непрочитанное сообщение zg » 2009-03-14 21:24:14

lissyara писал(а):foreach $line ( @list_proc ){
у тебя количество итераций равно произведению двух массивов @list_proc на @tmp, то есть 500 процессов, как я понял, на 193 пользователя - итого примерно сто тысяч оборотов. Я бы упразднил циклы.

Аватара пользователя
Alex Keda
стреляли...
Сообщения: 35462
Зарегистрирован: 2004-10-18 14:25:19
Откуда: Made in USSR
Контактная информация:

Re: [PERL] ускорить скрипт

Непрочитанное сообщение Alex Keda » 2009-03-14 23:28:10

верно.
я тоже про это думал - но идеи как именно - не родилось...
Убей их всех! Бог потом рассортирует...

paradox
проходил мимо
Сообщения: 11620
Зарегистрирован: 2008-02-21 18:15:41

Re: [PERL] ускорить скрипт

Непрочитанное сообщение paradox » 2009-03-14 23:38:47

а без поиска по списку процессов а дергании ps ax юзера нельзя?
тогда один цикл поидеи отпадает

Аватара пользователя
f_andrey
майор
Сообщения: 2651
Зарегистрирован: 2007-12-26 1:22:58
Откуда: СПб
Контактная информация:

Re: [PERL] ускорить скрипт

Непрочитанное сообщение f_andrey » 2009-03-14 23:40:09

А если исполизовать не массив а хеш массивов, как реализовать не скаже но вроде по сути тебе нужно именно оно, просто перл только начинаю изучать и пока на этапе всяких определений, и для чего нужны какие структуры, до реализации не добрался но онаа вроде хорошо рассмотрена в Ореливских книжках например в этой, ну и еше видел кукбук, но там конкретные советы в основном что да как.
Если ваша тема перенесена, то смотри http://forum.lissyara.su/viewtopic.php?f=1&t=32308

zg
полковник
Сообщения: 5845
Зарегистрирован: 2007-12-07 13:51:33
Откуда: Верх-Нейвинск

Re: [PERL] ускорить скрипт

Непрочитанное сообщение zg » 2009-03-14 23:48:29

большие циклы можно отдать на съеденье муси, там алгоритмы обработки оптимизированы до безобразия.

Либо оптимизировать цикл, работая только с целевыми данными. Но для этого нада определить целостность данных. То есть, если один процесс может принадлежать только одному пользователю, и при этом имя пользователя уникально, то я бы просто создал хэш-массив по пользвателю с суммой нужных значений. Потом перебрал всех пользоватлей и выделил нужных. Таким образом количество итераций высчитывалось бы по сумме, а не произведению.

Но в любом случае отказался бы от вложенных циклов.

Аватара пользователя
Alex Keda
стреляли...
Сообщения: 35462
Зарегистрирован: 2004-10-18 14:25:19
Откуда: Made in USSR
Контактная информация:

Re: [PERL] ускорить скрипт

Непрочитанное сообщение Alex Keda » 2009-03-14 23:49:50

paradox писал(а):а без поиска по списку процессов а дергании ps ax юзера нельзя?
тогда один цикл поидеи отпадает
ну, мне надо достать процессы юзера...
так выглядело на шелле:

Код: Выделить всё

ps -axo user,%cpu,%mem | awk '{print $1, $2, $3}' | sort > $pslog
# get users
grep Account /usr/local/ispmgr/etc/ispmgr.conf | awk '{print $2}' | sed 's/"//g' |
{
while read username
do
        # get statistics
        cpu="`grep "^$username " $pslog | awk '{cpu += $2; mem += $3}; {print $1, cpu, mem}' | tail -n1 | awk '{print $2}' | sed s/,/./`"
        mem="`grep "^$username " $pslog | awk '{cpu += $2; mem += $3}; {print $1, cpu, mem}' | tail -n1 | awk '{print $3}'| sed s/,/./`"
        count="`grep "^$username " $pslog | wc -l | awk '{print $1}'`"
        # users without runnings processes
        if [ $count -eq 0 ]
        then
                cpu="0"
                mem="0"
        fi
        echo "$cpu      $mem    $count" >> $txt_bases_preffix/$username.all.txt
done
}
время работы и использование ЦП неприемлимо - десяток секунд.
Убей их всех! Бог потом рассортирует...

paradox
проходил мимо
Сообщения: 11620
Зарегистрирован: 2008-02-21 18:15:41

Re: [PERL] ускорить скрипт

Непрочитанное сообщение paradox » 2009-03-14 23:52:40

шел и перл всетаки разница...


хотя идея с хешами тоже интересна

Аватара пользователя
Alex Keda
стреляли...
Сообщения: 35462
Зарегистрирован: 2004-10-18 14:25:19
Откуда: Made in USSR
Контактная информация:

Re: [PERL] ускорить скрипт

Непрочитанное сообщение Alex Keda » 2009-03-14 23:53:06

zg писал(а):большие циклы можно отдать на съеденье муси, там алгоритмы обработки оптимизированы до безобразия.
тоже подумывал запхать всё тупо в мусю...
вплоть до лоад дата фром филе, а дальше колбаснуть процедурой или ещё чем...
чё-то хочеться остаться в пределах файловой системы... незнаю почему =)
zg писал(а):Либо оптимизировать цикл, работая только с целевыми данными. Но для этого нада определить целостность данных. То есть, если один процесс может принадлежать только одному пользователю, и при этом имя пользователя уникально, то я бы просто создал хэш-массив по пользвателю с суммой нужных значений. Потом перебрал всех пользоватлей и выделил нужных. Таким образом количество итераций высчитывалось бы по сумме, а не произведению.

Но в любом случае отказался бы от вложенных циклов.
до этого пока не дорос...
третий день серьёзно перлом занимаюсь - четвёртый скрипт переписываю с шелла на перл =))
Убей их всех! Бог потом рассортирует...

zg
полковник
Сообщения: 5845
Зарегистрирован: 2007-12-07 13:51:33
Откуда: Верх-Нейвинск

Re: [PERL] ускорить скрипт

Непрочитанное сообщение zg » 2009-03-14 23:56:43

lissyara писал(а):время работы и использование ЦП неприемлимо - десяток секунд.
я бы обошёлся одним awk :roll:
lissyara писал(а):cpu="`grep "^$username " $pslog | awk '{cpu += $2; mem += $3}; {print $1, cpu, mem}' | tail -n1 | awk '{print $2}' | sed s/,/./`"
кпд данного куска кода 5% :smile:
paradox писал(а):шел и перл всетаки разница...
ноги, крылья... главное хвост :smile:

Аватара пользователя
ProFTP
подполковник
Сообщения: 3388
Зарегистрирован: 2008-04-13 1:50:04
Откуда: %&й
Контактная информация:

Re: [PERL] ускорить скрипт

Непрочитанное сообщение ProFTP » 2009-03-14 23:57:15

лиса, а где именно проблемы в скорости?


сделай потоки?

или что ты хочешь?
Pеrl FAQ
perl -e 'print join"",map $$_[rand@$_],([0..9,'a'..'z','A'..'Z'])x30'
ИзображениеИзображение

Аватара пользователя
Alex Keda
стреляли...
Сообщения: 35462
Зарегистрирован: 2004-10-18 14:25:19
Откуда: Made in USSR
Контактная информация:

Re: [PERL] ускорить скрипт

Непрочитанное сообщение Alex Keda » 2009-03-15 0:06:38

как и гриф, думаю, в количестве циклов.
с меньшим количеством циклов, и с большими потоками данных, мои же скрипты работают быстрей.
Убей их всех! Бог потом рассортирует...

Аватара пользователя
Alex Keda
стреляли...
Сообщения: 35462
Зарегистрирован: 2004-10-18 14:25:19
Откуда: Made in USSR
Контактная информация:

Re: [PERL] ускорить скрипт

Непрочитанное сообщение Alex Keda » 2009-03-15 0:08:08

да, задача не ускорить скрипт вообще.
задача заставить его кушать меньше ЦП и систему
в принципе, ускорив его более чем на порядок, по сравению с шелом - задача выполнена.
но - вопрос возник из-за того, что сомтрю на код, и понимаю что криво =)))
Убей их всех! Бог потом рассортирует...

Аватара пользователя
ProFTP
подполковник
Сообщения: 3388
Зарегистрирован: 2008-04-13 1:50:04
Откуда: %&й
Контактная информация:

Re: [PERL] ускорить скрипт

Непрочитанное сообщение ProFTP » 2009-03-15 0:10:18

а счего ты взял что именно из-за perl?

можешь замерять участки кода по скорости работы специальным модулем http://search.cpan.org/~pkent/Test-Time ... mestamp.pm , увидеть где именно медленно работает...

если нужно обработать много гемороя, вот потоки для этого дела:

Код: Выделить всё

#!/usr/bin/perl
use strict;
#Не работает если перл собран без поддержики
use threads;
use threads::shared;
use Data::Dumper;
use IO::Handle;
    #прочитаем массив ссылок из файла, предназначенных для обработки
open(TEST,"<test.txt") or die ("Can not open file for reading : $!");
my @urls=<TEST>;
close(TEST) or die ("Can not close file : $!");
    #чтобы вводилось сразу
STDOUT->autoflush(1);
    #Создадим разделяемый индекс указывающий на следующий элемент массива для обработки
my $sh_ind = 0;
share($sh_ind);
    #Создадим массив потоков которые будут обрабатывать наш массив
my $th_amount = 10;
foreach (0..$th_amount) {
    threads->create(\&check_url, \@urls);
}
print "Main: make all threads!\n";
    ### Collect the bits and pieces! ...
$_->join foreach threads->list;
print "Main: END!\n";
    #процедура работы дочерних потоков
sub check_url { 
    my $p_arr = shift;
    
    my $tid    = threads->tid();
    print "Thread ($tid): START\n";
    my $max_ind = $#$p_arr;
    my $time_wait;
    my $work_ind;
    while(1) {
    {
        lock($sh_ind);
        $work_ind = $sh_ind;
        if($work_ind <= $max_ind) {
        $sh_ind++;    #увеличиваем индекс для последующей обработки 
        }
    }
    print "Thread ($tid): index for work = $work_ind\n";
    if($work_ind > $max_ind) {    #Завершим работу если индекс стал больше чем количество элементов
        last
    };
        #вместо реальной работы просто засыпаем на произвольное число секунд от 1 до 3
    $time_wait = 1+int(rand 3);
    print "Thread ($tid): w_time=$time_wait, urls: $p_arr->[$work_ind]";
    sleep  $time_wait;
    }
    
    print "Thread ($tid): END\n";
}
вот еще пример

Код: Выделить всё

#!/usr/bin/perl -w
use IO::File;
use POSIX 'WNOHANG';
use strict;
use Data::Dumper;
#Мультипроцессная программа-пример, простейшая система состоящая из главного процесса, и нескольких подчиненных 
#процессов - рабочих, главный процесс порождает рабочих, дает им один общий канал для отчетов(для передачи данных
#от рабочего - главному) и индивидуальные каналы для передачи данных от главного к каждому конкретному рабочему
# для получения задания рабочим. Создав рабочих главный начинает раздавать команды.
# После создания рабочий обращается к главному с просьбой дать задание, по завершении которого передает ответ главному
# Главный получает отчеты и раздает приказы.
my $max_workers = 10;
my $quit = 0;
my %childs;
my $cnt_worker;
my $w_ready = 1;    #готов к работе
my $w_end_w = 2;    #закончил работу, обработал
my $b_wrk   = 1;    #обработай
my $b_cls   = 2;    #завершись
my $deb1    = 0;    #вывод отладочной информации 1
    #Прочитаем список URLs которые необходимо обработать
    #прочитаем массив ссылок из файла, предназначенных для обработки
open(TEST,"<test.txt") or die ("Can not open file for reading : $!");
my @urls=<TEST>;
map {chomp} @urls;
close(TEST) or die ("Can not close file : $!");
    #Установим обработчиков сигналов
$SIG{PIPE} = 'IGNORE';
$SIG{CHLD} = 'sig_child';
    #может быть здесь стоит убить и порожденные процессы  или они сами умрут когда умрет лидер?
$SIG{TERM} = $SIG{INT} = sub{$quit++};
    #Порождаем процессы которые будут выполнять основную работу и докладывать "хозяину", 
    #хозяин же, будет давать работу! через индивидуальные командные каналы
my  ($res_mk_cmd, $fh_boss, $fh_worker);
pipe(READER, WRITER) or die "pipe no good: $!";
$| = 1;
my($i);
my $child;
for($i = 0; $i < $max_workers; $i++) {
    #При создании worker создаем индивидуальный командный канал
    $fh_boss = undef;                #ЭТО очень ОБЯЗАТЕЛЬНОЕ действие!
    $res_mk_cmd = pipe($fh_worker, $fh_boss);
    die "Can't make command pipe: $!" unless defined $res_mk_cmd;
    $child = fork();
    die "Can't fork: $!" unless defined $child;
    if ($child == 0) { #Work inchild process
    close $fh_boss;
    close READER;
    do_child($fh_worker);
    exit(0);
    }
    #Установим не буферизированный вывод при передаче команд worker процессу
    select $fh_boss; $| = 1;
    select STDOUT;
    close $fh_worker;
    #Сохраним данные о child процессе в хеше 
    $childs{$child} = {id=>$i, fh_cmd=>$fh_boss};  
    print "Main: Build child pid $child id $i\n" if $deb1;
}
close WRITER;
print "Main: I build $i worker\n" if $deb1;
$cnt_worker = $i;
    #Все процессы рабочие готовы, начинаем раздачу заданий и прием ответов
my $cur_id_urls = 0;
my $in;
my ($id_rep,$mess);
my ($m_id, $m_res);
    #Будем работать 
    #пока ненадо выйти, есть рабочие, нет ошибок чтения отчетов от рабочих, и пока не обработали все ссылки
while (!$quit and ($cnt_worker > 0) and defined ($in = <READER>)) {
        # and ($cur_id_urls =< $#urls)
        #Итак принимаем доклад
    print "Main: get report: $in"  if $deb1;
    chomp $in;
    ($child, $id_rep, $mess) = split(/:/, $in);
    #Проверим есть ли у нас вообще такой работник
    if(!defined($childs{$child})) {    #Нет? ужас!!! откуда он взялся!
    print "Main: get report from unknown child($child)!\n" if $deb1;
    next;
    }    
    #Расшифровываем о чем этот доклад
    if($id_rep == $w_end_w) {
    print "Main: childs($child), reported end work!\n" if $deb1;
    ($m_id, $m_res) = split(/,/, $mess);
    #print "Main: URLs($m_id)='$urls[$m_id]', is '$m_res'\n";
    print "($child): URLs($m_id)='$urls[$m_id]', is '$m_res'\n";
    } elsif($id_rep == $w_ready) {
    print "Main: child($child), reported ready work!\n" if $deb1;
    } else {
    print "Main: child($child), send bad report '$id_rep', with message '$mess'\n" if $deb1;
    }
    #Даем задание рабочему если в этом есть необходимость
    my $fh = $childs{$child}->{fh_cmd};
    if($cur_id_urls <= $#urls) { #Есть еще не обработанные задания?
    print "Main($$): put new cmd 'JOB' to worker($child)\n" if $deb1;
    print $fh "$b_wrk:$cur_id_urls\n";
    $cur_id_urls++;
    } else {    #Нет? пошлем рабочему комаду завершиться
    print "Main($$): put new cmd 'END' to worker($child)\n" if $deb1;
    print $fh "$b_cls\n";
    }
}
    #Определим причину по которой завершилась программа
if($quit) {
    print "Exit by quit = $quit\n";
    print "cnt_worker is $cnt_worker\n";
}
if($cnt_worker <= 0) {
    print "Exit by all childs ended!\n";
    print "quit is $quit\n";
    print "cnt_worker is $cnt_worker\n";
}
if($cur_id_urls > $#urls) {
    print "Exit by cur_id_urls($cur_id_urls) gt count urls !\n";
}
#Если остались незавершенные процессы рабочие убъем их, благо информация что это за процессы у нас есть
while($cnt_worker > 0) {
    print "Main: Run worker killer!\n" if $deb1;
    foreach $child (keys %childs) {
    if($childs{$child}->{id} != 0) {
        print "Main: Please child($child) - kill self!\n" if $deb1;
        kill ('TERM', $child);
    }
    }
    sleep 1;
}
print "Main: --------------- A parent End print---------------------\n";
exit(0);
    #Обработка сигнала завершения дочернего процесса
sub sig_child {
    my $child; 
    while(($child = waitpid(-1, WNOHANG)) > 0) {
    my $id = $childs{$child}->{id}; 
    if(defined($id)) {
        #можно пометить процесс как убитый, а можно и ничего не делать
        $childs{$child}->{id} = 0;
        print "Kiled child id $id, PID($child)\n" if $deb1;
    } else {
        print "Kiled unknown child PID($child)\n" if $deb1;
    }
    $cnt_worker--;
    }
}
    #Процедура в которой выполняется работа дочерним процессом
sub do_child {
    my $fh = shift;
    my $quit_child = 0;
    my $timeout    = 5;
    my $job;
    my $res;
    my ($id_cmd, $work);
    #Установим собственный обработчик сигнала завершения процесса
    $SIG{TERM} = $SIG{INT} = sub{$quit_child++};
        #Сделаем так что бы отчет передавался главному процессу без буферизации
    select WRITER; $| = 1;
    select STDOUT;
    #Сообщим что рабочий готов к работе
    print WRITER "$$:$w_ready\n";
    while($quit_child == 0) {
        #Читаем команду от главного
    $job = <$fh>;
        #Задание получено, отработаем
    chomp $job;
    ($id_cmd, $work) = split(/:/, $job);
    if($id_cmd == $b_wrk) {        #Получена команда обработать элемент массива urls, $work-это индекс в urls
        #print "Child($$): work urls($work): '$urls[$work]'!\n";
        #Опять же вместо реальной работы некоторое время ждем от 1 до 2 секунд
        sleep(1+int(rand(2)));    
        #и возвращаем случайный результат где-то ошибка 1 из 5.
        $res  = (int(rand(6))) ? 'ok' : 'bad';
        print WRITER "$$:$w_end_w:$work,$res\n";
    } elsif ($id_cmd == $b_cls) {    #Получена команда завершения работы
        #print "Child($$): get command terminated!!!\n";
        $quit_child++;
    } else {
        print "Child($$): get unknown terminated!!!\n";
    }
    }
    
    close $fh;
    close WRITER;
    print "Child($$): Ended!\n" if $deb1;
}
Pеrl FAQ
perl -e 'print join"",map $$_[rand@$_],([0..9,'a'..'z','A'..'Z'])x30'
ИзображениеИзображение

zg
полковник
Сообщения: 5845
Зарегистрирован: 2007-12-07 13:51:33
Откуда: Верх-Нейвинск

Re: [PERL] ускорить скрипт

Непрочитанное сообщение zg » 2009-03-15 0:27:59

Код: Выделить всё

zg# ps -ax -o user= -o %cpu= -o %mem= | sed 's/,/./g' | awk 'BEGIN{print "USER\tCPU\tMEM\tPROC"}{cpu[$1]+=$2;mem[$1]+=$3;cnt[$1]+=1}END{for(i in cpu){print i"\t"cpu[i]"\t"mem[i]"\t"cnt[i]}}'
USER    CPU     MEM     PROC
pgsql   0       0       4
root    100     0       71
mysql   0       2       2
zg      0       0       2
zg#
вобщем-то без шуму и пыли авк проделал всю грязную работу ;-)

Аватара пользователя
ProFTP
подполковник
Сообщения: 3388
Зарегистрирован: 2008-04-13 1:50:04
Откуда: %&й
Контактная информация:

Re: [PERL] ускорить скрипт

Непрочитанное сообщение ProFTP » 2009-03-15 0:37:04

lissyara писал(а): задача заставить его кушать меньше ЦП и систему
может быть сама /bin/ps ЦП грузит?

померяй участки кода тем модулем http://search.cpan.org/~pkent/Test-Time ... mestamp.pm

я просто не вижу там ничего

этот файл очень большой? >>$txt_bases_preffix/$user_name.all.txt

можешь еще выделить больше памями там где foreash, но я не знаю где именно оно у тебя медленно работает
Pеrl FAQ
perl -e 'print join"",map $$_[rand@$_],([0..9,'a'..'z','A'..'Z'])x30'
ИзображениеИзображение

Аватара пользователя
Alex Keda
стреляли...
Сообщения: 35462
Зарегистрирован: 2004-10-18 14:25:19
Откуда: Made in USSR
Контактная информация:

Re: [PERL] ускорить скрипт

Непрочитанное сообщение Alex Keda » 2009-03-15 0:38:41

Код: Выделить всё

srv# time /tmp/test.sh
USER    CPU     MEM     PROC
nobody  0       0,1     1
root    81,2    7,1     613
h1160   0       3,6     12
mailnull        0       0,1     1
h1081   7,8     1       3
dovecot 0       0,6     6
h1296   1,3     1,1     3
www     4,6     19,9    68
h2029   3,8     1,1     3
h1471   10,4    5       9
h1152   3,3     0,3     1
mysql   0       1,6     2
h1234   3,9     6,9     21
h1200   1,4     2,2     6
h1526   3,5     0,9     3
h1780   1,4     1,1     3
bind    0       1,4     1
h2014   7,5     1       3
h1448   0       0,9     3
lissyara        0       0,6     6
h1960   2,7     0,4     1
h1430   9,6     1,1     3
h1918   12,7    9,9     27
0.027u 0.155s 0:00.66 25.7%     60+884k 0+0io 0pf+0w
srv# cat /tmp/test.sh
#!/bin/sh
ps -ax -o user= -o %cpu= -o %mem= | \
        awk 'BEGIN{print "USER\tCPU\tMEM\tPROC"}{cpu[$1]+=$2;
        mem[$1]+=$3;cnt[$1]+=1}END{for(i in cpu){print i"\t"cpu[i]"\t"mem[i]"\t"cnt[i]}}'

srv#   
надо обмозговать....
Убей их всех! Бог потом рассортирует...

Аватара пользователя
Alex Keda
стреляли...
Сообщения: 35462
Зарегистрирован: 2004-10-18 14:25:19
Откуда: Made in USSR
Контактная информация:

Re: [PERL] ускорить скрипт

Непрочитанное сообщение Alex Keda » 2009-03-15 0:40:44

ProFTP писал(а):этот файл очень большой? >>$txt_bases_preffix/$user_name.all.txt
за сутки не больше 3кб набегает
Убей их всех! Бог потом рассортирует...

Аватара пользователя
ProFTP
подполковник
Сообщения: 3388
Зарегистрирован: 2008-04-13 1:50:04
Откуда: %&й
Контактная информация:

Re: [PERL] ускорить скрипт

Непрочитанное сообщение ProFTP » 2009-03-15 0:44:50

а какая скорость, как ты запускаешь?
Pеrl FAQ
perl -e 'print join"",map $$_[rand@$_],([0..9,'a'..'z','A'..'Z'])x30'
ИзображениеИзображение

Аватара пользователя
Alex Keda
стреляли...
Сообщения: 35462
Зарегистрирован: 2004-10-18 14:25:19
Откуда: Made in USSR
Контактная информация:

Re: [PERL] ускорить скрипт

Непрочитанное сообщение Alex Keda » 2009-03-15 1:03:55

та на шелле чего-то идёт...
======
нет. 0.7 секунды примерно.
большая часть - система - понятно - 200 файлов открыть и закрыть надо, чего-то записав в них
Убей их всех! Бог потом рассортирует...