在程序中模拟 -pi 的实际 Perl 代码是什么？答案

【问题标题】：What is the actual Perl code that will mimic -pi inside the program?在程序中模拟 -pi 的实际 Perl 代码是什么？
【发布时间】：2010-11-06 14:21:58
【问题描述】：

这似乎是多余的，从 Perl 脚本本身运行 perl。

my $Pref = "&*())(*&^%$#@!"; 
system("perl -pi -e 's|^SERVERNAME.*\$|SERVERNAME \"\Q$Pref\E\"|g' pserver.prefs");

模仿 -pi 的实际 Perl 代码是什么？我只想要在 Perl 上像 sed 一样工作的东西，尽可能简单。

根据 Todd Gardner 的网站，它似乎基本上只是读取和写入所有文件，试图将正则表达式应用于每一行。对于像我这样的新手 Perl 用户来说，这个解决方案有点复杂，所以我使用以下方法简化了它：

my $ftp = "/home/shared/ftp";
my $backup = $ftp . ".bak";
rename($ftp, $backup);
open (FTP, "<", $backup) or die "Can't open $backup: $!"; 
open (FTP_OUT, ">", $ftp) or die "Can't open $ftp: $!"; 
    while (<FTP>)
    {
        $_ =~ s|$panel_user \Q$panel_oldpass\E |$panel_user \Q$panel_newpass\E |g;
        print FTP_OUT $_;
    }
close(FTP);
close(FTP_OUT);

使用两个打开有什么问题吗？是否应该避免这种情况，还是可以采用简单的解决方案？

我必须承认，系统 sed 命令要简单得多。

【问题讨论】：

如果您想打开两个不同的文件，两次打开是正常的并且是必需的——这正是您想要的。回复：sed 更简单、更干净——绝对可能是这样，但请记住，在幕后，某些程序必须打开每个文件，检查每一行，必要时进行替换，打印出该行等。没有什么神奇的方法将替换项滑入文件而不查看文件中的数据。或者，如果有的话，我希望有人教给我们俩。

标签： regex perl sed

【解决方案1】：

B::Deparse是你的朋友：

cowens@amans:~/test$ perl -MO=Deparse -pi -e 1
BEGIN { $^I = ""; }
LINE: while (defined($_ = <ARGV>)) {
    '???';
}
continue {
    print $_;
}
-e syntax OK

由此我们可以看出$^I 是实现就地编辑的东西。只需将@ARGV 设置为您要编辑的文件，然后循环即可。

【讨论】：

【解决方案2】：

Perlmonks 的建议相当于：

use English qw<$INPLACE_EDIT>;

{
    local ($INPLACE_EDIT, @ARGV) = ('.bak', @files);   
    while (<>) {
        s/this/that/;
        print;       
    }
}

在同一线程中也推荐Sysadm::Install::pie

【讨论】：

【解决方案3】：

我只会使用Tie::File。

use Tie::File;
use File::Copy;

copy $file, "$file.bak" or die "Failed to copy $file to $file.bak: $!";
tie @array, "Tie::File", $file or die "Can't open $file: $!";
s/foo/bar/ for @array;

【讨论】：

快速说明 Tie::File 在 5.8 中成为核心 Perl 的一部分。如果您使用的是 5.8 之前的版本，请升级（请），或者您可以从 CPAN 下载 Tie::File。

【解决方案4】：

查看perlrun，其中详细描述了这些选项。特别是，它列出了一些选项：

从shell说

$ perl -p -i.orig -e "s/foo/bar/; ... "

和使用程序一样：

#!/usr/bin/perl -pi.orig
s/foo/bar/;

相当于

#!/usr/bin/perl
$extension = '.orig';
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;
}
s/foo/bar/;
}
continue {
print;  # this prints to original filename
}
select(STDOUT);

【讨论】：