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

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

В общем, имеються имена файлов внепонятной кодеровке
пример имени файла:
Цитата
ЗАЯВКА для 2П7145 1114ЕУ7УИМ÷1114ЕУ10УИМ
скрипт напроч отказываеться удалять такие файлы.
Пробовал открыть файлы к других кодировках, так:
Код:
use open IO => ":raw:utf8";
но нечего не дало.

Лог ошибки таков (удалял каталог файлов):

Код:
H:\>perl d.pl tmp
<DIR>   tmp\IC
<DIR>   tmp\IC\HOME_IC
<DIR>   tmp\IC\HOME_IC\╧┼╨┼╧╚╤╩└
<DIR>   tmp\IC\HOME_IC\╧┼╨┼╧╚╤╩└\─юэёъющ
<FILE>  tmp\IC\HOME_IC\╧┼╨┼╧╚╤╩└\─юэёъющ\2╧7141└1 ? 2╧7144└1.doc
UNLINK FILE: tmp\IC\HOME_IC\╧┼╨┼╧╚╤╩└\─юэёъющ\2╧7141└1 ? 2╧7144└1.doc
RM DIR: tmp\IC\HOME_IC\╧┼╨┼╧╚╤╩└\─юэёъющ
Can't remove directory tmp\IC\HOME_IC\╧┼╨┼╧╚╤╩└\─юэёъющ: Directory not empty
RM DIR: tmp\IC\HOME_IC\╧┼╨┼╧╚╤╩└
Can't remove directory tmp\IC\HOME_IC\╧┼╨┼╧╚╤╩└: Directory not empty
<DIR>   tmp\IC\HOME_IC\╤ыєцхсэ√х чряшёъш
<DIR>   tmp\IC\HOME_IC\╤ыєцхсэ√х чряшёъш\╩юЁчєэє-╙╠╥╬
<FILE>  tmp\IC\HOME_IC\╤ыєцхсэ√х чряшёъш\╩юЁчєэє-╙╠╥╬\╟└▀┬╩└ фы  2╧7145 1114┼╙7╙╚╠?1114┼╙10╙╚╠.doc
UNLINK FILE: tmp\IC\HOME_IC\╤ыєцхсэ√х чряшёъш\╩юЁчєэє-╙╠╥╬\╟└▀┬╩└ фы  2╧7145 1114┼╙7╙╚╠?1114┼╙10╙╚╠.doc
<FILE>  tmp\IC\HOME_IC\╤ыєцхсэ√х чряшёъш\╩юЁчєэє-╙╠╥╬\╟└▀┬╩└ фы  2╧7145 ш 1114┼╙7╙╚╠?1114┼╙10╙╚╠ 2.doc
UNLINK FILE: tmp\IC\HOME_IC\╤ыєцхсэ√х чряшёъш\╩юЁчєэє-╙╠╥╬\╟└▀┬╩└ фы  2╧7145 ш 1114┼╙7╙╚╠?1114┼╙10╙╚╠ 2.doc
RM DIR: tmp\IC\HOME_IC\╤ыєцхсэ√х чряшёъш\╩юЁчєэє-╙╠╥╬
Can't remove directory tmp\IC\HOME_IC\╤ыєцхсэ√х чряшёъш\╩юЁчєэє-╙╠╥╬: Directory not empty
RM DIR: tmp\IC\HOME_IC\╤ыєцхсэ√х чряшёъш
Can't remove directory tmp\IC\HOME_IC\╤ыєцхсэ√х чряшёъш: Directory not empty
RM DIR: tmp\IC\HOME_IC
Can't remove directory tmp\IC\HOME_IC: Directory not empty
RM DIR: tmp\IC
Can't remove directory tmp\IC: Directory not empty
RM DIR: tmp
Can't remove directory tmp: Directory not empty
Directorys: 7
Files: 3

Сам скрипт такой:

Код:
#!/usr/bin/perl

$szSeparator="\\"; #разделитель каталогов (для Windows и NetWare "\\", для Unix "/" )
$uFiles=0; #общее кол-во файлов
$uDirectorys=0; #общеее кол-во каталогов

