Многопоточность в Perl. Threads, Queue.

У меня уже был пост об этом. Со временем исправил много багов. Теперь нити работают через очередь, не зависают. Данный скрипт пингает хосты из сети, которую мы ему задаем в переменной $network, выдаёт статистику "сколько хостов ответило из общего количества в сети". Сеть задаём в формате N.N.N.N/N, модуль Net::Netmask определяет кол-во хостов в сети. В данном случае стартует 25 нитей, каждая из которых выполняет функцию ping. Когда очередь исчерпана, скрипт переходит к подсчёту статистики из файла.

#!/usr/bin/perl -w
#Ping network with threads and queue

use threads;
use Net::Ping;
use Net::Netmask;
use Thread::Queue;

# Programm variables

$debug=1;
$data_queue0 = Thread::Queue->new;
my $sleeptime = 0;                              

$network='178.76.215.0/25';

sub cidr {
  my $net = shift @_;
  my $block = Net::Netmask->new($net);
  my @pool;
  $size=$block->size();

  for (my $i=0; $i<=$size; $i++) {
   #print $block->nth($i),"\n";
 push (@pool, $block->nth($i));
 
  }
  return @pool;

}
                                                        
sub ping {
  while ($data_queue0->pending()) {
  my $host = $data_queue0->dequeue;
  my $pingprotocol = "icmp";
  my $pingtimeout = 1;
  my $pinglength = 1;
                                                                                                 
  my $p = Net::Ping->new($pingprotocol,$pingtimeout,$pinglength);
    if ( $p->ping($host) ) {
      print OFILE "$host OK\n";
      #print "$host OK\n";
        }  
  $p->close();
  }
}


sub que {
    print "Starting que sub\n";
    my @ar=@_;
    #print @ar,"\n"; 
    my $a;

    foreach my $ip (@ar) {
     $data_queue0->enqueue($ip);
  $a++;
    }

    if ($debug==1) { print "$a elements queued\n"; }
}

sub startthreads {
    for ($m=0; $m<=24; $m++) {
 sleep($sleeptime);
 $thrd[$m] = threads->new(\&ping, $data_queue0);
     print "Thread $m started.\n";  

    }
    print "All threads are started\n";                                            
    foreach (@thrd) { $_->join(); }
    print "All threads are joined!\n";
}

#Programm body

#1 - Recive data from cidr to array
@ipaddr = cidr($network);

#2 - Insert array into queue
que(@ipaddr);

#3 - Open file for inserting stdout from threads
open OFILE, ">ping_network_stats.txt";

#4 - Create threads
startthreads;

#5 - Close file with WRITE ONLY
close(OFILE);

#6 - Open file with READ ONLY
open OFILE1, ";

#8 Delete empty strings
chomp @count;

#9 - Print results of programm 
print "Network usage\: ",$#count," of ",$size,", ", $use=($#count/$size)*100, " %";

#10 - Close file descriptor with WRITE ONLY
close (OFILE1);

Работа с PostgreSQL через DBI в Perl

Очень доходчиво.

Оригинал тут http://www.lghost.ru/docs/postgres/DBI_pg.html

В этом небольшом руководстве я рассмотрю работу с SQL сервером PostgreSQL в языке Perl. Поскольку для Perl существует стандартный интерфейс для работы с разными СУБД, который называется DBI (Database Independent Interface), то я буду рассматривать именно его. Хотя DBI и является стандартной вещью, но всё-равно от специфики конкретных СУБД никуда не уйти, так как некоторые СУБД могут не поддерживать весь спектр возможностей заложенных в DBI. Поэтому, в данном случае, я буду говорить только о реализации DBI интерфейса, которую поддерживает DBI драйвер для PostgreSQL. Этот драйвер поставляется в виде отдельного модуля, который интегрируется с DBI и называется DBD::Pg (DataBase Driver для PostgreSQL).

Информация, которую вы найдёте в данном руководстве не является (за малыми исключениями) моим личным опытом. Я просто сделал небольшую компиляцю странички man наDBD::Pg и снабдил ряд моментов пояснениями и примерами. В принципе, если у вас нет трудностей с английским языком, а также есть желание почитать оригинал - вы всегда можете это сделать.