Как удалить расширение в скрипте perl - PullRequest
Новая
       24

Как удалить расширение в скрипте perl

2 голосов
/ 17 июня 2020

Глупый вопрос, но он сводит меня с ума! У меня есть сценарий для удаления "жирных" данных в файле bvh. (Файл Mocap Biovision ..). Работает нормально, но создает двойное расширение ... (Имя.bvh.bvh) Мне нужно только одно расширение (* .bvh, а не * .bvh.bvh !!!) Вот код: 

@files = <*.bvh>;
foreach $file (@files) {
        open  (OLD, $file) || die "Couldn´t open $file: $!\n";
        open  (NEW, ">$file.bvh") || die "Couldn´t open $file.bvh: $!\n";
            while (<OLD>) {
                $line = $_;
                if (/Normal/) { while (<OLD>) { last if /}/; } $line => ""; }
                if (/normalIndex/) { while(<OLD>) { last if /[]]/; } $line = ""; }
                $line  =~  s/[-+]?[0-9]\.[0-9]+e[+-][0-9]+/0/g;
                $line  =~  s/([-+]?[0-9]+\.[0-9]{2})[0-9]+/$1/g;
                $line =~ s/0\.00/0/g;
                $line =~ s/[ ]+/ /g;
                $line =~ s/[\t]+/ /g;
                $line =~ s/^ //g;
                print NEW $line;

            }
            close OLD;
            unlink ($file);
            close NEW;          
            }

Есть помощь? Спасибо!

Ответы [ 3 ]

4 голосов
/ 17 июня 2020 
@files = <*.bvh>;

Это дает вам список файлов с расширением .bvh. Таким образом, он будет содержать что-то вроде: 

('foo.bvh', 'bar.bvh', 'baz.bvh')

Затем вы проходите по массиву с этим кодом: 

foreach $file (@files) {
  ...
}

Каждый раз вокруг этого l oop, $file будет содержать значение из вашего массива. Например, первая итерация $file будет содержать foo.bvh.

Затем вы открываете файлы ввода и вывода: 

open  (OLD, $file) || die "Couldn´t open $file: $!\n";
open  (NEW, ">$file.bvh") || die "Couldn´t open $file.bvh: $!\n";

Поскольку $file содержит foo.bvh, ваш новый файл (который создается с использованием имени "$file.bvh") будет называться foo.bvh.bvh.

Наивным решением будет удаление .bvh из оператора open(): 

# DON'T DO THIS
open  (OLD, $file) || die "Couldn´t open $file: $!\n";
open  (NEW, ">$file") || die "Couldn´t open $file.bvh: $!\n";

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

Вы в какой-то момент потребуется переименовать файл. И самый простой подход - сохранить существующие имена файлов и после обработки каждого файла переименовать его в исходное имя. 

# And then at the end of your loop
# Note that as you're copying the new file over the old one,
# there's no need to delete the old one.
close OLD;
close NEW;
rename("$file.bvh", $file);
2 голосов
/ 17 июня 2020

Просто вставьте rename("$file.new", $file);

, как показано в вашем коде: 

@files = <*.bvh>;
foreach $file (@files) {
        open  (OLD, $file) || die "Couldn´t open $file: $!\n";
        open  (NEW, ">$file.new") || die "Couldn´t open $file.new: $!\n";
            while (<OLD>) {
                $line = $_;
                if (/Normal/) { while (<OLD>) { last if /}/; } $line => ""; }
                if (/normalIndex/) { while(<OLD>) { last if /[]]/; } $line = ""; }
                $line  =~  s/[-+]?[0-9]\.[0-9]+e[+-][0-9]+/0/g;
                $line  =~  s/([-+]?[0-9]+\.[0-9]{2})[0-9]+/$1/g;
                $line =~ s/0\.00/0/g;
                $line =~ s/[ ]+/ /g;
                $line =~ s/[\t]+/ /g;
                $line =~ s/^ //g;
                print NEW $line;

            }
            close OLD;
            unlink ($file);

            close NEW;          
            rename("$file.new", $file);
            }
0 голосов
/ 17 июня 2020

Я уверен, что это не так, но вы можете получить результат.

Используйте этот модуль для переименования функции 

use File::Copy;

@files = qw(first.bhv second.bhv third.bhv);
foreach $file (@files) {

Просто удалите extension в исходном файле 

    (my $rem_ext = $file)=~s/\.bhv$//;

переименовать файл без extension

    rename($file, $rem_ext);

Просто прочтите без extension файл 

    open  (OLD, $rem_ext) || die "Couldn´t open $rem_ext: $!\n";

    open  (NEW, ">$file") || die "Couldn´t open $file.bvh: $!\n";
        while (<OLD>) {
             ...
        }
        close OLD;

Удалите файлы без extension, который создан нами самим. 

        unlink($rem_ext);
        close NEW;          
        }

Будет работать

...