How delete extension in a perl script - perl

Question

A silly question, but it make me crazy!
I have a script to remove "fat" data in a bvh file. (Biovision mocap file..).
Works fine, but it create a double extension... (The name.bvh.bvh)
I just only need one extension (*.bvh, not the *.bvh.bvh!!!)
Here is the code:
#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;
}
Any help? Thanks!

Answer 1

#files = <*.bvh>;
This gives you a list of the files that have a .bvh extension. So it will end up containing something like:
('foo.bvh', 'bar.bvh', 'baz.bvh')
Then you walk the array with this code:
foreach $file (#files) {
...
}
Each time round this loop, $file will contain a value from your array. One the first iteration, for example, $file will contain foo.bvh.
Then you open input and output files:
open (OLD, $file) || die "Couldn´t open $file: $!\n";
open (NEW, ">$file.bvh") || die "Couldn´t open $file.bvh: $!\n";
As $file contains foo.bvh, your new file (which is created using the name "$file.bvh") will be called foo.bvh.bvh.
The naive fix would be to remove the .bvh from the open() statement:
# DON'T DO THIS
open (OLD, $file) || die "Couldn´t open $file: $!\n";
open (NEW, ">$file") || die "Couldn´t open $file.bvh: $!\n";
This won't work as your old and new files will now have the same name and when you open your new file for writing, it will truncate the file and remove all of your input data.
You'll need to rename a file at some point. And the easiest approach is to keep your existing filenames and once you have processed each file, rename it to the original name.
# 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);

Answer 2

Just insert rename("$file.new", $file);
as shown in your code:
#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);
}

Answer 3

I am sure this is not the way however you can get the output.
Use this Module for renaming function
use File::Copy;
#files = qw(first.bhv second.bhv third.bhv);
foreach $file (#files) {
Just remove the extension on the original file
(my $rem_ext = $file)=~s/\.bhv$//;
rename the file without extension
rename($file, $rem_ext);
Just read the without extension file
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;
Delete the files without extension which is created by ourself.
unlink($rem_ext);
close NEW;
}
It will works