Início / unix / Perguntas / 793747
Accepted
jsx97
Asked: 2025-04-15 04:03:18 +0800 CST

Por que meus nomes de arquivo UTF-8 sempre correspondem a uma expressão de colchetes regex em Perl?

  • 772

Aqui está um script para corrigir nomes de arquivos cirílicos quebrados se os arquivos foram movidos do Windows para o Mac (com base em uma resposta para Reverter nomes de arquivos depois que eles foram corrompidos pelo uso de codificação diferente )

#!/bin/zsh

# Usage: <script> <target directory>
# Requires Perl::Rename

find "$1" -mindepth 1 -print0 |
  rename -0 -d -e '
    use Unicode::Normalize qw(NFC);
    use Encode qw(:all);

    if ($_ =~ /[†°Ґ£§•¶І®©™Ђђ≠]/) {
      my $check = DIE_ON_ERR | LEAVE_SRC;
      my $new = eval {encode("UTF-8",
                      decode("cp866",
                      encode("mac-cyrillic",
                      NFC(decode("UTF-8", $_, $check)), $check), $check))
                     };
      if ($new) {$_ = $new;} else {warn $@;}
    }'

Quero que ele renomeie apenas os arquivos no diretório de destino que tenham pelo menos um dos seguintes caracteres em seus nomes: †°Ґ£§•¶І®©™Ђђ≠. Mas, por algum motivo, o script renomeia todos os arquivos ali: por exemplo, um nome de arquivo correto срочно.txté alterado para um ёЁюўэю.txt. O que estou fazendo errado?

O caminho para minha pasta de teste é simples /Users/john/scripts/test: sem espaços, sem caracteres cirílicos ou especiais.

O script é usado no macOS e com a versão BSD do find.

Uma atualização dois dias após a resposta à pergunta: as versões Chazelas e Choroba do Stéphane funcionam bem para mim. A versão do Terdon ainda não funciona.

perl

4 respostas

  1. Por padrão, o Perl não espera código-fonte codificado em UTF-8. Você precisa informar se estiver usando caracteres codificados em UTF-8; caso contrário, o Perl os trata como bytes (no nosso caso, o byte 209 corresponde).

    use utf8;

    Além disso, você deve usar a -uopção para renameinformar ao Perl que os nomes dos arquivos são codificados em UTF-8 (ou especificar qualquer outra codificação, se necessário). Então, crie seu script:

    #!/bin/zsh

# Usage: <script> <target directory>
# Requires Perl::Rename

find "$1" -mindepth 1 -print0 |
  rename -0 -u -d -e '
    use Unicode::Normalize qw(NFC);
    use Encode qw(:all);
    use utf8;
    if ($_ =~ /[†°Ґ£§•¶І®©™Ђђ≠]/) {
      my $check = DIE_ON_ERR | LEAVE_SRC;
      my $new = eval {encode("UTF-8",
                      decode("cp866",
                      encode("mac-cyrillic",
                      NFC(decode("UTF-8", $_, $check)), $check), $check))
                     };
      if ($new) {$_ = $new;} else {warn $@;}
    }'

    Testado com o seguinte Makefile ( fixé o próprio script):

    .PHONY: test
test:
    mkdir path
    touch path/срочно.txt
    touch path/†°Ґ£§•¶І®©™Ђђ≠
    ./fix path
    ls path

