[Rio-pm] Ajuda com Threads - tempo de abertura
Fernando Oliveira
fernandocorrea em gmail.com
Sábado Julho 10 12:15:33 PDT 2010
Fiz uns testes aqui no meu super lento notebook q acho q pode interessar:
fernando em fernando-laptop:~$ cat test_threads.pl
#!/usr/bin/perl
use 5.10.0;
use strict;
use Time::HiRes qw/gettimeofday tv_interval usleep/;
use threads ('yield',
'stack_size' => 16384,
'exit' => 'threads_only',
'stringify');
use threads::shared;
my @ips : shared;
my %result : shared;
my $time : shared;
$| = 1;
@ips = 1 .. 10_000;
my $ips = @ips;
say "ips: $ips";
my $max_threads = shift || 200;
my $t0 = [gettimeofday];
push my @thrs, create_thread() for 1 .. $max_threads;
say "Levou ", tv_interval($t0, [gettimeofday]), " seg para startar
$max_threads threads";
say "Media de tempo p/ startar cada thread: ", $time / $max_threads;
print("\rtestados: ", scalar keys %result), usleep 100 while @ips and $ips
!= scalar keys %result;
print $/;
my %r;
$r{ $_ }++ for values %result;
say "$_: $r{ $_ }" for qw/OK NOK/;
say "TOTAL: ", $r{ OK } + $r{ NOK };
sub create_thread {
threads->create({context => "void"}, \&sub_thread, [gettimeofday]);
}
sub sub_thread {
my $t0 = shift;
my $time_unit = tv_interval($t0, [gettimeofday]);
my $tid = threads->tid;
say $tid, ": ", $time_unit if $tid >= $max_threads - 5;
$time += $time_unit;
while(my $ip = shift @ips) {
my $r = int rand 9;
sleep 1 unless $r % 2;
$result{ $ip } = $r % 2 ? "OK" : "NOK";
}
exit;
}
fernando em fernando-laptop:~$ diff test_threads.pl test_forks.pl
7c7
< use threads ('yield',
---
> use forks ('yield',
11c11
< use threads::shared;
---
> use forks::shared;
fernando em fernando-laptop:~$ time ./test_threads.pl 100
ips: 10000
95: 0.009266
96: 0.006097
97: 0.011582
98: 0.007523
99: 0.006502
100: 0.022716
testados: 99030seg para startar 100 threads
OK: 4509
NOK: 5395
TOTAL: 9904
Perl exited with active threads:
85 running and unjoined
15 finished and unjoined
0 running and detached
real 0m55.945s
user 0m48.159s
sys 0m0.596s
fernando em fernando-laptop:~$ time ./test_threads.pl 500
ips: 10000
495: 0.005923
496: 0.151628
497: 1.154306
498: 0.005588
499: 0.005505
500: 0.006324
Levou 33.697717 seg para startar 500 threads
Media de tempo p/ startar cada thread: 0.06719761
OK: 4420
NOK: 5580
TOTAL: 10000
Perl exited with active threads:
0 running and unjoined
500 finished and unjoined
0 running and detached
real 0m38.136s
user 0m2.640s
sys 0m0.856s
fernando em fernando-laptop:~$ time ./test_threads.pl 1000
ips: 10000
995: 0.125149
996: 0.687834
997: 0.164103
998: 0.00555
999: 0.00544
1000: 0.005672
Levou 133.962833 seg para startar 1000 threads
Media de tempo p/ startar cada thread: 0.132355601
OK: 4385
NOK: 5615
TOTAL: 10000
Perl exited with active threads:
0 running and unjoined
1000 finished and unjoined
0 running and detached
real 2m28.914s
user 0m4.620s
sys 0m1.412s
fernando em fernando-laptop:~$ time ./test_forks.pl 100
ips: 10000
95: 0.600199
96: 0.463332
97: 0.462497
98: 0.012093
99: 1.848478
100: 0.273546
Levou 80.618404 seg para startar 100 threads
Media de tempo p/ startar cada thread: 0.81342024
testados: 9671
OK: 4417
NOK: 5583
TOTAL: 10000
Perl exited with active threads:
2 running and unjoined
98 finished and unjoined
0 running and detached
real 3m37.531s
user 0m30.998s
sys 0m9.469s
fernando em fernando-laptop:~$
Sendo q no forks meu load chegou a 53...
Just another Perl Hacker,
Fernando (SmokeMachine)
http://perl-e.org
Em 10 de julho de 2010 12:50, João André Simioni <jasimioni em gmail.com>escreveu:
> Fiz um teste agora colocando um sleep 10 no inicio da função checkIp.
> As threads abrem rápido assim, mas o desempenho ficou ruim. Além
> disso, notei que as threads não utilizam os demais processadores.
>
> Minha solução atual está com um fork no começo, quebrando o código em
> 8 processos distintos (número de processadores), cada processo com um
> sub-grupo e criando suas threads (30 threads por grupo).
>
> Obrigado pela ajuda
>
> João André
>
> 2010/7/10 João André Simioni <jasimioni em gmail.com>:
> > Blabos,
> >
> > o loop interno não é nem usado nesse código, como observado pelo
> > Bruno, porque ele define a quantidade de threads no início. Usualmente
> > eu disparo uma thread para cada elemento que vou gerenciar, e defino
> > um limite de threads abertas no início do código e é por isso que esse
> > loop existe, para controlar o limite de threads (e funciona bem em
> > diversos outros scripts que não têm o mesmo problema de desempenho).
> >
> > Segue os comentários no código:
> >
> >> #!/usr/bin/perl
> >>
> >> use strict;
> >> use DBI;
> >> use Net::Ping;
> >> use Time::HiRes qw/usleep tv_interval gettimeofday/;
> >> use threads ('yield', 'stack_size' => 32*4096, 'exit' =>
> >> 'threads_only', 'stringify');
> >>
> >> my $host = '192.168.160.179';
> >> my $sid = 'HOMOLOG';
> >> my $user = 'mac_user';
> >> my $pass = 'mac_user';
> >>
> >> my $dbh = DBI->connect("dbi:Oracle:host=$host;sid=$sid", $user, $pass,
> >> { AutoCommit => 1 });
> >>
> >> my $sth = $dbh->prepare('SELECT CPE_ID, CLIENTE_ID, CPE_DESC,
> >> CPE_IP_WAN, CPE_NODE, CPE_IF FROM MAC_CPE WHERE CPE_PING = ? AND
> >> CPE_ATIVO = ?');
> >> $sth->execute('1', 'A');
> >>
> >> my @cpes;
> >>
> >> while (my (@row) = $sth->fetchrow_array) {
> >> push @cpes, [ @row ];
> >> }
> >>
> >> $dbh->disconnect();
> >
> > Até aqui somente listei os elementos a partir do banco de dados.
> >
> > O código abaixo quebra o numero de elementos em 250 threads.
> >
> >> my $maxThreads = 250;
> >> my $total = @cpes;
> >>
> >> my $cpePerThread = int($total / $maxThreads);
> >>
> >> my @toMonitor;
> >> my $i = 0;
> >> my $c = 0;
> >>
> >> foreach my $cpe (@cpes) {
> >> push @{$toMonitor[$i]}, $cpe;
> >> $c++;
> >>
> >> if ($c > $cpePerThread) {
> >> $i++;
> >> $c = 0;
> >> }
> >> }
> >>
> >> print "Para $total cpes, e $maxThreads threads, tenho no final $i
> >> grupos, com ", scalar @{$toMonitor[0]}, " elementos cada\n";
> >
> >
> >
> > E imprimo - vou ter o total de elementos dividido em 250 grupos (cada
> > grupo atendido por uma thread)
> >
> >
> >
> >> sub processResult {
> >> my $r = shift;
> >> if (ref $r ne 'ARRAY') {
> >> print STDERR "Erro na thread\n";
> >> return 0;
> >> }
> >> my ($result, $host, $ifs) = @$r;
> >>
> >> }
> >
> > Funcao de processamento do resultado da thread -- aqui não faz nada
> >
> >> sub testeClient {
> >> my $threadNum = shift;
> >> my $cpeGroup = shift;
> >> foreach my $cpe (@{$cpeGroup}) {
> >> my ($cpeId, $clientId, $cpeDesc, $cpeIp, $cpeNode, $cpeIf) =
> @$cpe;
> >> my $pingOk = &checkIp($cpeIp);
> >> my $status = $pingOk ? 'RESPONDE' : 'MORTO';
> >> # print join(", ", $threadNum, $cpeId, $clientId, $cpeDesc,
> >> $cpeIp, $cpeNode, $cpeIf, $status), "\n";
> >> }
> >> # print "Finishing thread $threadNum\n";
> >> return([1, 0]);
> >> }
> >
> > Código da thread - basicamente chama a sub 'checkIp' para ver se o
> > host está vivo.
> >
> > Abaixo o código de criação das threads - para cada grupo, cria uma
> thread.
> >
> >> my $threadCount = 1;
> >> foreach my $cpeGroup (@toMonitor) {
> >> print "Trying to create thread";
> >> my $t0 = [gettimeofday];
> >>
> >> print " in ", scalar localtime $t0->[0], ".", $t0->[1], "\n";
> >>
> >> my $thr = threads->create({scalar => '1'}, 'testeClient',
> >> $threadCount, $cpeGroup);
> >> my $elapsed = tv_interval ( $t0, [gettimeofday]);
> >> print "Created thread $thr ($threadCount) - took $elapsed seconds
> >> to create\n";
> >> $threadCount++;
> >
> > Esse bloco pode ser removido, pois nunca entra - foi a primeira coisa
> > que tirei, porque achei que a chamada a threads->list poderia estar
> > influenciando. Esse método retorna em menos de 1ms em todas as
> > execuções. Mas se preferir só ignora.
> >
> >> while (threads->list() >= $maxThreads) {
> >> my @joinable = threads->list(threads::joinable);
> >> for (@joinable) {
> >> my $r = $_->join();
> >> &processResult($r);
> >> }
> >> usleep(10000);
> >> }
> >> my $elapsed = tv_interval ( $t0, [gettimeofday]);
> >
> > Finaliza a criação de threads
> >
> >> }
> >
> > Aguarda as threads concluirem.
> >
> >> while (threads->list()) {
> >> my @joinable = threads->list(threads::joinable);
> >> for (@joinable) {
> >> my $r = $_->join();
> >> &processResult($r);
> >> }
> >> usleep(10000);
> >> }
> >
> > Fim de execução
> >
> >> sub checkIp {
> >> my $ip = shift;
> >> my $pingOk = 0;
> >
> >
> > Essa rotina faz 3 testes para cada elemento. Em cada teste, tenta um
> > ping ICMP, um UDP e um TCP. Tenho que executar o ping do S.O. porque
> > senão sou obrigado a rodar o script como root e o Net::Ping faz
> > confusão com o ICMP. Se eu testo um host e ele nao responde no tempo
> > de timeout e eu em seguida testar outro host, se o primeiro responder
> > ele acha que o segundo respondeu.
> >
> >> eval {
> >> for (1..3) {
> >> my $ping = `/bin/ping -c 1 -w 1 $ip`;
> >>
> >> if (grep { / 0% packet loss/ } $ping) {
> >> $pingOk = 1;
> >> return 1;
> >> }
> >>
> >> if ($pingOk == 0) {
> >> my $p = Net::Ping->new('icmp');
> >> $p->service_check(1);
> >> if ($p->ping($ip, 1)) {
> >> $pingOk = 1;
> >> return 1;
> >> }
> >> }
> >>
> >> if ($pingOk == 0) {
> >> my $p = Net::Ping->new('udp');
> >> $p->service_check(1);
> >> if ($p->ping($ip, 1)) {
> >> $pingOk = 1;
> >> return 1;
> >> }
> >> }
> >>
> >> sleep 3;
> >> }
> >> };
> >>
> >> return $pingOk;
> >> }
> >>
> >
> > Quanto a usar Java, é que tenho um grupo de desenvolvimento Java do
> > meu lado - eu posso solicitar a eles, mas eu não vejo porque Perl não
> > pode atender bem nesse caso.
> >
> > Obrigado
> >
> _______________________________________________
> Rio-pm mailing list
> Rio-pm em pm.org
> http://mail.pm.org/mailman/listinfo/rio-pm
>
-------------- Próxima Parte ----------
Um anexo em HTML foi limpo...
URL: <http://mail.pm.org/pipermail/rio-pm/attachments/20100710/d1fe9620/attachment.html>
Mais detalhes sobre a lista de discussão Rio-pm