Please find attached a patch that solves this problem, too. I actually removed the system('mv'...) entirely, since that is generally not portable. Furthermore I changed the temp file generation to use File::Temp. The resulting new code works now fine on Windows with Strawberry Perl. I think the original proposal is correct in using File::Copy::move _before_ rename, so that there are less dummy warnings printed.
When updating, please mind adding File::Temp and File::Copy to the prerequisites of this distro.
Many thanks and happy new year,
Marek
--- C:\Strawberry\perl\site\lib\MP3\Tag\ID3v2.pm Sat Jan 2 18:12:40 2010
+++ lib\MP3\Tag\ID3v2.pm Thu Dec 3 23:34:48 2015
@@ -9,6 +9,8 @@
use strict;
use File::Basename;
# use Compress::Zlib;
+use File::Temp qw();
+use File::Copy qw(move);
use vars qw /%format %long_names %res_inp @supported_majors %v2names_to_v3
$VERSION @ISA %field_map %field_map_back %is_small_int
@@ -627,21 +629,15 @@
my ($self, $insert) = @_;
my $mp3obj = $self->{mp3};
# !! use a specific tmp-dir here
- my $tempfile = dirname($mp3obj->{filename}) . "/TMPxx";
+ my $tmpfh = File::Temp->new(TMPDIR => 1);
+ unless($tmpfh) {
+ warn "Problems with tempfile: $!\n";
+ return -1;
+ }
+ my $tempfile = $tmpfh->filename;
my $count = 0;
- while (-e $tempfile . $count . ".tmp") {
- if ($count++ > 999) {
- warn "Problems with tempfile\n";
- return undef;
- }
- }
- $tempfile .= $count . ".tmp";
- unless (open (NEW, ">$tempfile")) {
- warn "Can't open '$tempfile' to insert tag\n";
- return -1;
- }
my ($buf, $pos_old);
- binmode NEW;
+ binmode $tmpfh;
$pos_old=0;
$mp3obj->seek(0,0);
local $\ = '';
@@ -650,12 +646,12 @@
if ($pos_old < $ins->[0]) {
$pos_old += $ins->[0];
while ($mp3obj->read(\$buf,$ins->[0]<16384?$ins->[0]:16384)) {
- print NEW $buf;
+ print $tmpfh $buf;
$ins->[0] = $ins->[0]<16384?0:$ins->[0]-16384;
}
}
for (my $i = 0; $i<$ins->[2]; $i++) {
- print NEW chr(0);
+ print $tmpfh chr(0);
}
if ($ins->[1]) {
$pos_old += $ins->[1];
@@ -664,18 +660,23 @@
}
while ($mp3obj->read(\$buf,16384)) {
- print NEW $buf;
+ print $tmpfh $buf;
}
- close NEW;
+ close $tmpfh;
$mp3obj->close;
# rename tmp-file to orig file
- unless (( rename $tempfile, $mp3obj->{filename})||
- (system("mv",$tempfile,$mp3obj->{filename})==0)) {
- unlink($tempfile);
- warn "Couldn't rename temporary file $tempfile to $mp3obj->{filename}\n";
- return -1;
- }
+ my $fname = $mp3obj->{filename};
+ unless(unlink $fname) {
+ warn "Cannot unlink $fname: $!\n";
+ }
+ if(!rename($tempfile, $fname)) {
+ warn "Cannot rename $tempfile to $fname: $!\n";
+ if(!move($tempfile, $fname)) {
+ warn "Cannot move $tempfile to $fname: $!\n";
+ return -1;
+ }
+ }
return 0;
}
@@ -772,7 +773,6 @@
sub as_bin ($;$$$) {
my ($self, $ignore_error, $update_file, $raw_ok) = @_;
-
return $self->{raw_data}
if $raw_ok and $self->{raw_data} and not $self->{modified} and not $update_file;
@@ -848,7 +848,6 @@
my ($self,$ignore_error) = @_;
$self->fix_frames_encoding()
if $self->get_config1('id3v2_fix_encoding_on_write');
-
$self->get_frame_ids; # Ensure all the reading is done...
# Need to do early, otherwise file size for calculation of "best" padding
# may not take into account the added ID3v1 tag
@@ -893,33 +892,33 @@
sub remove_tag {
my $self = shift;
- my $mp3obj = $self->{mp3};
- my $tempfile = dirname($mp3obj->{filename}) . "/TMPxx";
+ my $mp3obj = $self->{mp3};
+
+ my $tmpfh = File::Temp->new(TMPDIR => 1);
+ unless($tmpfh) {
+ warn "Problems with tempfile: $!\n";
+ return undef;
+ }
+ my $tempfile = $tmpfh->filename;
my $count = 0;
local $\ = '';
- while (-e $tempfile . $count . ".tmp") {
- if ($count++ > 999) {
- warn "Problems with tempfile\n";
- return undef;
- }
+ my $buf;
+ binmode $tmpfh;
+ $mp3obj->seek($self->{tagsize}+10,0);
+ while ($mp3obj->read(\$buf,16384)) {
+ print $tmpfh $buf;
}
- $tempfile .= $count . ".tmp";
- if (open (NEW, ">$tempfile")) {
- my $buf;
- binmode NEW;
- $mp3obj->seek($self->{tagsize}+10,0);
- while ($mp3obj->read(\$buf,16384)) {
- print NEW $buf;
- }
- close NEW;
- $mp3obj->close;
- unless (( rename $tempfile, $mp3obj->{filename})||
- (system("mv",$tempfile,$mp3obj->{filename})==0)) {
- warn "Couldn't rename temporary file $tempfile\n";
- }
- } else {
- warn "Couldn't write temp file\n";
- return undef;
+ close $tmpfh || die $!;
+ $mp3obj->close;
+ my $fname = $mp3obj->{filename};
+ unless(unlink $fname) {
+ warn "Cannot unlink $fname: $!\n";
+ }
+ if(!rename($tempfile, $fname)) {
+ warn "Cannot rename $tempfile to $fname: $!\n";
+ if(!move($tempfile, $fname)) {
+ warn "Cannot move $tempfile to $fname: $!\n";
+ }
}
return 1;
}