.PHONY: clean
clean:
    rm -rf path

    Saídas:

    абвгдежзийклмн  срочно.txt
    • 11
  2. Best Answer

    Você está fazendo essa correspondência no nome de arquivo não decodificado, você precisaria fazer a decodificação (das partes decode("UTF-8", $_, $check)e NFC()) antes de fazer a correspondência.

    Também porque, como já mencionado, perlele interpreta seu código em iso8859-1 por padrão no Unix (ou melhor, em nível de byte, sem precisar fazer nenhuma codificação ou decodificação) e não em UTF-8, ele /[†°Ґ£§•¶І®©™Ђђ≠]/não funcionará a menos que você informe que eles são expressos em UTF-8.

    Então isso /[†°Ґ£§•¶І®©™Ђђ≠]/é literalmente o mesmo que /[\x{E2}\x{80}\x{A0}\x{C2}\x{B0}\x{D2}\x{90}\x{C2}\x{A3}\x{C2}\x{A7}\x{E2}\x{80}\x{A2}\x{C2}\x{B6}\x{D0}\x{86}\x{C2}\x{AE}\x{C2}\x{A9}\x{E2}\x{84}\x{A2}\x{D0}\x{82}\x{D1}\x{92}\x{E2}\x{89}\x{A0}]/, aí você reconhecerá \xe2\x80\xa0a codificação UTF-8 do †caractere:

    $ printf %s '†' | iconv -t utf-8 |  od -An -vtx1
 e2 80 a0

    Essa expressão regular corresponderia a qualquer string que contivesse qualquer um dos caracteres\xe2 ou \x80ou \xa0etc , que, se você não fizer nenhuma codificação/decodificação do nome do arquivo, corresponderá a qualquer string em que a codificação de qualquer caractere contenha os bytes , ... e milhares de caracteres contêm esses bytes quando codificados em UTF-8, incluindo (U+0440), por exemplo, cuja codificação UTF-8 é 0xd1 0x80.\xe2\x80р

    use utf8Como outros sugeriram, informa ao Perl que seu código é codificado em UTF-8, mas isso precisa ser feito no início do script. Aqui, o perlcódigo é passado como um argumento regular para o renamescript (não como um argumento de código para perl) e avaliado por esse script como parte de uma evalinstrução, portanto, uma use utf8adição não se aplicaria. Compare:

    $ perl -e 'use utf8; printf "%#x\n", ord("≠")'
0x2260

    o mesmo que:

    $ perl -Mutf8 -e 'printf "%#x\n", ord("≠")'
0x2260

    Este é o ponto de código de ≠, que foi decodificado corretamente de UTF-8. Com:

    $ rename 'use utf8; printf "%#x\n", ord("≠")' .
0xe2

    Esse é o valor do primeiro byte da codificação UTF-8 de ≠(também ponto de código de â(U+00E2), que é codificado como 0xe2 em iso8859-1).

    $ rename -u -e 'printf "%#x\n", ord("≠")' .
0xe2

    Usar -unão ajuda porque se trata da codificação/decodificação de nomes de arquivos, não do código Perl, e aqui não queremos usar -u, pois queremos fazer nossa própria codificação/decodificação com a verificação de sucesso.

    Aqui, você pode usar PERL_UNICODE=A rename...o que informa que perlos Aargumentos do script devem ser codificados em UTF-8 ou você pode usar \x{HHHH}ou \N{character name}para esses caracteres e manter o código em ASCII:

    find "$@" -depth -mindepth 1 -print0 |
  rename -0 -d -e '
    use Unicode::Normalize qw(NFC);
    use Encode qw(:all);
    use utf8;
    my $check = DIE_ON_ERR | LEAVE_SRC;
    my $new = eval {NFC(decode("UTF-8", $_, $check))};
    if ($new) {
      if ($new =~ /[\N{DAGGER}\N{DEGREE SIGN}\N{CYRILLIC CAPITAL LETTER GHE WITH UPTURN}\N{POUND SIGN}\N{SECTION SIGN}\N{BULLET}\N{PILCROW SIGN}\N{CYRILLIC CAPITAL LETTER BYELORUSSIAN-UKRAINIAN I}\N{REGISTERED SIGN}\N{COPYRIGHT SIGN}\N{TRADE MARK SIGN}\N{CYRILLIC CAPITAL LETTER DJE}\N{CYRILLIC SMALL LETTER DJE}\N{NOT EQUAL TO}]/) {
        $new = eval {encode("UTF-8",
                     decode("cp866",
                     encode("mac-cyrillic", $new, $check), $check))
                    };
        if ($new) {$_ = $new;} else {warn $@;}
      }
    } else {warn $@}'

    (Eu costumava uconv -x nameobter esses nomes de personagens, usados uconv -x hex/perl​​para obter o \x{HHHH}formulário).

    Ou findfaça a correspondência (assumindo uma implementação find/ fnmatch()que funcione bem com caracteres multibyte)

    com:

    find . -depth -mindepth 1 '(' -name '*[†°Ґ£§•¶І®©™Ђђ≠]*' -o \
  -name $'*=\u0338*' ')' -print0 |
  rename -0 -d -e '
    use Unicode::Normalize qw(NFC);
    use Encode qw(:all);
    my $check = DIE_ON_ERR | LEAVE_SRC;
    my $new = eval {encode("UTF-8",
                    decode("cp866",
                    encode("mac-cyrillic",
                    NFC(decode("UTF-8", $_, $check)), $check), $check))
                   };
    if ($new) {$_ = $new} else {warn$@}'

    (onde =\u0338é a forma decomposta do ≠caractere que o macOS pode usar no nome do arquivo¹).

    Ou use zshglobs em vez de find:

    print -rNC1 -- $^@/**/*(=$'\338'|[†°Ґ£§•¶І®©™Ђђ≠])*(NDod) |
  same rename command as above.

    ¹ e que NFC()no código Perl será convertido para sua forma Ccomposta F, aquela para a qual a cadeia de decodificação/codificação converterá н.

    • 7

  3. O problema é que você está correspondendo, $_mas não está tratando como Unicode. Você precisa primeiro decodificar $_para Unicode e depois corresponder. Isso deve funcionar:

    #!/bin/zsh

