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

burakov

Дата 21.8.2008, 15:07 (ссылка)

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

Загрузка ...

Опытный

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

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

Добрый день.
помогите пожалуйста
нужен класс, который бы читал РЕКУРСИВНО предложенный ему каталог возвращая имена файлов.

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

Вот класс.

Код


package DirScanNoRecurce;
use strict;
use warnings;


my $workdir;
my $dir;

sub new {
    my $class = shift;
    $workdir = shift;
    
    return "workdir undefined\n" unless ($workdir);
    chdir ($workdir);
    opendir ($dir, $workdir) or die (print "Can't open $workdir");
    bless $dir, $class;
    return $workdir; 
}

sub get_file {
    my $class = shift;
    my $file;
    $file = readdir ($dir);
    if ($file and $file eq '.') {$file = readdir ($dir);}
    if ($file and $file eq '..') {$file = readdir ($dir);}
    if ($file) {$file = "$workdir/$file";}
    return $file;
}

sub close {
    closedir ($dir);
}

return 1;

а вот как я получаю имя файла

Код


use strict;
use warnings;
use DirScanNoRecurce;

my $workdir = 'h:/test';
my $dir = DirScanNoRecurce -> new ($workdir); 
while (my $str = DirScanNoRecurce -> get_file()) {
    print "$str\n";
}

вообщем то я воспользовался подсказкой ginnie
http://forum.vingrad.ru/forum/topic-224296.html
по поводу класса через файловый дискриптор.

но вот РЕКУРСИЯ меня доконала, уже третий день сижу.
нужно, чтобы работало как в выше приведенном примере, только читало каталог $workdir вместе с подкаталогами (рекурсивно)

может кто уже делал? или быстро соображает... smile

огромное спасибо.

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

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

shamber

Дата 21.8.2008, 15:18 (ссылка)

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

Загрузка ...

Эксперт

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

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

burakov,
а что если попробовать вот так
(не проверял, писал прямо в форум)

.....

Добавлено @ 15:19
Ps есть еще модуль DirHandle, может он поможет?

Это сообщение отредактировал(а) shamber - 21.8.2008, 15:25

ginnie

Дата 21.8.2008, 15:29 (ссылка)

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

Загрузка ...

Эксперт

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

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

Уважаемый burakov, хочу обратить внимание на ошибку в Вашем классе: переменные $workdir и $dir являются общими для всех объектов Вашего класса, соответственно одновременно Вы не можете создать два независимых объекта, что неправильно. Надо переделать класс с файлового дескриптора на хэш.

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

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

burakov

Дата 21.8.2008, 15:41 (ссылка)

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

Загрузка ...

Опытный

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

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

чего то у меня не отображается пример shamber' a
я вижу только

burakov,
а что если попробовать вот так
(не проверял, писал прямо в форум)

.....

Добавлено @ 15:19
Ps есть еще модуль DirHandle, может он поможет?

что значат эти четыре точки smile

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

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

KSURi

Дата 21.8.2008, 16:15 (ссылка)

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

Загрузка ...

Опытный

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

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

File::Find?

Это сообщение отредактировал(а) KSURi - 21.8.2008, 16:16

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

Died at Life.pl line 21

ginnie

Дата 21.8.2008, 16:24 (ссылка)

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

Загрузка ...

Эксперт

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

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

Код


use strict;
use warnings;

my $dir = DirScanWithRecurce->new( workdir => '/home/ginnie' );

while (my $filename = $dir->get_file()) {
    print $filename, "\n";
}

package DirScanWithRecurce;
use strict;
use warnings;