# ======================================================================
# Functions _SCAN_DIR
# ======================================================================
sub _SCAN_DIR{
my $szCurrentDir;
($szCurrentDir)=@_;

opendir(DIR,$szCurrentDir) or warn "can't open directory $dir: $!" and return 0;
my @DirList=readdir(DIR) or warn "can't read directory $!\n";
closedir(DIR);

foreach my $szName(@DirList){
#next if($szName eq ".");
#next if($szName eq "..");
next if($szName =~ /^\.\.?$/);
my $szTempPath="$szCurrentDir$szSeparator$szName"; # полный путь
if(-e $szTempPath and -d $szTempPath){ # операция над каталогом
print("<DIR>\t$szTempPath\n");
&_SCAN_DIR($szTempPath);
next;
}else{ # операция над файлами
print("<FILE>\t$szTempPath\n");
&_REMOVE_FILE($szTempPath);
next;
}
}
&_REMOVE_EMPTY_DIR($szCurrentDir);
}

# ======================================================================
# Functions _REMOVE_EMPTY_DIR
# ======================================================================
sub _REMOVE_EMPTY_DIR{
my $szPath;
($szPath)=@_;
print("RM DIR: $szPath\n");
chmod(0777,$szPath);
rmdir($szPath) or warn "Can't remove directory $szPath: $! \n";
$uDirectorys++;
return;
}

# ======================================================================
# Functions _REMOVE_FILE
# ======================================================================
sub _REMOVE_FILE{
my $szPath;
($szPath)=@_;
print("UNLINK FILE: $szPath\n");
chmod(0777, $szPath);
rename($szPath, "1");
#unlink($szPath) or warn "Can't remove file $szPath: $! \n";
$uFiles++;
return;
}

&_SCAN_DIR(@ARGV); # вход в программу (main)
print("Directorys: $uDirectorys\nFiles: $uFiles\n");

Может стоит перекодировать имена файлов в другую кодировку? Тогда не подскажите как это сделать? Здесь была моя ладья...
Спасибо.
Записан
RXL
Технический
Администратор

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

WWW
« Ответ #1 : 18-06-2008 16:24 » 

diver, у меня два предложения: по стилю и по коду. Поверь, оба важны.

