perl -i*是如何实现的？

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了没有扩展名(也就是for $extension eq '').Perl定义的行为是在没有创建备份文件的情况下编辑文件:

如果没有提供扩展,并且您的系统支持它,则原始文件将保持打开状态而没有名称,而输出将重定向到具有原始文件名的新文件.当perl退出时,干净利落或不干净,原始文件被取消链接.

也许我的系统(Mac OS X Yosemite 10.10.3)不支持它.

如果我把$extension = ''这个计划,那么代码将正常工作超过STDIN的一个块(4096个字节AcivePerl 5.10,但5.16的activeperl 8192个字节)的文件,但它会不会超过一个块大文件的工作.

它在我看来,在我的系统上,如果$ARGV并且$backup具有相同的值(如果它们将会是这样$extension eq '',那么第open(ARGVOUT, ">$ARGV")17行的调用就会在输入文件的一个块被读取之后破坏输入文件.

当然,我可以通过写入临时文件然后在最后重命名它来解决这个问题.但经过几个小时的调试后,我有点失望,perlrun中的例子并不像我预期的那样通用.

1. 是否有一种标准的,惯用的方式来处理$extension eq ''案件？

2. 这个$extension eq ''用例是否足够重要,应该编辑perlrun？当然,"和你的系统支持它"子句意味着这个例子并不正确,但如果它也涵盖了这种情况,那么这个例子会更有用.

Answer 1

Perl 5.28 改变了-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);