tj Рекурсивно вывести все данные,

# передавая при рекурсивных вызовах

# выравнивающие пробелы и ширину числа sub output {

my($root, Sprefix, Swidth) = (shift, shift , shift \\ 0), my Spath,

(Spath = Sroot) =" s# ./##, n Базовое имя my Ssize = $Dirsize{$root},

my Sline = sprintf( %${width}d %s, Ssize, Spath), print Sprefix, Sline, \n ,

for (Sprefix = Sline) { tj Дополнительный вывод

s/\d /I /, s/[-]/ /9,

If ($Kids{$root}) { # Узел имеет подузлы

my (SKids = §{ $Kids{$root} },

©Kids = sort { SDirsizeiSb) <=> $Dirsize{$a} } (SKids, $Dirsize{$Kids[0]} =~ /(\d+)/, my Swidth = length $1,

for my Skid (©Kids) { output($kid, Sprefix, Swidth) }

До того как в Perl появилась прямая поддержка хэшей массивов, эмуляция подобных конструкций высшего порядка требовала титанических усилий. Некоторые программисты использовали многократные вызовы split и join, но это работало чрезвычайно медленно.

В примере 5.4 приведена версия программы dutree из тех далеких дней. Поскольку у нас не было прямых ссылок на массивы, приходилось самостоятельно залезать в символьную таблицу Perl. Программа на ходу создавала переменные с жутковатыми именами. Удастся ли вам определить, какой хэш используется этой программой?

Пример 5.3 (продолжение)

ту $root = $ [0],

my($size, $cursize),

$size = $cursize = $Dirsize{$root},

If t$Kids{$root}) {

for my $kid ((Э{ $Kids{$root} }) {

Scursize -= $Dirsize{$kid},

getdots($kid),

If ($size = Scursize) { my $dot = $root/ , $Dirsize{$dot} = Scursize, push §{ $Kids{$root} }, $dot,

Массив @{"pcb"} содержит ссылку на анонимный массив, содержащий "рсЬ/ fix", "pcb/rev и "pcb/pending". Массив @{"pcb/rev"} содержит "pcb/rev/maybe" и "pcb/rev/web". Массив @{"pcb/rev/maybe"} содержит "pcb/rev/maybe/yes" и "pcb/rev/maybe/not.

Когда вы присваиваете *kid что-нибудь типа pcb/f ix", строка в правой части преобразуется в тип-глоб. @kid становится синонимом для @{ pcb/f ix"}, но это отнюдь не все. &kid становится синонимом для &{" pcb/f ix"} и т. д.

Если эта тема покажется неинтересной, подумайте, как local использует динамическую область действия глобальных переменных, чтобы избежать передачи дополнительных аргументов. Заодно посмотрите, что происходит с переменной width в процедуре output.

Пример 5.4. dutree-orig

#1/usr/bin/perl

# clutree orig старая версия, которая появилась

# до выхода рег15 (начало 90-х)

(Slines = du (SARGV , chop(@lines),

&input($top = pop (Slines),

&output($top),

exit,

sub input {

local($root, *kid, $him) = (Э [0,0], while ((Slines && &childof($root, $lines[$fllines])) { &input($him = pop((alines)), push((a>kid, $him),

If ((Skid) {

local($mysize) = ($root =- /"(\d+)/), for ((Skid) { Smysize -= (/"(\d+)/)[0], } push((akid, Smysize ) if $size = Smysize,

(Skid = &sizesort(*kid),

sub output {

local($root, «kid, Sprefix) =@ [0,0,1], local($size, Spath) = split( , Sroot), Spath =~ s ./ .

Sline = sprintf(%${width}d %s , $size, Spath), print Sprefix, Sline, \n, Sprefix = Sline, Sprefix =~ s/\d /I /, Sprefix =- s/["]/ /g,

local($width) = $kid[0] =~ /(\d+)/ && length( $1 ), for ((Skid) { &output($ , Sprefix), }, } продолжение #

Пример 5.4 (продолжение)

sub sizesort {

local(«list, (Biinclex) = shift; sub bynum { $inclex[$b] <=> $inclex[$a]; } for (§list) { push((aindex, /(\d+)/), } (aiist[sort bynum 0..$#list];

sub childof {

local((apair) = (Э ;

for (©pair) { s/-\d+\s+ g. s/$/\ , } index($pair[1], $pair[0]) >= 0,

Итак, какой же хэш используется старой программой dutree? Правильный ответ - %main :, то есть символьная таблица Perl. Не стоит и говорить, что эта программа не будет работать с use strict. Мы рады сообщить, что новая версия работает втрое быстрее старой. Дело в том, что старая версия постоянно ищет переменные в символьной таблице, а новая обходится без этого. Кроме того, нам удалось избежать медленных вызовов split для занимаемого места и имени каталога. Однако мы приводим и старую версию, поскольку она весьма поучительна.