Эта тема на forum.dklab.ru


Ant: Удаление директории со всем её содержимым.
Как известно в узких кругах, удаление директории в Perl посредством функции «rmdir» возможно, только если директория пуста. Зачастую необходимо удалить директорию, которая содержит файлы и даже вложенные директории со своими файлами и т.д. Данная функция возвращает размер директории (указывается при вызове в первом аргументе) и полные пути ко всем файлам (даже во вложенных директориях) относительно заданной директории. Если второй аргумент больше «0», то директория со всем её содержимым удаляется.

# Return size of given directory (including embedded
# directories) and list of all files inside. If «$_[1] > 0»
# (the second argument) then delete all content.
sub filesList {
my $start_dir = $_[ 0 ];
my ( $number, $size ) = ( 0, 0 );
my ( @directories, @files, @dir );

return if !$start_dir or !-d $start_dir;

# Collection directories.
$directories[ 0 ] = $start_dir;
for ( my $i = 0; $i <= $number; $i++ ) {
opendir( local *DIR, $directories[ $i ] );
@dir = readdir( DIR );
closedir( DIR );
for ( my $k = 0; $k <= $#dir; $k++ ) {
if ( $i == 0 ) { local $/ = '/'; chomp $directories[ 0 ]; }
if ( -d "$directories[ $i ]/$dir[ $k ]" and $dir[ $k ] ne '.' and $dir[ $k ] ne '..' ) {
$directories[ ++$number ] = "$directories[ $i ]/$dir[ $k ]";
}
}
}

# Collection files.
$directories[ 0 ] = $start_dir;
@directories = sort( @directories );
for ( my $i = 0; $i <= $number; $i++ ) {
opendir( local *DIR, $directories[ $i ] );
@dir = readdir( DIR );
closedir( DIR );
for ( my $k = 0; $k <= $#dir; $k++ ) {
if ( $i == 0 ) { local $/ = '/'; chomp $directories[ 0 ]; }
if ( !-d "$directories[ $i ]/$dir[ $k ]" ) {
$size += ( stat( "$directories[ $i ]/$dir[ $k ]" ) )[ 7 ];
push( @files, "$directories[ $i ]/$dir[ $k ]" )
}
}
}

# Removing all directories.
if ( $_[ 1 ] ) {
unlink( @files );
for ( my $i = $#directories; $i >= 0; $i-- ) { rmdir $directories[ $i ] }
}

return $size, @files;
}

Примеры использования функции:

# Получить размер директории и список всех её файлов.
# Без удаления.
my ( $size, @files ) = filesList( "/home/user/www/data/" );

# Получить размер директории и список всех её файлов.
# При этом, удалить диреторию со всем её содержимым.
my ( $size, @files ) = filesList( "/home/user/www/data/", "1" );

# Просто удалить директорию.
filesList( "/home/user/www/data/", "1" );

Xor:
по моему проще, если не пользоваться модулями, так:

#рекурсивное удаление всех файлов и папок
sub rec_delete {
my $path = shift;
my @all_files = &ReadAllFiles("$path","0");
foreach (@all_files) {
unlink("$path/$_");
}
my @all_dirs = &ReadAllFiles("$path","1");
foreach (@all_dirs) {
&rec_delete("$path/$_");
}
rmdir($path);
return 1;
}

# получение списка файлов или списка папок; параметры: путь в папку где смотреть, флаг (1 - список директорий, 0 - список файлов)
sub ReadAllFiles {
my ($path,$ff) = @_;
my ($line, @dir_mas, @res_mas,@dira_mas);
opendir(DIR,"$path");
@dir_mas=readdir(DIR);
foreach $line(@dir_mas) {
if (!-d "$path/$line" && "$line" ne "." && "$line" ne ".." && !$ff) {
push(@res_mas,$line);
}
if ( -d "$path/$line" && "$line" ne "." && "$line" ne ".." && $ff) {
push(@dira_mas,$line);
}
}
closedir(DIR);
return @res_mas if (!$ff);
return @dira_mas if ($ff);
}

Дмитрий Котеров:
http://www.hmug.org/man/3/File::Path.php
гость:
всётаки интересно почему например так не работает рекурсия
#!/usr/local/perl/bin/perl -w
print "Content-Type: text/html\n\n";

sub ReadAllFiles {
my $path = shift;
local $line, DIR;
print '<hr/><b>' . $path . "/</b><br/>\n";

opendir(DIR, $path) || die 'ошибка открытия';
while($line = readdir(DIR)) {
if (-f $path.'/'.$line) {
print $line . "<br/>\n";
}
elsif ($line ne '.' && $line ne '..') {
ReadAllFiles($path.'/'.$line);
}
}
closedir(DIR);
print "<hr>\n";
}

my $dir = '..';
ReadAllFiles($dir);
доходит до первой дирректории потом до самой вложенной в ней и всё.
как-то можно поправить не создавая массивов содержимого дирректорий ?
(только начинаю изучать perl)
09h:
хоть тема старая но всеравно спс за ф-цию ) не пришлось велосипед изобретать
Sova2008:
Что заморачиваться? Мне кажется самое простое - File::Path;
rmtree
impactbomb:
Sova2008

о! спасибо )) совет дельный )
Ant:
Что заморачиваться? Мне кажется самое простое - File::Path;
Им не всегда получается пользоваться.
xyle:
что-то у меня вообще ни rmtree, ни filesList не работает ..(
rmtree при любых флагах всё удаляет, а filesList ничего не возвращает.
heed:
bat-файл

@rem = '
@echo off
cd /d %~dp0
setlocal
set PATH=%~dp0bin;%PATH%
:: или ещё где путь к perl
perl %0
endlocal
goto ENDOFPERL
rem ';
#!perl -w
use strict;
$| = 1;
my ($ds , $fs)=(0,0);

sub ReadAllFiles {
my $path = shift;
my $line;
print "\n\t\t" . $path . "\n";
opendir(local *DIR, $path) || die 'ошибка открытия';
while($line = readdir(DIR) ) {
if (-f $path.'/'.$line) {
$fs++;
print $line . ' ';
}
elsif ($line !~ /^\.{1,2}$/) {
$ds++;
ReadAllFiles($path.'/'.$line);
}
}
closedir(DIR);
print "\n-----------------\n";
}

my $dir = 'eg';

ReadAllFiles($dir);
print "\n\n$ds-$fs\n\n";
__END__
:ENDOFPERL
echo.
pause

Wooster:
Еще можно удалить в одну строчку через системны вызов

$result = `rm -fr /path/to/directory/`
tarianz:
Поскажите плз учебник на перле. Искал переменные my и our где можно по подробнее прочитать?
косоглазиеbates method
Ohlob:
Поскажите плз учебник на перле.

http://citforum.ru/internet/perl.shtml - склад русскоязычной документации по перлу
viktorz:
Поскажите плз учебник на перле. Искал переменные my и our где можно по подробнее прочитать?
косоглазиеbates method

Изучал перл по учебнику, называется перл за 15 минут. В инете поискать везде воляется)) А потом все как по масло пошло )

Эта тема на forum.dklab.ru