VPF::рекурсивное сканирование каталогов

burakov

Дата 3.9.2008, 16:19 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 554
Регистрация: 28.7.2006

Репутация: нет
Всего: нет

Вот код

Код


use strict;
use warnings;
use Tk;
use DirScanRecurce;

my $mw = MainWindow -> new ();
my $DirScanRecurce; #объявил глобально, чтобы не заморичаться с передачей значения между подпрограммами
my $button_1 = $mw -> Button (-text => 'START', -command => \&button_1_work) -> pack ();
my $button_2 = $mw -> Button (-text => 'STOP', -command => \&button_2_work) -> pack ();
MainLoop;

sub button_1_work {
    my $workdir = 'd:/';
    $DirScanRecurce = DirScanRecurce -> new($workdir); 
    while (my $file = $DirScanRecurce -> get_file()) {
        $mw -> update;
        print "$file\n"; 
    }
}

sub button_2_work {
    if ($DirScanRecurce) {
        $DirScanRecurce -> DESTROY();
    }
}

а вот код класса, который сканирует каталог рекурсивно
я воспользовался помощью ginnie

Код


package DirScanRecurce;
use strict;
use warnings;
sub new {
    my $class = shift;
    my %args; $args{workdir} = shift;
    
    return "workdir undefined\n" unless (exists $args{workdir});
    my $dh;
    opendir ($dh, $args{workdir}) or die "Can't open $args{workdir}: $!";
    my $self = [ [$dh, $args{workdir}] ];
    return bless $self, $class;
}
sub get_file {
    my $self = shift;
    return unless (@$self);
    my $return_filename;
    DH: while ( my $dh_arr = pop(@$self) ) {
        while (my $filename = readdir($dh_arr->[0])) {
            next if ($filename eq '.' or $filename eq '..');
            my $full_name = $dh_arr->[1].'/'.$filename;
            $full_name =~ s/(\/\/)+/\//g;
            if (-d $full_name) {
                push(@$self, $dh_arr);
                my $dh;
                #opendir ($dh, $full_name) or die "Can't open $full_name: $!";
                last DH unless (opendir ($dh, $full_name));
                $dh_arr = [$dh, $full_name];
            }
            else {
                $return_filename = $full_name;
                push(@$self, $dh_arr);
                last DH;
            }
        }
        closedir($dh_arr->[0]) if (@$self);
    }
    return $return_filename; 
}
sub DESTROY {
    my $self = shift;
    my $dh_arr = pop(@$self);
    if ($dh_arr->[0]) {
        closedir($dh_arr->[0]);
    }
}
1;

P.S.
Я попробовал сделать ДЕСТРОЙ на дескриптор в своем классе (который сканирует каталог НЕ рекурсивно) - и это СРАБОТАЛО. Т.е. многопоточность мне вообщем не нужна.
но вот на классе ginnie (с которым я до конца так и не сумел разобраться) ДЕСТРОЙ не работает.

вот пример моего НЕ рекурсивного класса,

Код


package DirScanNoRecurce;
use strict;
use warnings;

sub new {
    my $class = shift;
    my $workdir = shift;
    if ($workdir) {
    my $self = {};
    $self->{workdir} = $workdir;
    $self->{dh} = my $dh;
    opendir ($self->{dh}, $workdir) or die (print "Can't found $workdir");
    return bless $self;
    }
}

sub get_file {
    my $self = shift;
    my $dh = $self->{dh};
    my $workdir = $self->{workdir};
        
    my $file = readdir ($dh); 
    
    if ($file) {
        $file = "$workdir/$file"; 
        $file =~ s/(\/\/)+/\//g;
    }
        while ($file and ($file =~ /\.+$/ or -d $file)) { 
            $file = readdir ($dh); 
    
            if ($file) {
                $file = "$workdir/$file"; 
                $file =~ s/(\/\/)+/\//g;
            }
    }
        
    if ($file and -f $file) {
    return $file;
    }
}

sub DESTROY {
    my $self = shift;
    my $dh = $self->{dh};
    closedir ($dh);
}

return 1;

Спасибо

--------------------

Нотный архив http://libnote.ru скачать ноты бесплатно

shamber

Дата 4.9.2008, 10:17 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1422
Регистрация: 5.9.2006
Где: Россия

Репутация: 1
Всего: 18

burakov, замените DESTROY на что-нибудь такое

Код


sub DESTROY {
    my $self = shift;
    while(my $dh_arr = shift @$self){
         closedir($dh_arr->[0]) if $dh_arr->[0];
     };
}

ginnie

Дата 4.9.2008, 10:49 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 1287
Регистрация: 6.1.2008
Где: Москва

Репутация: 6
Всего: 49

Уважаемый burakov,

Цитата

но вот на классе ginnie (с которым я до конца так и не сумел разобраться)

так задавайте вопросы, где и что не понятно! Будем разбираться!

