- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
- 26
- 27
- 28
- 29
- 30
- 31
- 32
- 33
- 34
- 35
- 36
- 37
- 38
- 39
- 40
- 41
# Relocate
if (open(my $reloc, "support/reloc.txt")) {
# ...
print "Relocating...";
my $count = 0;
local $_;
while (<$reloc>) {
chomp;
my($type, $f) = split(' ', $_, 2);
$f = "$prefix/$f";
$f =~ s,/,\\,g;
#print "Relocating $f...\n";
my $read_only;
unless (-w $f) {
$read_only++;
run("\@attrib", "-r", $f);
}
open(my $fh, "+<", $f) || die "Can't open $f: $!";
binmode($fh);
my $content = do { local $/; <$fh> };
if ($type eq "B") {
$content =~ s,\Q$sponge\E([^\0]*),$prefix$1$binary_pad,go;
}
else {
$content =~ s,\Q$sponge\E,$prefix,go;
$content =~ s,\Q$sponge_str\E,$prefix_str,go if $^O eq "MSWin32";
truncate($fh, length($content)) || die "Can't truncate '$f': $!";
}
seek($fh, 0, 0) || die "Can't reset file pos on '$f': $!";
print $fh $content;
close($fh) || die "Can't write back content to '$f': $!";
run("\@attrib", "+r", $f) if $read_only;
$count++;
}
print "done ($count files relocated)\n";
}
установщик перл...
reloc.txt содержит 137 файлов.
Follow us!