Несколько замечаний по стилю.
1. Не начинай имена переменных и ф-ий со строчных букв - так обозначают константы. Собственно, стиль полностью соответствует принятому в других языках, как-то C, C++, Java и т.д. Будет меньше путать.
2. Вместо & перед именем ф-ии лучше определяй прототипы (так же, как и в С - раньше первого вызова в тексте).
3.
Цитата
foreach my $szName(@DirList){
3.1. Делай отступы и не сцепляй имена переменных со скобками - будет меньше путаницы и неожиданного поведения программы.
3.2. Фигурные скобки, обозначающие блоки, лучше переносить на новую строку. Хотя оба стиля имеют право на существование, скобка на отдельной строке визуально отделает оператор и тело блока - легче читается.
3.3. Оператор foreach в Perl - синоним для for. Традиционно применяется for.
4. Старайся применять для строк одиночные кавычки, за исключением случаев, когда нужна интерполяция строки (в том числе, когда нужно вставлять \n \t и т.п.). Это спасет от нежелательных интерполяций и ускорит код.

По коду.
Судя по всему, ты работаешь в виндовой консоли. Надо знать, что там иная кодировка, чем в самой винде. Именуется OEM (реальная кодовая страница зависит от локали системы).

Perl может автоматически перекодировать текст при вводе-выводе, но опции можно определить только при открытии файла. Дескриптор STDOUT, в который неявно выводит print, можно переоткрыть.
Попробуй переоткрыть STDOUT с указанием кодировки:
Код: (Perl)
use PerlIO::encoding;

open(STDOUT, ">:encoding(cp866)", "-");
Записан

... мы преодолеваем эту трудность без синтеза распределенных прототипов. (с) Жуков М.С.
diver
Гость
« Ответ #2 : 19-06-2008 06:13 » 

По стилю коменты это конечно интерестно, но меня больше интерисует то, что б код заработал правильно, он спокойно удаляет несложные каталоги с файлами, а вот если файлы как я привел выше, то не получаеться удалить.
Код:
use PerlIO::encoding;

open(STDOUT, ">:encoding(cp866)", "-");
куда мне эту впихнуть?
я ж вначале открываю каталог и считываю от туда все, потом провряю, это файл или каталог. Плюс это все в рекурсии.
Код:
opendir(DIR,$szCurrentDir) or warn "can't open directory $dir: $!" and return 0;
my @DirList=readdir(DIR) or warn "can't read directory $!\n";

я на перле токо начал писать, так что возможно эти вопросы глупые А черт его знает...
Записан
Sla
Команда клуба

ua
Offline Offline
Пол: Мужской

WWW
« Ответ #3 : 19-06-2008 06:40 » 

STDOUT - "стандартный вывод", т.е. то что ты выводишь в консоль будет перекодироваться в cp866
Записан

Мы все учились понемногу... Чему-нибудь и как-нибудь.
RXL
Технический
Администратор

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

WWW
« Ответ #4 : 19-06-2008 07:02 » 

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

Приведенный мною код помести в начало программы.
Еще туда полезно добавить
Код: (Perl)
use strict;
Это поможет избежать многих ошибок, т.к. программа не запуститься, пока не уберешь все неопределенности и не выполнишь требования strict.

Кстати - "Directory not empty". Ни о чем не говорит?
При рекурсивном обходе, если встречается директория, то сперва входи в нее и удаляй все внутри, а только потом саму директорию. С рекурсией это легко реализуется и директория удялиться только после того, когда очистятся и удаляться все поддиректории.

Цитата
-e $szTempPath and -d $szTempPath
Достаточно только "-d".

Цитата
Код:
chmod(0777, $szPath);
rename($szPath, "1");
Это что такое?
Под виндой chmod ничего не делает (просто затычка), а переименовать все файлы в "1" вместо удаления - конечно ты потом не сможешь удалить директорию, в которой они остались.

Говорю же - надо причесать сперва, а в процессе и мысли появятся.
Записан

... мы преодолеваем эту трудность без синтеза распределенных прототипов. (с) Жуков М.С.
diver
Гость
« Ответ #5 : 19-06-2008 10:38 » 

вот улучшил стиль немного:
Код:
use strict;

my $Separator = "\\"; #разделитель каталогов (для Windows и NetWare "\\", для Unix "/" )
my $Files = 0; #общее кол-во файлов
my $Directorys = 0; #общеее кол-во каталогов
my $dir = 0;

sub RemoveDir
{
my $CurrentDir;
($CurrentDir) = @_;

opendir(DIR, $CurrentDir) or warn "can't open directory $dir: $!" and return 0;
my @DirList = readdir(DIR) or warn "can't read directory $!\n";
closedir(DIR);

foreach my $Name(@DirList)
{
next if($Name = ~/^\.\.?$/);
my $TempPath = "$CurrentDir$Separator$Name"; # полный путь
if(-d $TempPath)
# операция над каталогом
{
#print("<DIR>\t$TempPath\n");
&RemoveDir($TempPath);
next;
}
# операция над файлами
else
{
#print("<FILE>\t$TempPath\n");
&RemoveFile($TempPath);
next;
}
}
&RemoveTree($CurrentDir);
}

sub RemoveTree
{
my $Path;
($Path) = @_;
print("RM DIR: $Path\n");
chmod(0777, $Path);
rmdir($Path) or warn "Can't remove directory $Path: $! \n";
$Directorys++;
return;
}

sub RemoveFile
{
my $Path;
($Path) = @_;
print("UNLINK FILE: $Path\n");
chmod(0777, $Path);
unlink($Path) or warn "Can't remove file $Path: $! \n";
$Files++;
return;
}

&RemoveDir(@ARGV); # вход в программу (main)
print("Directorys: $Directorys\nFiles: $Files\n");

вообще скрипт будет выполняться на сервере NetWare, просто в винде тоже не удаляються файлы, с такими именами, хотя не факт, что тут дело только с именами (есть проблема с правами - поэтому тут и имееться chmod(0777, $Path),  для предоставления прав, хотя я не уверен, что оно правильно работает, так как это все таки не UNIX, с этим буду потом разбираться)

в книгах и в любимом google только одна вода, нечерта по делу, вот цитата из книги:
Цитата
Как и во всем остальном в Perl, простые операции с файлами выполняються просто, а сложные... как-нибудь да выполняються.
Это все...
Записан
diver
Гость
« Ответ #6 : 19-06-2008 10:41 » 

просто может, кто-нибудь сталкивался с такой проблемой, вот я и спрашиваю.
Записан
RXL
Технический
Администратор

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

WWW
« Ответ #7 : 19-06-2008 16:30 » 

diver, фиговая книга...
По перл есть лиш одна стоящая книга (я ее много раз упоминал в статьях: "Программирование на Perl" https://club.shelek.ru/viewfiles.php?id=19), после нее - только официальная документация (http://www.perl.org/docs.html).

Так. Улучшил. Какой результат?

Кстати, я бы применил не warn, а die, т.к. любая ошибка с файлами здесь критическая.
Записан

... мы преодолеваем эту трудность без синтеза распределенных прототипов. (с) Жуков М.С.
diver
Гость
« Ответ #8 : 20-06-2008 05:34 » 

к сожалению нечего не улучшилось, буду думать.
Записан
Sla
Команда клуба

ua
Offline Offline
Пол: Мужской

WWW
« Ответ #9 : 20-06-2008 05:57 » 

diver, а что должно было улучшится?
где
use PerlIO::encoding;

open(STDOUT, ">:encoding(cp866)", "-");
Записан

Мы все учились понемногу... Чему-нибудь и как-нибудь.
diver
Гость
« Ответ #10 : 20-06-2008 06:49 » 

это нечего не дает
Записан
RXL
Технический
Администратор

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

WWW
« Ответ #11 : 20-06-2008 09:36 » 

diver, так ты расскажи, что получается. Или ты ждешь, чтобы я у себя запускал программу, которая удаляет файлы и работает не правильно?
Записан

... мы преодолеваем эту трудность без синтеза распределенных прототипов. (с) Жуков М.С.
Sla
Команда клуба

ua
Offline Offline
Пол: Мужской

WWW
« Ответ #12 : 20-06-2008 09:54 » 

я проверил у себя на винде - работает
кодировкой не заморачивался
файлы с русскими именами удаляет

У Новела есть (по крайней мере, были) проблемы с русской кодировкой
Записан

Мы все учились понемногу... Чему-нибудь и как-нибудь.
diver
Гость
« Ответ #13 : 23-06-2008 06:35 » 

Понимаете, простые имена, скрипт удаляет на ура(русские, не русские, без разницы), а вот если имена файлов содержат символы какой то другой кодовой страницы, то скрипт ступориться, лог ошибки тот же, см выше.
На счет Netware, в Windows эти файлы также не удаляються, так что видимо все таки проблема, что скрипт не может прочитать имя файла, а потом когда хочет удалить каталог, т.к. в нем есть файлы, он пишет ошибку -  Directory not empty

Я приложил пример каталога, которые не удаляеться, может станет вам яснее, в чем проблема.
Сам пока попробую, что либо сделать, может получиться, стоко времени не могу написать толком работающий скрипт, то ли это диагноз, толи ДНК, непонятно Здесь была моя ладья...
Спасибо, за любую помощь.


* Home.rar (59.96 Кб - загружено 858 раз.)
Записан
RXL
Технический
Администратор

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

WWW
« Ответ #14 : 23-06-2008 16:31 » new

В строке не может быть нескольких кодировок.

Вполне возможно, что в кодировке по умолчанию может отсутствовать символ, соответствующий коду 0xF7 (симовол "÷" в cp1251). К сожалению, нечем мне проверить - не держу на винде Perl.

Давай попробуем так: сделай скрипт, который открывает директорию, читает имена и сваливает их в файл. Потом посмотри, что в файле вышло и нет ли каких-либо изменений в именах.
Записан

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

Powered by SMF 1.1.21 | SMF © 2015, Simple Machines