Добавлено через 4 минуты и 24 секунды
P.S. По проблеме с кнопкой могу предложить в функцию button_2_work() добавить warn и по логу посмотреть, в какой момент после нажатия кнопки оно отработает.

--------------------

Написать код, понятный компьютеру, может каждый, но только хорошие программисты пишут код, понятный людям. (Мартин Фаулер. Рефакторинг)

shamber

Дата 4.9.2008, 11:22 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1422
Регистрация: 5.9.2006
Где: Россия

Репутация: 1
Всего: 18

Уважаемый ginnie, кнопка отрабатывает сразу. Проблема там в другом.

Просто массив $self после

Код


sub DESTROY {
    my $self = shift;
    my $dh_arr = pop(@$self);
    if ($dh_arr->[0]) {
        closedir($dh_arr->[0]);
    }
}

еще содержит директории.
И код продолжает возвращять имена файлов из них. И остановка происходит после отработки всех уже открытых директорий
Поэтому я предложил burakov, в Destroy просто очистить массив $self и все. после этого кнопка отрабатывает сразу smile

Это сообщение отредактировал(а) shamber - 4.9.2008, 14:32

ginnie

Дата 4.9.2008, 11:36 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 1287
Регистрация: 6.1.2008
Где: Москва

Репутация: 6
Всего: 49

shamber, спасибо за пояснения! Ваш вариант деструктора, несомненно, более правильный.
С идеологической точки зрения вызывать деструктор вручную не совсем грамотный подход, лучше остановить цикл.

--------------------

shamber

Дата 4.9.2008, 11:46 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1422
Регистрация: 5.9.2006
Где: Россия

Репутация: 1
Всего: 18

Цитата(ginnie @ 4.9.2008, 11:36

)

С идеологической точки зрения

полностью с вами согласен smile

Добавлено @ 11:50
burakov, как вариант, то о чем,как мне кажется, говорил ginnie.

Код


use strict;
use warnings;
use Tk;
use DirScanRecurce;

my $mw = MainWindow -> new ();
my $DirScanRecurce; #объявил глобально, чтобы не заморичаться с передачей значения между подпрограммами
my $button_1 = $mw -> Button (-text => 'START', -command => \&button_1_work) -> pack ();
my $button_2 = $mw -> Button (-text => 'STOP', -command => \&button_2_work) -> pack ();
MainLoop;

sub button_1_work {
    my $workdir = 'd:/';
    $DirScanRecurce = DirScanRecurce -> new($workdir); 
    while (1) {
        if (defined $DirScanRecurce){
            my $file = $DirScanRecurce-> get_file();
            if (defined $file){
                $mw -> update;
                print "$file\n";
            }else{
                #еcли мы оказались здесь, то это значит что кончились файлы
                last;
            }
        }else{
            #еcли мы оказались здесь, то это значит нажали кнопку стоп
            last;
        }
    }
}

sub button_2_work {
    undef ($DirScanRecurce); #это вызывает $DirScanRecurce->DESTROY
}

Это сообщение отредактировал(а) shamber - 4.9.2008, 14:33

shamber

Дата 4.9.2008, 14:37 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1422
Регистрация: 5.9.2006
Где: Россия

Репутация: 1
Всего: 18

или более компактный вариант процедуры

Код


sub button_1_work {
    my $workdir = 'd:/';
    $DirScanRecurce = DirScanRecurce -> new($workdir); 
    while (my $file = $DirScanRecurce-> get_file()) {
        $mw -> update;
        print "$file\n";
        unless (defined $DirScanRecurce){
            last;
        }
    }
}

Это сообщение отредактировал(а) shamber - 4.9.2008, 14:39

burakov

Дата 5.9.2008, 11:23 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 554
Регистрация: 28.7.2006

Репутация: нет
Всего: нет

Добрый день.
Ну как всегда спасибо за ответы...
про связь undef-DESTROY это вы вовремя мне рассказали... smile

вопросик по этому поводу:
если объект сделать = undef, то выполнится DESTROY который записан в классе? или же какой нибудь автоматический перловый DESTROY (например если в классе нет sub DESTROY smile

).

и еще вопросик по поводу класса DirScanRecurce, все еще пытаюсь в нем разобраться...

Код


