4 'Эх, хорошо в стране советской жить!!!'

5 '2002-03-31 05:11:01'

1 ARRAY(0x83cedd0)

0 2

1 1

2 'S'

3 1

4 'И чего хорошего???'

5 '2002-03-31 05:11:01'

Массив заполнен правильными данными из базы данных. Продолжаем выполнение скрипта в пошаговом режиме.

DB<2> n

main::printTalks(common.cgi:171): $studs{$arr[3]} = 1;

DB<2>

main::printTalks(common.cgi:167): while( my @arr=$sth->fetchrow_array ) {

С помощью команды «l» (listing, распечатка текста программы) выясняем номер строки на которой находится интересующий нас код. В данном случае нас интересует, будет ли выполняться блок if, начинающийся на строке 178.

DB<2> l

167==> while( my @arr=$sth->fetchrow_array ) {

168: $arr[3] = int($arr[3]);

169: push @talks, [ @arr ];

170: if( $arr[2] eq 'S' ) {

171: $studs{$arr[3]} = 1;

172 }

173 else {

174: $admins{$arr[3]} = 1;

175 }

176 }

DB<2> l

177: $sth->finish;

178: if( %admins ) {

179: $sth=$dbh->prepare('select id,full_name from admin where id in ('.join(',',keys %admins).')');

180: unless( $sth && $sth->execute ) {

181: my $errstr = $dbh->errstr;

182: print "Content-Type: text/plain\n\nОшибка выборки переписки: $errstr\n";

183: exit 0;

184 };

185: %admins = ();

186: while( my @arr = $sth->fetchrow_array ) {

С помощью команды «с» (continue, продолжение выполнения до строки, номер которой указан в команде, контрольной точки или конца программы) пропускаем выполнение до строки, предшествующей началу блока. С помощью пошаговых команд проверяем, передаётся ли выполнение внутрь блока if.

DB<2> c 177

main::printTalks(common.cgi:177): $sth->finish;

DB<3> n

main::printTalks(common.cgi:178): if( %admins ) {

DB<3>

main::printTalks(common.cgi:179): $sth=$dbh->prepare('select id,full_name from admin where id in ('.join(',',keys %admins).')');

DB<3>

main::printTalks(common.cgi:180): unless( $sth && $sth->execute ) {

Аналогичным образом проверяем, передаётся ли управление внутрь блока if( %stud ) начинающегося на строке 190.

DB<3> l

180==> unless( $sth && $sth->execute ) {

181: my $errstr = $dbh->errstr;

182: print "Content-Type: text/plain\n\nОшибка выборки переписки: $errstr\n";

183: exit 0;

184 };

185: %admins = ();

186: while( my @arr = $sth->fetchrow_array ) {

187: $admins{$arr[0]} = $arr[1];

188 }

189: $sth->finish;

DB<3> c 189

main::printTalks(common.cgi:189): $sth->finish;

DB<4> n

main::printTalks(common.cgi:191): if( %studs ) {

Далее нас интересует правильность работы подпрограммы печати дерева переговоров. Для этого используем серию команд «n», «l» и «c», чтобы перейти на точку вызова подпрограммы, расположенную на строке 204.

DB<4> l

191==> if( %studs ) {

192: $sth=$dbh->prepare('select id,full_name from students where id in ('.join(',',keys %studs).')');

193: unless( $sth && $sth->execute ) {

194: my $errstr = $dbh->errstr;

195: print "Content-Type: text/plain\n\nОшибка выборки переписки: $errstr\n";

196: exit 0;

197 };

198: %studs = ();

199: while( my @arr = $sth->fetchrow_array ) {

200: $studs{$arr[0]} = $arr[1];

DB<6> c 198

main::printTalks(common.cgi:198): %studs = ();

DB<7> n

main::printTalks(common.cgi:199): while( my @arr = $sth->fetchrow_array ) {

DB<7> l

199==> while( my @arr = $sth->fetchrow_array ) {

200: $studs{$arr[0]} = $arr[1];

201 }

202: $sth->finish;

203 }

204: printSubTalks(0,\%admins,\%studs,\@talks);

205 }

206

207 sub printSubTalks($$$$) {

208: my ( $parent,$adm,$std,$talks) = @_;

DB<7> c 204

main::printTalks(common.cgi:204): printSubTalks(0,\%admins,\%studs,\@talks);

С помощью команды «s» переходим в подпрограмму и с помощью команды «n» трассируем выполнение программы при печати одного сообщения.

DB<8> s

main::printSubTalks(common.cgi:208):

208: my ( $parent,$adm,$std,$talks) = @_;

DB<8> n

main::printSubTalks(common.cgi:209):

209: my $found = 0;

DB<8>

main::printSubTalks(common.cgi:210):

210: for( my ($cntr,$lim)=(0,scalar @$talks);$cntr<$lim;$cntr++) {

DB<8> l

210==> for( my ($cntr,$lim)=(0,scalar @$talks);$cntr<$lim;$cntr++) {

211: my ( $id,$cur_parent,$cr_type,$cr_id,$descr,$date ) = @{$$talks[$cntr]};

212: next if $cur_parent != $parent;

213: unless( $found ) {

214: print "<UL>\n";

215: $found = 1;

216 }

217: if( $cr_type eq 'S' ) {

218: if( exists $$std{$cr_id} ) {

219: $cr_id = $$std{$cr_id};

DB<8> n

main::printSubTalks(common.cgi:211):

211: my ( $id,$cur_parent,$cr_type,$cr_id,$descr,$date ) = @{$$talks[$cntr]};

DB<8>

main::printSubTalks(common.cgi:211):

211: my ( $id,$cur_parent,$cr_type,$cr_id,$descr,$date ) = @{$$talks[$cntr]};

DB<8>

main::printSubTalks(common.cgi:212):

212: next if $cur_parent != $parent;

DB<8>

main::printSubTalks(common.cgi:213):

213: unless( $found ) {

DB<8>

main::printSubTalks(common.cgi:214):

214: print "<UL>\n";

DB<8>

<UL>

main::printSubTalks(common.cgi:215):

215: $found = 1;

DB<8>

main::printSubTalks(common.cgi:217):

217: if( $cr_type eq 'S' ) {

DB<8>

main::printSubTalks(common.cgi:226):

226: if( exists $$adm{$cr_id} ) {

DB<8>

main::printSubTalks(common.cgi:227):

227: $cr_id = $$adm{$cr_id};

DB<8>

main::printSubTalks(common.cgi:233):

233: print '<li><b>',CGI::escapeHTML($cr_id),'</b>(',$date,'): ',

234: CGI::escapeHTML($descr),"\n";

DB<8>

(offline mode: enter name=value pairs on standard input)

<li><b>Олег Иванович Лисов</b>(2002-03-31 05:11:01): Эх, хорошо в стране советской жить!!!

main::printSubTalks(common.cgi:235):

235: printSubTalks($id,$adm,$std,$talks);

DB<8> n

<UL>

<li><b>Елена Валерьевна Гостева</b>(2002-03-31 05:11:01): И чего хорошего???

<UL>

<li><b>Олег Иванович Лисов</b>(2002-03-31 05:11:01): Эх, хорошо стране полезным быть!!!

<UL>

<li><b>Елена Валерьевна Гостева</b>(2002-03-31 05:11:01): Так чего же хорошего в этом???

</UL>

<li><b>Олег Иванович Лисов</b>(2002-03-31 05:11:01): Дык просто хорошо.

</UL>

</UL>

main::printSubTalks(common.cgi:210):

210: for( my ($cntr,$lim)=(0,scalar @$talks);$cntr<$lim;$cntr++) {

DB<8> n

main::printSubTalks(common.cgi:211):

211: my ( $id,$cur_parent,$cr_type,$cr_id,$descr,$date ) = @{$$talks[$cntr]};

DB<8> n

main::printSubTalks(common.cgi:211):

211: my ( $id,$cur_parent,$cr_type,$cr_id,$descr,$date ) = @{$$talks[$cntr]};

DB<8>

main::printSubTalks(common.cgi:212):

212: next if $cur_parent != $parent;

DB<8>

main::printSubTalks(common.cgi:210):

210: for( my ($cntr,$lim)=(0,scalar @$talks);$cntr<$lim;$cntr++) {

Убедившись в корректной работе подпрограммы с помощью команды «c» продолжаем выполнение программы до завершения.

DB<8> c

<li><b>Елена Валерьевна Гостева</b>(2002-03-31 05:11:01): a1aaa1aa

<UL>

<li><b>Елена Валерьевна Гостева</b>(2002-03-31 05:11:01): bbbbbbbbb

<UL>

<li><b>Олег Иванович Лисов</b>(2002-03-31 05:11:01): ccccccc

<UL>

<li><b>Елена Валерьевна Гостева</b>(2002-03-31 05:11:01): qewr asdf qwer zcxvasd qerasdf zcv qwer zcxv qewr zcv qwer cv qwer zcv qwer zxcv qwer zxcv qewr zxcv wer vqwe5 zxadfqw4 zxcvq asdfg e5qtqz zadsf qewr adf qer adf qwer adf qwer dfasdf qewr gdfgdfg rt qer asdf qwer sadf qewr adf qwer adf qwer dasf qewr fsa erqwerqwer adfadsfasd qewrerqwe asdfasfsa erqwraf qewrqwer adsfasfasd qerqwer adfasdfas

</UL>

<li><b>Олег Иванович Лисов</b>(2002-03-31 05:11:01): ddddddddd

</UL>

</UL>

</UL>

Debugged program terminated. Use q to quit or R to restart,

use O inhibit_exit to avoid stopping after program termination,

h q, h R or h O to get additional info.

После завершение программы выходим из отладочного интерпретатора с помощью команды «q» (quit, завершить работу).

DB<8> q

egosteva@zeta:~/lena.tvc.ru/cgi-bin$

В данном примере показан завершающий этап отладки скрипта, в котором уже исправлены все ошибки. В случае обнаружения ошибок сеанс отладки скрипта завершается с помощью команды «q» в произвольном месте отладки. Ошибки исправляются посредством любого редактора, например стандартного для операционных систем типа UNIX редактора vi.