Столкнулся с задачей - создать List деревьев каталогов (полностью, тоесть пройти до максимальной глубины подкаталогов), с заданием скрипту в качестве параметра - корневой каталог, т.е.:
perl script.pl /homeЗдесь нашел очень хорошие примеры, они практически соответсвуют моим нуждам:
http://perlmaven.com/recursive-subroutines
http://www.onperl.net/Reading-Directories-RecursivelyНо приведенные там скрипты корректно обходят все подкаталоги только когда запускаются без параметров и соответственно обходят только подкаталоги только в директориии где находится сам скрипт.
Помогите пожалуйста состовить скрипт которому возможно скормить в качестве параметра корневой каталог для составления дерева подкаталогов. спасибо!
my @contents;
sub read_directorys_tree {
my ($dir, @tmp) = @_;
my @arr;
push @arr, @tmp if(@tmp);
push @arr, $dir if( -d $dir);
opendir(my $dh, $dir) or die $!;
while(my $file = readdir($dh)) {
next if($file eq '.' || $file eq '..');
my $path = $dir . '\\' . $file;
read_directorys_tree($path, @arr) if(-d $path);
}
closedir($dh);
print Dumper @arr;
return @arr;
}@contents = read_directorys_tree("c:\\cygwin64\\home\\temp0", @contents);
print $_."\n" for @contents;
print "\n\n";
#описанная функция возвращает только первый елемент (корневой каталог), а мне нужно всё дерево
> Помогите пожалуйста состовить скрипт которому возможно скормить в качестве параметра корневой
> каталог для составления дерева подкаталогов. спасибо!Google: perl @ARGV @ARGC
> Google: perl @ARGV @ARGC#я так понимаю проблема в самой рекурсии, я набросал простой код, для проверки:
my $a;
sub test_rec {
my ($end, $ref) = @_;
my @arr;
push @arr, $ref if ($ref);
push @arr, $end;
for(my $i =1; $i < $end; $i++) {
test_rec($end - $i, \@arr);
}
return \@arr;
}$a = test_rec(3, $a);
print "\n\n@{$a}"."\n\n";
print @_."\n" for @{$a};#в результате получаю один елемент (импользуемый в первом проходе рекурсии), Пробовал и по ссылкам и по значениям передавать.. При пощаговом прохождение все нормально до вызова return, при этом один за одним удаляются элементы из массива.
#задачу можно легко решить используя для push внешний массив, но я хочу разобраться как решить эту задачу имено используя внутренний массив в рекурсиивной функции.
> Помогите пожалуйста состовить скрипт которому возможно скормить в качестве параметра корневой каталог для составления дерева подкаталогов. спасибо!
#!/usr/bin/perluse strict;
use warnings;my @dirs;
my $path = shift;&dir($path);
sub dir($) {
my $dir = shift;
my $dh;opendir $dh, $dir;
while ( my $sub = readdir $dh) {
next if $sub =~ /^\.\.?$/;
push @dirs, "$dir/$sub" if -d "$dir/$sub";
&dir("$dir/$sub") if -d "$dir/$sub";
}
closedir $dh;
}for(@dirs){print $_,"\n";}
>#
> my @dirs;
> sub dir($) {
> push @dirs, "$dir/$sub" if
> }#Спасибо за помощь, но такое решение я и Сам изначально написал, вопрос в том, что бы не использовать массив объявленный до рекурсивной функции.
> #Спасибо за помощь, но такое решение я и Сам изначально написал, вопрос
> в том, что бы не использовать массив объявленный до рекурсивной функции.Кхм.. Ну получили массив, а выводить как будете?
Типа вещь в себе?Тогда так
#!/usr/bin/perluse strict;
use warnings;my $path = shift;
&dir($path);
sub dir($) {
my $dir = shift;
my $dh;opendir $dh, $dir;
while ( my $sub = readdir $dh) {
next if $sub =~ /^\.\.?$/;
no strict;
push @dirs, "$dir/$sub" if -d "$dir/$sub";
&dir("$dir/$sub") if -d "$dir/$sub";
}
closedir $dh;
}
no strict;
for(@dirs){print $_,"\n";}
> Кхм.. Ну получили массив, а выводить как будете?
> Типа вещь в себе?
>my $a;
sub test_rec {
my ($end, $ref) = @_;
my @arr;
push @arr, $ref if ($ref);
push @arr, $end;
for(my $i =1; $i < $end; $i++) {
test_rec($end - $i, \@arr);
}
return \@arr;
}
$a = test_rec(2, $a);
print "\n\n@{$a}"."\n\n";
print @_."\n" for @{$a};
Давайте для начала измению немного задачу, не будем привязываться к дереву папок, с этим у меня вопрососв нет.
На данный момент вопрос в рекурсии, например приведенный выше пример скрипта, как я понимаю должен возвращать масив по ссылке (return \@arr;), пробовал и по значению, всё равно не работает.
Вся "магия" происходит на этапе return, при каждой итерации рекурсии, удаляется по одному элементу их массива.
> sub test_rec {
> ...
> ...
> my @arr;
> ...
> return \@arr;
> }Я давно на перле не пЕсал - но чет мне кажется что возвращать ссылку на массив который объявлен как "my" внутри блока не есть гут ))
> Я давно на перле не пЕсал - но чет мне кажется что
> возвращать ссылку на массив который объявлен как "my" внутри блока не
> есть гут ))Да, согласен!
Область видимости переменных никто не отменял.Всё дело в рекурсии, каждый вызов объявляет новый манипулятор каталога и новый массив.
Короче, не прокатит.Массивов бояться на перле не пейсать ))
Мы боимся и потому почти обойдёмся без них.
Вот те же яица, вид профиль с циклом for, без массива для "складирования" полученных директорий и с живым print'ом ))#!/usr/bin/perluse strict;
use warnings;my $path = $ARGV[0] || "/home";
sub tree {
my $root = shift;
my $dh;opendir $dh, $root;
my @dir = readdir $dh;
closedir $dh;
for my $subdir (@dir) {
next if $subdir eq "." or $subdir eq "..";
print "$root/$subdir\n" and tree("$root/$subdir") if -d "$root/$subdir";
}
}tree $path;
> Вся "магия" происходитА вам обязательно юзать свой код? На CPAN полно же готовых модулей.
File::Find;
File::Next;
use File::Next;my $iter = File::Next::dirs(@ARGV[0]);
while ( defined ( my $dirs = $iter->() ) ) {
print $dirs, "\n";
}
> А вам обязательно юзать свой код? На CPAN полно же готовых модулей.дайти людям вдоволь поеб**ься, чеж вы их советами то мучаете )))
Я наконец-то реализовал то что хотел, вот код:
sub collect_directorys_tree {
my ($root) = @_;
my @res;
push @res, "$root" if ( -d "$root" );
opendir my($dh), $root;
my @dir = readdir $dh;
closedir $dh;
if(@dir == 2) { return @res }
for my $subdir (@dir) {
next if $subdir eq "." or $subdir eq "..";
push @res, collect_directorys_tree("$root\\$subdir") if ( -d "$root\\$subdir" );
}
return @res;
}
#всем спасибо за помощь!
ещё вариант яиц ))#!/usr/bin/perluse strict;
use warnings;my $path = shift || "/home";
sub tree {
my $root = shift;
my $dirs = shift;opendir my($dh), $root;
while (my $subdir = readdir $dh) {
next if $subdir eq "." or $subdir eq "..";
push @$dirs, "$root/$subdir" if -d "$root/$subdir";
tree("$root/$subdir", $dirs) if -d "$root/$subdir";
}
closedir $dh;
return @$dirs;
}print $_,"\n" for my @tree_dirs = tree $path;
Учебная задача сделана, но в боевую систему такое ставить нельзя.
- дерево может в память не влезть
- в дереве могут оказаться симлинки
- и даже рекурсивные симлинки
> Учебная задача сделана, но в боевую систему такое ставить нельзя.
> - дерево может в память не влезть
> - в дереве могут оказаться симлинки
> - и даже рекурсивные симлинкисогласен с вами