sub new {
    my $class = shift;
    my %args = @_;
    
    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;
            if (-d $full_name) {
                push(@$self, $dh_arr);
                my $dh;
                opendir ($dh, $full_name) or die "Can't open $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);
    closedir($dh_arr->[0]);
}

1;

Это сообщение отредактировал(а) ginnie - 21.8.2008, 16:27

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

shamber

Дата 21.8.2008, 16:36 (ссылка)

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

Загрузка ...

Эксперт

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

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

Грубая прикидка.

Код


#!/usr/bin/perl -w
use strict;
use warnings;
use DirScanRecurce;

my $workdir = 'C:/Alphacenter';
my $dir = DirScanRecurce -> new ($workdir); 

my $str = $dir->get_file($dir->{cat});
while (my $data = shift @{$str}){
    print $data."\n";
}

Код


package DirScanRecurce;
use strict;
use warnings;


my $workdir;
my $dir;

sub new {
    my $class = shift;
    $workdir = shift;
    
    return "workdir undefined\n" unless ($workdir);
    chdir ($workdir);
    opendir ($dir->{dir}, $workdir) or die (print "Can't open $workdir");
    $dir->{cat} = $workdir;
    $dir->{buf} = []; #имена файлов
    $dir->{queue} = [];#очередь каталогов
    bless $dir, $class;
    return $dir; 
}


sub get_file {
    my $class = shift;
    my $dir = shift;
    my $tempdir;
    my $file;
    
    if(opendir($tempdir,$dir)){
        while($file = readdir $tempdir){
            if(-d $dir.'/'.$file ){#если это каталог лезем сюда
                if($file eq '.'){
                #пропускаем
                }elsif($file eq '..'){
                #пропускаем
                }else{
                push @{$class->{queue}},$dir.'/'.$file;
                }
            }elsif(-f $dir.'/'.$file){
                push @{$class->{buf}},$dir.'/'.$file;
            }
        }
        closedir $tempdir;
    }else{
        die (print "Can't open $workdir");
    }
    my $data = shift @{$class->{queue}};
    if(defined $data){
        $class->get_file($data);
    }
    return $class->{buf};
}

З.Ы. вместо точек читать тут smile

Добавлено @ 16:36
Хотя File::Find наверно лучше smile

Добавлено @ 16:38
ginnie, обогнал smile

Это сообщение отредактировал(а) shamber - 21.8.2008, 16:38

ginnie

Дата 21.8.2008, 16:43 (ссылка)

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

Загрузка ...

Эксперт

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

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

Уважаемый shamber, предлагаю подумать на предмет

Код


my $workdir = 'C:/Alphacenter';
my $dir = DirScanRecurce -> new ($workdir);
$workdir = 'C:/Betacenter';
my $dir2 = DirScanRecurce -> new ($workdir);

my $str = $dir->get_file($dir->{cat});
while (my $data = shift @{$str}){
    print $data."\n";
}

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

shamber

Дата 21.8.2008, 16:47 (ссылка)

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

Загрузка ...

Эксперт

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

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

ginnie, полностью с Вами согласен. Но я написал, грубая прикидка. Я не писал ему код, я предложил вариант.
Спасибо, за уточнение

Код


sub new {
    my $class = shift;
    my $workdir = shift;
    my $self;
    return "workdir undefined\n" unless ($workdir);
    chdir ($workdir);
    opendir ($self->{dir}, $workdir) or die (print "Can't open $workdir");
    $self->{cat} = $workdir;
    $self->{buf} = []; #имена файлов
    $self->{queue} = [];#очередь каталогов
    bless $self, $class;
    return $self; 
}

Это сообщение отредактировал(а) shamber - 21.8.2008, 16:57

burakov

Дата 22.8.2008, 14:08 (ссылка)

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

Загрузка ...

Опытный

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

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

Огромное спасибо за ответы.
smile

, тока есть у меня один вопросик.
(то что я много не понял это черт с ним, главное рабочие примеры есть, буду разбираться). Но вот хотел спросить
все таки

по поводу объявления переменных в модуле.
чем все таки лучше, если через ХЕШ это делать.

ведь имя каталога в ХЕШ массиве
пишется в одно место
$self->{cat} = $workdir; т.е. по идее

Код


my $workdir = 'C:/Alphacenter';
my $dir = DirScanRecurce -> new ($workdir);
$workdir = 'C:/Betacenter';
my $dir2 = DirScanRecurce -> new ($workdir);

перезапишет $self->{cat}

и чем тогда это отличается, если просто все делать не через ХЕШ, а как я по старинке через переменную (ибо пока не до конца понимаю прелестей этих Хешей).

Можете ПО-РУССКИ (по проще на конкретном примере) сказать почему лучше @_ писать в ХЕШ, а делать $workdir = shift; ???

понимаю, что возможно я где то чего то не дочитал ( и наверное много) раз такие вопросы задаю., но все таки .... если что не судите строго smile

Спасибо.

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

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

shamber

Дата 22.8.2008, 14:28 (ссылка)

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

Загрузка ...

Эксперт

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

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

burakov, для каждого DirScanRecurce -> new , создается свой экземпляр $self. И Поэтому $self->{cat} не перезапишется.

my $workdir = shift; я лично так привык делать. получаем параметры при вызове метода.

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

ginnie

Дата 22.8.2008, 14:29 (ссылка)

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

Загрузка ...

Эксперт

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

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

Уважаемый burakov, отличие понять очень просто, для этого надо просто распечатать адреса $dir и $dir2, а также внутри объектов адреса Ваших переменных и все прояснится. Распечатать адреса очень просто: print ссылки выводит тип данных и адрес в памяти.

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

shamber

Дата 22.8.2008, 14:29 (ссылка)

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

Загрузка ...

Эксперт

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

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

Цитата(burakov @ 22.8.2008, 14:08

)

лучше @_ писать в ХЕШ

что это значит?

Ps вопрос снят внимательным прочтением

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

ginnie

Дата 22.8.2008, 14:33 (ссылка)

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

Загрузка ...

Эксперт

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

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

Цитата

Можете ПО-РУССКИ (по проще на конкретном примере) сказать почему лучше @_ писать в ХЕШ, а делать $workdir = shift; ???

это два разных метода передачи параметров в функцию: именованный и списочный. Если у Вас передается несколько параметров - лучше использовать списочный (он быстрее), если много, либо из списка в разных вызовах передаются некоторые различные параметры - лучше именованный.

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

burakov

Дата 22.8.2008, 15:17 (ссылка)

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

Загрузка ...

Опытный

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

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

Понял,

(т.е. можно и через

my $workdir = shift;
и через
my %args = @_;
главное, чтобы это все присутствовало в sub new (), а не в теле модуля?
)

ну и пожалуйста еще один вопросик (раз уж эта неделя у меня - "НЕДЕЛЯ получения ответов" буду наглым до конца)
вот код модуля который аналогичен Reader::TextFile
http://forum.vingrad.ru/forum/topic-224296.html
ну я его переписал, так чтобы сам его понимал до конца smile

Код


package FileList;
use strict;
use warnings;

sub new {
    my $class = shift;    
    my $home_dir = shift; 
    my $file = rand(); $file = "$home_dir/$file\.tmp";
    my $f;    

    if (-d $home_dir) {
        open ($f, "+>$file") or die print ("Can't found file $file;"); 
        bless $f;
        return $f; 
    }    
}

sub get_str {
    my $f = shift;
    my $str = <$f>; 
    chomp ($str) if ($str);
    return $str; 
}

sub put_str {
    my $f = shift;
    my $str = shift;
    print $f "$str\n" if ($str); 
    return $str;
}

sub delete {
    my $f = shift;
    my $file = shift;    #вот тут непонятно! глобально $file объявлять ?
    close ($f);
    unlink ($file) if (-e $file);
}

return 1;

только в конце самом при помощи sub delete мне созданный *.tmp надо удалить
а как передать имя файла в sub delete внутри модуля??? (чтобы не вылезти в основной код) при этом не объявляя $file глобально?

Спасибо.

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

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

ginnie

Дата 22.8.2008, 15:35 (ссылка)

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

Загрузка ...

Эксперт

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

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

Уважаемый burakov, еще раз хочу обратить Ваше внимание на

Цитата

а как передать имя файла в sub delete внутри модуля???

Надо передать имя файла не внутри модуля (класса), а внутри объекта (экземпляра класса). Лучше это делать используя в качестве основы класса массив или хэш, тогда все данные, уникальные именно для этого объекта надо помещать в этом массиве (хеше).

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

shamber

Дата 22.8.2008, 15:37 (ссылка)

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

Загрузка ...

Эксперт

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

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

Цитата(burakov @ 22.8.2008, 15:17

)

my $file = shift; #вот тут непонятно! глобально $file объявлять ?

а зачем объявлять, лучше его в самом начале сохранить в хэш, а потом удалить, так надежнее

если в самом конце удалять то используйте DESTROY

пример показал ginnie
PS может так лучше?

Код


package FileList;
use strict;
use warnings;

sub new {
    my $class = shift;    
    my $home_dir = shift; 
    my $self; 
    my $file = rand(); 
    $self->{filename} = "$home_dir/$file\.tmp";
       

    if (-d $home_dir) {
        open ($self->{file}, "+>$self->{filename}") or die print ("Can't found file $self->{filename};"); 
        bless $self,$class;
        return $self; 
    }    
}

sub get_str {
    my $self = shift;
    my $str = <$self->{file}>; 
    chomp ($str) if ($str);
    return $str; 
}

sub put_str {
    my $self = shift;
    my $str = shift;
    print $self->{file} "$str\n" if ($str); 
    return $str;
}

sub DESTROY {
    my $self= shift;
    close ($self->{file});
    unlink ($self->{filename}) if (-e $self->{filename});
}

return 1;

Это сообщение отредактировал(а) shamber - 22.8.2008, 16:04

burakov

Дата 25.8.2008, 14:00 (ссылка)

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

Загрузка ...

Опытный

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

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

Добрый день.
вообщем за выходные я разобрался в ответах,примерах smile

. огромное спасибо.

а вот на конструкцию my $str = <$self->{file}> PERL ругается.
Очевидно ему не нравится большое количество <->> вот таких вот значков
а как же тогда сказать ему чтобы он читал из файла?

Код


sub get_str {
    my $self = shift;
    my $str = <$self->{file}>;  #вот на вот это вот PERL ругается 
    chomp ($str) if ($str);
    return $str;

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

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

ginnie

Дата 25.8.2008, 14:10 (ссылка)

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

Загрузка ...

Эксперт

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

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

Уважаемый burakov, попробуйте

Код


my $fh = $self->{file};
my $str = <$fh>;

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

burakov

Дата 25.8.2008, 14:29 (ссылка)

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

Загрузка ...

Опытный

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

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

Спасибо,
я через так

Код


my $fh = $self->{file};
my $str = <$fh>;

попробовал - получилось, НО
а все таки без дополнительного присваивания
my $str = <$fh>;
никак нельзя ?

ибо не всегда это вот присваивание уместно. я об него споткнулся, сейчас покажу

Код


sub new {
    my $self = {};
    $self->{class} = shift;
    $self->{file} = shift;
    $self->{fh} = my $fh;  
    
    if (-f $self->{file}){
        open ($self->{fh}, $self->{file});
        return bless $self;
    } 
}

вот например если делать open не на $self->{fh}, на $fh,
то $self->{fh} остается закрытым дескриптором. Обо что я собственно и стукнулся .
поэтому ж и вопрос.

может както можно вывернуться и указать перлу чтобы он делал <> непосредственно из
$self->{file}???
или тут ничего не поделаешь?
(по моему это вопрос чисто синтаксиса написания (не понимает <->>), поскольку логика перла в строке
open ($self->{fh}, $self->{file});
работает отлично)

Спасибо.

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

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

ginnie

Дата 25.8.2008, 14:39 (ссылка)

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

Загрузка ...

Эксперт

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

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

Уважаемый burakov, не могли бы Вы объяснить, как должен изменится $self->{fh} при вызове функции open() во фрагменте

Код


my $self = {};
$self->{fh} = my $fh;
open ($fh, 'some_file');

По теме: с <> по-другому нельзя (см. http://perldoc.perl.org/perlop.html, раздел I/O Operators), можно попробовать

Код


my $str = readline($self->{file});

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

burakov

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

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

Загрузка ...

Опытный

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

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

добрый день

по поводу

Код


my $self = {};
$self->{fh} = my $fh;
open ($fh, 'some_file');

вот если вот так вот сделать, как в примере выше, а потом попытаться поработать с дескриптором,
то получить строку из файла не удается
типа get_str() ругается - ну я так понял на закрытый дискриптор или неопределенный дискриптор.

а вот если сделать вот так

Код


my $self = {};
$self->{fh} = my $fh;
open ($self->{fh}, 'some_file');

т.е. сделать open непосредственно на $self->{fh}
то все нормально.

УЖ не знаю с чем это связано...
я так для себя по простому объяснил, что
типа просто $fh чем то отличается от open ($fh ......)
поэтому и спросил как убрать лишнее присваивание, чтобы лишний раз не путаться.

Огромное спасибо за ответы.

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

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

ginnie

Дата 27.8.2008, 12:15 (ссылка)

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

Загрузка ...

Эксперт

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

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

Уважаемый burakov,

Цитата

УЖ не знаю с чем это связано...

обязательно надо разобраться, если хотите заниматься разработкой на Perl.
Проблема с первым фрагментом в том, что сначала происходит присваивание, а затем вызов open(). В хэш попадает значение undef, а ссылка на файловый дескриптор после open() остается только в переменной $fh. Чтобы работало правильно надо присваивание делать после open().

Код


my $self = {};
my $fh;
open ($fh, 'some_file');
$self->{fh} = $fh;

стало понятнее?

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

burakov

Дата 27.8.2008, 13:32 (ссылка)

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

Загрузка ...

Опытный

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

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

Да стало понятнее.....
присвоить
$self->{fh} после open - как то до меня сразу не дошло.

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

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

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

shamber

Дата 28.8.2008, 09:23 (ссылка)

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

Загрузка ...

Эксперт

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

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

burakov, вопрос только в том, зачем вам плодить переменные. почему сразу не

Код


open ($self->{fh}, 'some_file');

burakov

Дата 28.8.2008, 09:51 (ссылка)

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

Загрузка ...

Опытный

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

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

добрый день,

все таки если не сделать

Код


$self->{fh} = my $fh;           #если не сделать вот этого...
open ($self->{fh}, 'some_file');

то без присвоения $self->{fh} переменной код не сработает

переменная $fh нужна впоследствии, для чтение строки из файла, посколько
perl не понимает синтаксиса типа.

Код


sub get_str {
    my $self = shift;
    my $str = <$self->{file}>;  #вот на вот это вот PERL ругается 
    chomp ($str) if ($str);
    return $str;

вот ginnie посоветовал воспользоваться функцией readline(), чтобы не плодить переменные.

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

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

burakov

Дата 3.9.2008, 10:05 (ссылка)

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

Загрузка ...

Опытный

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

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

Добрый день.
спрошу еще о сканировании каталогов.

захотелось создать кнопочку "СТОП", которая бы
делала DESTROY. на сканирование каталогов

ну т.е. прерывала сканирование каталогов в нужный для пользователя момент.
ну вообщем нарисовал я такую кнопочку приделал к ней DESTROY.
но при нажатии такого вот четкого конкретного дестроя на чтение каталога не происходит.
т.е. если несколько раз понажимать, подергать эту кнопочку, то в какой то момент сканирование каталогов все таки останавливается.

тогда я подумал, что наверное если это вот сканирование выделить в отдельный процесс.
и потом делать Kill на вот этот вот отдельный процесс
(и хотя я работаю в windows Kill у меня тоже работает)
то это более четко прекратит сканирование каталогов.

только как сказать перлу, чтобы он запустил сканирование каталогов в отдельном процессе?
fork попробовал - получается вроде как два сканирования сразу - не подходит....

как правильно реализовать мою СТОП-идею?

Спасибо.

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

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

shamber

Дата 3.9.2008, 11:14 (ссылка)

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

Загрузка ...

Эксперт

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

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

почитайте про треды, на форуме может они вам помогут

burakov

Дата 3.9.2008, 15:02 (ссылка)

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

Загрузка ...

Опытный

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

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

форуме про это дело мало
нашел вот
http://nopox.wordpress.com/2007/10/06/mult...eading-in-perl/
наворочено блин с тредами этими.

Ну а все таки, к черту потоки эти.
Дестрой то должен закрыть дескриптор - отчего ж тогда
тогда ж так неустойчиво все отрабатывает???

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

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

shamber

Дата 3.9.2008, 15:27 (ссылка)

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

Загрузка ...

Эксперт

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

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

burakov, вы приведите ваш скрипт. Сложно сказать, что у вас там происходит. Телепатия сегодня не работает

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;
            }

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

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