Форум программистов «Весельчак У»
  *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

  • Рекомендуем проверить настройки временной зоны в вашем профиле (страница "Внешний вид форума", пункт "Часовой пояс:").
  • У нас больше нет рассылок. Если вам приходят письма от наших бывших рассылок mail.ru и subscribe.ru, то знайте, что это не мы рассылаем.
   Начало  
Наши сайты
Помощь Поиск Календарь Почта Войти Регистрация  
 
Страниц: [1]   Вниз
  Печать  
Автор Тема: Удаление ветви дерева каталогов  (Прочитано 5406 раз)
0 Пользователей и 1 Гость смотрят эту тему.
diver
Гость
« : 20-03-2008 11:05 » 

В общем ребята такая проблема - необходимо удалить каталог со всем его содержимым.
Проблема в том, что на сервере находятся некоторые файлы с длинными именами, и их невозможно удалить.
(TotalCommander их не может прочитать/скопировать/переместить и др средства тоже)
В скрипте выдается сообщение "Can't delete directory '$dir': $!\n";
Можно ли как-то обойти это и удалить файлы с длинными именами??
Или может написать скрипт для сканирования директорий и записи в log-файл тех файлов, что не может удалить (что б потом вручную их поправить)
Может как-то влияет на это кодировка(UTF8, ANSI)??
Или еще возможно написать срипт который выводит большую информацию о непрочитанных файлов (запорченых), что б понять в чем проблема(возможно кроме длинного имени в файлах, проблема скрыта в чем то другом – в кодировке например)

Мой скрипт для удаления таков:
Код:
#!/usr/bin/perl -w
use strict;
use File::Path;

if ( @ARGV ) {
    RemoveDir( @ARGV );
} else {
    print "\nYou must call this programm with parameters.\nSample: C:\\>perl $0 D:/dir1 C:/dir2\n\n";
    exit(0); # Завершаем выполнение программы
}

sub RemoveDir {
   while ( my $dir = shift ) {
           if ( -e $dir and -d $dir ) {
                rmtree( [ $dir ] )
                   ? print "Directory '$dir' was successfuly removed.\n"
                   : warn "Can't delete directory '$dir': $!\n";
           } else {
                print "Directory '$dir' is not exists or not directory.\n";
           }
   }
}
еще писал скрипт для вывода информации о файлах, но он чего-то не работает, на всякий случай кидаю код:
Код:
use Cwd: # модуль для определения текущего рабочего каталога
$1=1; # отключаем буферизацию ввода/вывода
sub ScanDirectory {
my ($workair) = shift;
my($startdir) = &cwd;
ft запоминаем, откуда мы начали chdir($workdir)
or die "Невозможно зайти а каталог $workdir:$'\n":
opendir(DIR, ".")
or die "Невозможно открыть каталог $workdir:$!\n";
my @names = readdir(DIR);
closedir(DIR);
foreach my $name (@names){ next if ($name eq "."); next if ($name eq "..");
if (-d $name){ ft это каталог?
&ScanDirectory($name); next; } unless (&CheckFile($name)){
print &cwd."/".$name."\n"; # выводим имя
ft поврежденного файла } }
sub CheckFile<
my($name) = shift;
print STDERR "Проверяется ". &cwd."/'".
$name. "\n"; # пытаемся получить состояние файла my @stat = stat($name);
if (!$stat[4] && '$stat[5] && !$stat[6] && !$stat[7] && l$stat[8]){ return 0;
i )
# пытаемся открыть этот файл unless (open(T,"$name")){
return 0: }
tt читаем файл по байту за один раз for (my $i=0;$i< $stat[7]:$i++){
фу $r=sys'-ead(T.$i, 1);
if ($r '= 1) { dose(T); retu--n 0 } >
close(T);
return 1: >
&ScanDirecto-y("."):
« Последнее редактирование: 20-03-2008 11:09 от diver » Записан
RXL
Технический
Администратор

ru
Online Online
Пол: Мужской

WWW
« Ответ #1 : 20-03-2008 21:32 » 

diver, не могу пока сказать точно. Попробуй директиву "use utf8;"

Кстати, мог бы код привести в читабельный вид - глаза в нем сломаешь.
« Последнее редактирование: 20-03-2008 21:34 от RXL » Записан

... мы преодолеваем эту трудность без синтеза распределенных прототипов. (с) Жуков М.С.
Страниц: [1]   Вверх
  Печать  
 

Powered by SMF 1.1.21 | SMF © 2015, Simple Machines