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 скачать ноты бесплатно

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