# Usage: <script> <target directory>
# Requires Perl::Rename

find "$1" -mindepth 1 -print0 |
  rename -0 -d -e '
    use Unicode::Normalize qw(NFC);
    use Encode qw(:all);

    if (decode("UTF-8",$_) =~ /[†°Ґ£§•¶І®©™Ђђ≠]/) {
      my $check = DIE_ON_ERR | LEAVE_SRC;
      my $new = eval {encode("UTF-8",
                      decode("cp866",
                      encode("mac-cyrillic",
                      NFC(decode("UTF-8", $_, $check)), $check), $check))
                     };
      if ($new) {$_ = $new;} else {warn $@;}
    }'

    Eu testei usando (onde foo.shestá o script acima):

    $ /home/terdon/perl5/bin/rename --version
/home/terdon/perl5/bin/rename using File::Rename version 2.02, File::Rename::Options version 2.01

    E:

    $ ls -l
total 0
-rw-r--r-- 1 terdon terdon 0 Apr 15 18:11 abd§•¶
-rw-r--r-- 1 terdon terdon 0 Apr 15 18:11 file.foo
-rw-r--r-- 1 terdon terdon 0 Apr 15 18:11 срочно.txt

$ foo.sh .

$ ls -l
total 0
-rw-r--r-- 1 terdon terdon 0 Apr 15 18:11 abdдеж
-rw-r--r-- 1 terdon terdon 0 Apr 15 18:11 file.foo
-rw-r--r-- 1 terdon terdon 0 Apr 15 18:11 срочно.txt
    • 5

  4. Aqui está minha própria versão, com alguns ajustes adicionais e um caso de teste.

    #!/bin/zsh

perl -MFile::Rename -e 1 2>/dev/null || {
  echo "Error: Perl module File::Rename is not installed." >&2
  exit 1
}

rename_all=false

find "$1" -mindepth 1 -depth -print0 |
  while IFS= read -r -d '' file; do
    name="${file##*/}"
    if $rename_all || echo "$name" | grep -q '[†°Ґ£§•¶І®©™Ђђ≠]'; then
      rename -0 -d -e '
        use Unicode::Normalize qw(NFC);
        use Encode qw(:all);
        my $check = DIE_ON_ERR | LEAVE_SRC;
        my $new = eval {
          encode("UTF-8",
            decode("cp866",
              encode("mac-cyrillic",
                NFC(decode("UTF-8", $_, $check)), $check), $check))
        };
        if ($new) { $_ = $new } else { warn $@ }' "$file"
    fi
  done

    Antes:

    target-dir
├── abc1.txt
├── срочно1.txt
├── бваг™вга†1
│   ├── abc2.txt
│   ├── срочно2.txt
│   ├── бваг™вга†2
│   │   ├── abc.txt
│   │   ├── срочно.txt
│   │   └── бваг™вга†.txt
│   └── бваг™вга†2.txt
└── бваг™вга†1.txt

    Depois:

    target-dir
├── abc1.txt
├── срочно1.txt
├── структура1
│   ├── abc2.txt
│   ├── срочно2.txt
│   ├── структура2
│   │   ├── abc.txt
│   │   ├── срочно.txt
│   │   └── структура.txt
│   └── структура2.txt
└── структура1.txt

    rename --version: /Users/john/perl5/bin/rename using File::Rename version 2.02, File::Rename::Options version 2.01

    • 2

relate perguntas