Кто имеет опыт в оптимизации Perl скриптов?

Question

[Салават Ситдиков]

Доброе утро. Столкнулся со следующей проблемой.
Есть проект, код которого написан на Perl. Поддерживал его долгое время, но вот настала беда - поддержка упирается в ресурсы системы.

Человек, который писал этот код, не на связи.

Суть следующая, есть
sub treecom{} которая выводит комментарии. Рекурсионно. Но запросы к БД - в каждой итерации.

На php написать могу и исправить - но как внедрить код - непонятно, поэтому нужна следующая помощь.

Нужен костяк функции, которая на пхп выглядела бы ~ так:

function getcomments($id){
$tree = array();
$comments = Db::getCommentsByArticle($id);
foreach ($comments as $row){
$tree[$row->parent][] = $row;
}
return getTreeComments($tree, 0);
}

function getTreeComments($tree, $parent){
$html = '';
if (isset($tree[$iter])){
$html  .= $row->comment;
if (isset($tree[$row->id])){
$html .= getTreeComments($tree, $row->id);
}
return $html;
}

Сам код на Perl

sub treecom {
    ( my $przd, my $y, my $allend ) = @_;
    $cntr++;
    if ( $cntr > 200 ) { print qq[<b>Зацикливание!!</b><br><hr>$bb]; exit; }
    $y++;
    $selectp = "SELECT * FROM table WHERE key = value ORDER BY date ASC, id ASC
    ";
    my $sp = $dbh->prepare($selectp);
    $sp->execute;
    while (
        ( $arid, $namek, $titlek, $textk, $date, $end, $usr_id, $rait, $pub, $usr_name, $status, $src ) =
        $sp->fetchrow_array )
    {
        undef $img;

        if ($src) {
          $img = qq[<img src="/blog/users/$usr_id/profile.$src" width="30px" align="left" hspace="5" />];
        }
        if ( $pub eq "0" && $status < 1 ) { next; }
        $date =~ /(\d\d\d\d)-(\d\d)-(\d\d) (\d\d:\d\d:\d\d)/;
        $dates = qq[$3.$2.$1];
        $time  = $4;
        @tm    = split( ':', $time );
        $time  = qq[$tm[0]:$tm[1]];
        $plft  = ( $y * 10 ) . "px";

        if ( !$usr_name ) { $namek = qq[<font class="nicname">$namek</font>]; }
        else {

          $namek = qq[<div style="width: 50%; float: left;">$img<a href="/reader/$usr_id/" class="nicnamea"><b>$usr_name</b></a>&nbsp;&nbsp;<font class="gryl">$usr_cnt</font></div>];
        }

        $bb .= qq[<tr><td style="padding: 0 0 10px $plft"><a name="cmt$arid"></a>$namek

         <div style="clear: both;"></div>
         <div>$textk</div>
        ];
        
        if ( $end eq "1" && ( $allend eq 0 || $allend >= $y ) ) {
            $allend = $y;
        }
        if ( $allend > $y || $allend eq "0" ) {
            $otv = qq[<a href="/cgi-bin/comment.pl?article=$article&amp;trs=table&amp;parcom=$arid#cform" class="icomm" onclick="atcomm('$arid','table');">[ответить на комментарий]</a>];
        }
        $bb .= qq[<div style="float: left;">$otv</div><div style="float: right;"><font class="gryl">$dates $time</font></div></td></tr>];
        undef $otv;
        $par =
          $dbh->selectrow_array("SELECT id FROM table where parent='$arid'");
        if ($par) { treecom( $arid, $y, $allend ); }
        if ( $y eq $allend ) { $allend = 0; }
    }

    $sp->finish;
}

Comments

[pcdesign]

Причем тут php? Покажите perl код, который по вашему мнению работает медленно.

[Салават Ситдиков]

pcdesign: я надеялся, что кто-нибудь эту же конструкцию опишет на Perl'e. Обновил пост.

Answer 1

[pcdesign]

my %child;
my $n = $dbh->prepare('SELECT * FROM `table` where key =?  ');
$n->execute($value);
my $all = $n->fetchall_arrayref( {} );
foreach my $item (@$all) {
    print $item->{'arid'};
}

Comments

[Салават Ситдиков]

pcdesign: Простите, не совсем понял о чем вы. Оба запроса - это оба запроса к одной и той же таблице. Сначала он выбирает корневые комментарии и в каждой итерации - дочерние.
Моя идея была в том - чтобы выбрать все комментарии разом и на уровне приложения уже строить дерево, не создавай каждый раз sql-запрос.

[pcdesign]

Салават: А почему сразу нельзя забрать все и потом разбираться?

[Салават Ситдиков]

pcdesign: я как раз это и хочу сделать. Но не знаю (не получается пока что) как на perl'e написать нужную конструкцию - поэтому и привел пример php-кода, который желательно описать на perl.

[pcdesign]

Салават: Проблема не в перл-коде в данном случае, а в повторном запросе SQL в каждой итерации.
Я изменил свой первый комментарий.
Попробуйте забрать вообще все.
Потом в хэш заносите информацию по дочерним комментариям.

[Салават Ситдиков]

pcdesign: да, об этом как раз и речь. Я слабо представляю как это реализуется на перл, поэтому и представил пример php-кода.
Ваш комментарий вижу, сейчас на основе него постараюсь сделать нужное. Спасибо!

[pcdesign]

Салават: А разницы нет перл это или php.
Повторные запросы к базе везде зло.

Если я до конца понял структуру вашей базы,
то дальнейшая проверка внутри цикла такая:

if ( $item->{'parent'} ){
# Значит есть дочерние комментарии.
# Делаем что-нибудь.
my $id = $item->{'id'}
}

[Салават Ситдиков]

pcdesign: так и есть. Поэтому я в своем приемре и привел код, где мы получаем все записи
$comments = Db::getCommentsByArticle($id);
А потом уже играемся с ними.

[Салават Ситдиков]

pcdesign , поправьте, пожалуйста, меня и мой код. Никак работать не хочет.

sub _dopsec {
  $selectp = 'SELECT id, name, parent FROM razdel WHERE visible = 0 ORDER BY id';
  my $sp = $dbh->prepare($selectp);
  $sp->execute;

  my @razdel;

  while (@rp = $sp->fetchrow_array){
    push @{$razdel->{$rp[2]}}, $rp;
  }

  _dopsecArr(0, $razdel);

  $sp->finish;

}

sub _dopsecArr {
  (my $razdel, my $arr) = @_ ;
  foreach my $n (@{$arr->{$razdel}}){
    $seclist .= qq[<option value='$n[0]'>$n[1]</option>];
    _dopsecArr($n[2], $arr);
  }
}

[pcdesign]

Салават: Ну вы бы воткнули везде где только можно print и смотрели бы что там выводится. Так быстрее разобрались.
А если сходу, то вот это странно:
в функцию _dopsecArr вы передаете два аргумента 0 и $razdel
_dopsecArr(0, $razdel);

А потом получаете
(my $razdel, my $arr) = @_ ;
И выходит, что раздел у вас всегда будет равен 0.
А $arr будет равен $razdel

P.S. И кстати стоит писать вот так:
my ( $razdel, $arr) = @_ ;

[pcdesign]

И еще вы объявляете массив @razdel, вносите в него данные через push.
А потом откуда не возьмись появляется переменная $razdel.
Если хотите передать массив в функцию, то можно это сделать так:
my $razdel = \@razdel;
Ну и потом только передавать.

[Салават Ситдиков]

pcdesign: нашел Dumper.
Но все равно есть некоторые непонятки.

while (@rp = $sp->fetchrow_array){
    my $rp = \@rp;
    push @{$razdel->{$rp[2]}}, @rp;
  }

Я думал, что получу структуру:

Array( 0 => array(
key1 => array(id, name, parent),
key2 => array(id, name, parent),
), 141 => array(
keyX => array(id, name, parent),
keyY => array(id, name, parent),
),

Но, похоже перл этого не делает. Разбираюсь дальше

[pcdesign]

use Data::Dumper;
print Dumper(@razdel);
search.cpan.org/~smueller/Data-Dumper-2.154/Dumper.pm

[Салават Ситдиков]

pcdesign: да, спасибо.
Получил теперь утечку в памяти.

sub _dopsec {
  $selectp = 'SELECT id, name, parent FROM razdel WHERE visible = 0 ORDER BY id';
  my $sp = $dbh->prepare($selectp);
  $sp->execute;

  my $razdel;

  while (@rp = $sp->fetchrow_array){
    my $rp = \@rp;
    push @{$razdel->{$rp[2]}->{$rp[0]}}, @rp;
  }
  $sp->finish;

  _dopsecArr(0, $razdel);

}

sub _dopsecArr {

  my ($parent, $razdel) = @_ ;

  foreach my $n ({$razdel->{$parent}}){
    $seclist .= qq[<option value='$n[0]'>$n[1]</option>];
    _dopsecArr($n[2], $razdel);
  }
}

[pcdesign]

Салават: немудрено ;)
Вы усложняете. Завтра все получится.

[Салават Ситдиков]

pcdesign:
Довёл до ума, код работает - но в рекурсии - утечка. Похоже дело в типах данных и передаче?

sub _dopsecArr {

  my ($parent, $razdel) = @_ ;

  my $items = $razdel->{$parent};
  %items = %{ $items };
  foreach my $n (keys %items ) {
    @item = @{$items->{$n}};
    $seclist .= qq[<option value='@item[0]'>@item[1]</option>];
    _dopsecArr(@item[2], $razdel);
  }
}

[Салават Ситдиков]

pcdesign: передавал одного и того же родителя, вместо дочерних. Все, теперь работает как надо и быстро :) Спасибо!

Answer 2

[FanatPHP]

А точно ли проблема "в каждой итерации"? Ты профилировал скрипт?
Сколько там тех комментов? Сто? Двести? Для индексированных запросов это ерунда.
Причины бывают очень разные. Методом тыка ты много не наоптимизируешь

Comments

[Салават Ситдиков]

FanatPHP: если честно, я пытался профилировать perl скрипт, но закончилось все это неудачей.
То что это, одна из проблем - в этом я уверен.
В среднем комментариев по 100. И судя по результатам общения с поддержкой хостинга и своему небольшому опыту - узкое место база данных. Индексы, где это необходимо - имеются.