Скрипт Perl, чтобы первые 8 символов были написаны заглавными буквами, но не всем именем файла - PullRequest
Новая
       22

Скрипт Perl, чтобы первые 8 символов были написаны заглавными буквами, но не всем именем файла

3 голосов
/ 27 марта 2012

Какой сценарий Perl я должен использовать, чтобы заменить только первые 8 символов в имени файла на все прописные, а не на скрипт, меняющий полное имя файла на все прописные?

Вот как я его настраиваю: 

#!/usr/bin/perl

chdir "directory path";
#@files = `ls *mw`;
@files = `ls | grep mw`;
chomp @files;

foreach $oldname (@files) {
  $newname = $oldname;
  $newname =~ s/mw//;
  print "$oldname -> $newname\n";
  rename("$oldname","$newname");
}

Ответы [ 6 ]

8 голосов
/ 27 марта 2012

Вы можете использовать это регулярное выражение: 

my $str = 'Hello World!';
$str =~ s/^(.{8})/uc($1)/se; # $str now contains 'HELLO WOrld!'
4 голосов
/ 27 марта 2012

Подстановка 

s/^(.{1,8})/\U$1/

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

use strict;
use warnings;

chdir "directory path" or die "Unable to change current directory: $!";

opendir my $dh, '.' or die $!;
my @files = grep -f && /mw/, readdir $dh;

foreach my $file (@files) {
  (my $new = $file) =~ s/mw//;
  $new =~ s/^(.{1,8})/\U$1/s;
  print "$file -> $new\n";
  rename $file, $new;
}
3 голосов
/ 27 марта 2012

Как насчет: 

#!/usr/bin/perl
use strict;
use warnings;
use File::Copy;

chdir'/path/to/directory';
# Find all files that contain 'mw'
my @files = glob("*mw*");

foreach my $file(@files) {
    # skip directories
    next if -d $file;
    # remve 'mw' from the filename
    (my $FILE = $file) =~ s/mw//;
    # Change filename to uppercase even if the length is <= 8 char
    $FILE =~ s/^(.{1,8})/uc $1/se;
    move($file, $FILE);
}

Как сказано в документе для переименования , вам лучше использовать File :: Copy , чтобы быть независимым от платформы.

2 голосов
/ 27 марта 2012

Всегда проверяйте возвращаемые значения системных вызовов!

Когда вы делаете какой-либо вызов службам ОС, вы должны всегда проверять возвращаемое значение.Например, документация Perl для chdir (с дополнительным акцентом)

chdir EXPR
chdir FILEHANDLE
chdir DIRHANDLE
chdir

Изменяет рабочий каталог на EXPR , если это возможно.Если EXPR опущен, изменяется на каталог, заданный $ENV{HOME}, если установлен;если нет, то изменяется на каталог, указанный $ENV{LOGDIR}.(В VMS переменная $ENV{SYS$LOGIN} также проверяется и используется, если она установлена.) Если ни одна из них не установлена, chdir ничего не делает. Возвращает true в случае успеха, иначе false. См. Пример под die.

В системах, которые поддерживают fchdir (2), вы можете передать дескриптор файла или дескриптор каталога в качестве аргумента.В системах, которые не поддерживают fchdir (2), дескрипторы передачи вызывают исключение.

Как написано в вашем вопросе, ваш код отбрасывает важную информацию: успешно ли выполняются системные вызовы chdir и renameили не удалось.

Предоставление полезных сообщений об ошибках

Пример общей идиомы проверки возвращаемых значений в Perl: 

chdir $path or die "$0: chdir $path: $!";

Сообщение об ошибке содержит три важных бита информации:

  • программа, выдавшая ошибку, $0
  • что она пыталась сделать, chdir в данном случае
  • почему это не удалось, $!

Также обратите внимание, что die также имя файла и номер строки, где находилось управление программой, если ваше сообщение об ошибке не заканчивается символом новой строки,При сбое chdir стандартная ошибка будет выглядеть как 

./myprogram: chdir: No such file or directory at ./myprogram line 3.

Logical или имеет значение true, если хотя бы один из ее аргументов имеет значение true.Идиома «сделай что-нибудь или умри» работает, потому что, если chdir выше терпит неудачу, она возвращает ложное значение и требует or для оценки правой части и завершает выполнение с die.В счастливом случае, когда chdir завершается успешно и возвращает истинное значение, нет необходимости оценивать правую часть, потому что у нас уже есть один истинный аргумент для логического или.

Предлагаемые улучшения вашего кода

Для того, что вы делаете, я рекомендую использовать readdir, чтобы избежать проблем, если одно из имен файлов содержит пробел.Обратите внимание на тест defined в приведенном ниже коде для остановки файла с именем 0 ( т.е. , один нулевой символ), завершающего ваш цикл. 

#! /usr/bin/env perl

chdir "directory path" or die "$0: chdir: $!";

opendir $dh, "." or die "$0: opendir: $!";

while (defined($oldname = readdir $dh)) {
  next unless ($newname = $oldname) =~ s/mw//;
  $newname =~ s/^(.{1,8})/\U$1/;
  rename $oldname, $newname or die "$0: rename $oldname, $newname: $!";
}

Чтобы у rename была какая-то надежда, вам нужно сохранить значение $oldname, поэтому код, приведенный выше, сразу копирует его в $newname и начинает изменять копию, а не оригинал.Вы увидите 

($new = $old) =~ s/.../.../;  # or /.../

в коде Perl, поэтому это также важная идиома для понимания.

Документация perlop определяет удобные escape-последовательности для использования в строках иподстановки регулярных выражений:

\l только следующий символ в нижнем регистре *
\u только следующий символ в верхнем регистре (не в верхнем регистре!)
\L все символы в нижнем регистре до \ E *
\U заглавные буквы всех символов до \ E увиденного
\Q кавычки не-словосочетаний до \ E
\E конец либо модификации регистра, либо раздела в кавычках (в зависимости от того, что было просмотрено в последний раз)

Приведенный выше код захватывает первые восемь символов (или меньше, если $newname короче по длине) и заменяет их аналогами в верхнем регистре.

Пример вывода

См. Код в действии:

$ ls directory\ path/
defmwghijk  mwabc  nochange  qrstuvwxyzmw

$ ./prog

$ ls directory\ path/
ABC  DEFGHIJK  QRSTUVWXyz  nochange
1 голос
/ 27 марта 2012

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

use v5.14;
use utf8;

chdir "/Users/brian/test/";
my @files = glob( 'mw*' );

foreach my $old (@files) {
    my $new = $old =~ s/\Amw(\pL{1,8})/\U$1/ir;
    print "$old → $new\n";
    }

Некоторые другие заметки:

  • Вы можете сделать глобус прямо в Perl. Вам не нужно ls.
  • Похоже, вы сняли mv, так что я сделал это. Если это не то, что вы хотите, это легко изменить.
0 голосов
/ 27 марта 2012

Вместо регулярного выражения в верхнем регистре первых восьми символов вы можете использовать форму с 4 аргументами substr . Это предлагает замену на месте. 

my $old = q(abcdefghij);
my $new = $old;
substr( $new, 0, 8, substr( uc($old), 0, 8 ) );
print "$old\n$new\n";

abcdefghij
ABCDEFGHij

Используйте rename или File::Copy::move (как показано в M42) для фактического переименования.

...