Удаление файлов

[diver]

В общем, имеються имена файлов внепонятной кодеровке
пример имени файла:

ЗАЯВКА для 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]

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]

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

Код:

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]

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

[RXL]

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

Приведенный мною код помести в начало программы.
Еще туда полезно добавить

Код: (Perl)

use strict;

Это поможет избежать многих ошибок, т.к. программа не запуститься, пока не уберешь все неопределенности и не выполнишь требования strict.

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

-e $szTempPath and -d $szTempPath

Достаточно только "-d".

Код:

	chmod(0777, $szPath);
	rename($szPath, "1");

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

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

[diver]

вот улучшил стиль немного:

Код:

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]

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

[RXL]

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

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

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

[diver]

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

[Sla]

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

open(STDOUT, ">:encoding(cp866)", "-");

[diver]

это нечего не дает

[RXL]

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

[Sla]

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

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

[diver]

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

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

[RXL]

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

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

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