perl -i *really* 是如何实现的？

Question

在http://perldoc.perl.org/perlrun.html 对 Perl -i[extension] 功能的描述中，与以下程序基本相同的代码被视为使用 perl -pi.orig ... 的“等价物”：

#!/usr/bin/perl

use strict;
use warnings;

my $extension = '.orig';
my $oldargv = '';
my $backup;
LINE: while (<>) {
    if ($ARGV ne $oldargv) {
        if ($extension !~ /\*/) {
            $backup = $ARGV . $extension;
        } else {
            ($backup = $extension) =~ s/\*/$ARGV/g;
        }
        rename($ARGV, $backup);
        open(ARGVOUT, ">$ARGV");
        select(ARGVOUT);
        $oldargv = $ARGV;
    }
    # Don't change anything; just copy.
}
continue {
    print;
}
select(STDOUT);

$extension eq '.orig' 时这工作正常；然而，Perl 也定义了没有扩展名的-i（即$extension eq ''）。 Perl 定义的行为是在原地编辑文件，而不创建备份文件：

如果没有提供扩展，并且您的系统支持它，则原来的 当输出被重定向到一个 具有原始文件名的新文件。当 perl 退出时，无论是否干净， 原始文件已取消链接。

也许我的系统（Mac OS X Yosemite 10.10.3）不支持它。

如果我在这个程序中设置$extension = ''，那么代码对于小于一个 STDIN 块的文件（AcivePerl 5.10 中为 4096 字节，而 ActivePerl 5.16 中为 8192 字节）将正常工作，但它会不 适用于大于 1 块的文件。

在我看来，在我的系统上，如果 $ARGV 和 $backup 具有相同的值（如果 $extension eq '' 相同，那么第 17 行上的 open(ARGVOUT, ">$ARGV") 调用会在一个块之后破坏输入文件已阅读。

当然，我可以通过写入一个临时文件然后在最后重命名它来解决这个问题。但是我有点失望，经过几个小时的调试，perlrun 中的示例没有我预期的那样通用。

1. 是否有标准、惯用的方法来处理$extension eq '' 案例？

2. 这个$extension eq '' 用例是否足够重要以至于应该编辑perlrun？当然，“and your system supports it”子句表示这个例子没有错，但是如果这个例子也能涵盖这种情况会更有用。

Answer 1

Perl 5.28 changed -i。此答案适用于早期版本的 Perl。

---

提供扩展时：

open(my $fh_in,  '<', $qfn);
rename($qfn, "$qfn$ext");
open(my $fh_out, '>', $qfn);

这可以使用strace查看。

$ strace perl -i~ -pe1 a
...
open("a", O_RDONLY)                     = 3
rename("a", "a~")                       = 0
open("a", O_WRONLY|O_CREAT|O_EXCL, 0600) = 4
...

---

当没有提供扩展时：

open(my $fh_in,  '<', $qfn);
unlink($qfn);
open(my $fh_out, '>', $qfn);

这可以使用strace查看。

$ strace perl -i -pe1 a
...
open("a", O_RDONLY)                     = 3
unlink("a")                             = 0
open("a", O_WRONLY|O_CREAT|O_EXCL, 0600) = 4
...

---

Mac 等 Unix 系统支持匿名文件。 Windows 没有，所以-i 需要在那里扩展。

>perl -i.bak -pe1 a

>perl -i -pe1 a
Can't do inplace edit without backup.

---

如果我们将这些知识整合到您发布的代码中，我们会得到以下信息：

#!/usr/bin/perl

use strict;
use warnings;

my $extension = '.orig';
my $oldargv = '';
my $backup;
LINE: while (<>) {
    if ($ARGV ne $oldargv) {
        if (length($extension)) {
            if ($extension !~ /\*/) {
                $backup = $ARGV . $extension;
            } else {
                ($backup = $extension) =~ s/\*/$ARGV/g;
            }
            rename($ARGV, $backup);
        } else {
            die("Can't do inplace edit without backup.\n") if $^O eq 'MSWin32';
            unlink($ARGV);
        }
        open(ARGVOUT, ">$ARGV");
        select(ARGVOUT);
        $oldargv = $ARGV;
    }
    # Don't change anything; just copy.
}
continue {
    print;
}
select(STDOUT);