sub get_file {
    my $self = shift;
    return unless (@$self);           # ВОТ ТУТ ВОТ НЕПОНЯТНО что возвращается если нет ссылки
    my $return_filename;
    DH: while ( my $dh_arr = pop(@$self) ) {
        while (my $filename = readdir($dh_arr->[0])) {
            next if ($filename eq '.' or $filename eq '..');
            my $full_name = $dh_arr->[1].'/'.$filename;
            $full_name =~ s/(\/\/)+/\//g;
            if (-d $full_name) {
                push(@$self, $dh_arr);
                my $dh;
                #opendir ($dh, $full_name) or die "Can't open $full_name: $!";
                last DH unless (opendir ($dh, $full_name));                 #вот это вот я сам уже подписал
                $dh_arr = [$dh, $full_name];                                       #чтобы на "недоступных"               
            }
            else {
                $return_filename = $full_name;
                push(@$self, $dh_arr);
                last DH;                                      # и вот тут вот непонятно вроде бы отправляет на DH,        
            }                                                     # return_filename когда же - вроде уже файл надо вернуть
        }                                                         # или я неправильно понимаю что такое last DH?
        closedir($dh_arr->[0]) if (@$self);
    }
    return $return_filename;

вообщем хороше бы код всего класса прокомментировать да и все тут smile

Спасибо.

--------------------

Нотный архив http://libnote.ru скачать ноты бесплатно

ginnie

Дата 5.9.2008, 11:51 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 1287
Регистрация: 6.1.2008
Где: Москва

Репутация: 6
Всего: 49

Уважаемый burakov, немного поясню по вызову DESTROY:
пусть в переменной $DirScanRecurce ссылка на объект класса DirScanRecurce. Если это единственная ссылка на этот объект, то при выполнении

Код


undef $DirScanRecurce

ссылка удаляется и запускается процедура сбора мусора, в рамках которой вызывается метод DESTROY объекта, если он есть. Поэтому, можно считать процедуру сбора мусора автоматическим DESTROY, но он не заменяется методом класса, а дополняется.
Если ссылок на объект больше одной, то undef одной из них не приведет к запуску сборщика мусора для объекта.

По поводу return читаем perldoc -f return:
"Если аргумент не задан, возвращается пустой список в списочном контексте, undef в скалярном контексте и ничего не возвращается в пустом (void) контексте."

Код


last DH;

говорит, что надо завершить цикл с меткой DH (т.е. выйти из него). После этой строчки следующей выполняется

Код


return $return_filename;

Это сообщение отредактировал(а) ginnie - 5.9.2008, 11:54

--------------------

burakov

Дата 8.9.2008, 11:29 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 554
Регистрация: 28.7.2006

Репутация: нет
Всего: нет

Добрый день.
спасибо за ответы с кодом $DirScanRecurce более менее разобрался.
вот на его основе
написал такой же, только он отдает не только файлы, но и каталоги, т.е. получается полное дерево. Удобно если допустим убирать-устанавливать атрибуты у файлов-каталогов.
есть только один вопрос.

вот кстати код

Код



my $workdir = 'h:/test'; 
my $test = test -> new($workdir);
while (my $line = $test -> get_line()) {
print "$line\n";
}


package DirScanRecurceWithNameDir;
sub new {
    my $class = shift;
    my $workdir = shift;
    my $dh; 
    opendir ($dh, $workdir) or die (print "Can't opendir $workdir\n");
    my $self = [[$dh, $workdir]]; 
    bless $self; 
    return $self;
}

sub get_line {
    my $self = shift;
    my $file; my $args; 

m1:    while ($args = pop(@$self)) { 

        while ($file = readdir ($args->[0])) {
            next if ($file eq '.' or $file eq '..');    

            if ($args->[1]) {
                $file = $args->[1].'/'.$file;
                $file =~ s/(\/\/)+/\//g;
            }
        
            if (-d $file) {
                push (@$self, $args); 
                my $dh; 
                last m1 unless (opendir ($dh, $file));
                my $args = [$dh, $file]; 
                push (@$self, $args); 
                last m1;
            } 
            
            if (-f $file) {
                push(@$self, $args);
                last m1;
            }
        }
    closedir ($args->[0]) if @$self; 
    }
return $file;
}

sub DESTROY {
    my $self = shift; 
    while (@$self) {
        my $args = pop (@$self);
        closedir ($args->[0]); 
    }
}    
    
1;

в моем варианте $workdir, который подставляется в sub new не попадает в print "$line\n";
понятно, что достать этот $workdir нетрудно, поскольку он известный (я же знаю, чего подставляю), но все таки

возможно следующее ?:
чтобы сканировало рекурсивно, в new подставлялся $workdir,
а первым my $line = $test -> get_line() получался бы наш главный (родительский) $workdir, который мы подставляем в new?

--------------------

Нотный архив http://libnote.ru скачать ноты бесплатно

ginnie

Дата 10.9.2008, 17:53 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 1287
Регистрация: 6.1.2008
Где: Москва

Репутация: 6
Всего: 49

Уважаемый burakov,

Цитата

возможно следующее ?:
...
первым my $line = $test -> get_line() получался бы наш главный (родительский) $workdir

если я скажу "нет", Вы поверите? smile

комментируем строку

Код


   opendir ($dh, $workdir) or die (print "Can't opendir $workdir\n");

в конструкторе

в get_line() дописываем:

Код


m1:        while ($args = pop(@$self)) {
            if (!@$self and !$args->[0]) {
                if (opendir ($args->[0], $args->[1])) {
                    $file = $args->[1];
                    push(@$self, $args);
                }
                last m1;
            }

--------------------

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Perl: Системное программирование \| Следующая тема »