在 perl 中没有正确设置变量

Question

我有以下代码：

#!/usr/bin/perl -w
use warnings;
use diagnostics;

open $fh, "<", "$ARGV[0]" or die "Could not open file: $!";

sub getsub {
    my $sub = $_[0];
    print "sub entered for $sub\n";
    while (<$fh>) {
        if ( /\.subckt $sub/ .. /\.ends/ ) {
            print;
        }
    }
}

while (<$fh>) {
    if ( $_ =~ /^xa1/ ) {
        $line = $_;
        print "line found to be $line\n";
        while ( ( my $nxt = readline($fh) ) =~ /^\+/ ) {
            $line = $nxt;
            print "line changed to $line\n";
        }
        $line =~ s/\s+$//;
        print "last line is $line\n";
        my $sub = ( split '\s', $line )[-1];
        print "subcircuit found is $sub in $line\n";
        getsub($sub);
    }
}

在这里，我试图在getsub 例程中的两个模式之间打印一些文本。但是当我尝试运行它时，我进入了子例程，但没有进入子例程内的 if 块。我正在尝试在以下文件上运行它：

.subckt a1 x y z
  xa a b c1
  xb c d e1
  xc f g h1
.ends

.subckt c1 x y z
  xa a b f
  xb c d e
  xc f g h
.ends

.subckt e1 x y z
  xa a b c1
  xb c d k1
  xc f g h1
.ends

xa1 a s f a1

我想打印.subckt a1和.ends之间的文件内容。

我知道这可以通过命令行上的 perl 一行来完成，但我想为不同的文件创建一些通用脚本，所以我只需要这样做。上面的代码有什么问题。

Answer 1

上面的代码有什么问题？

两件大事

1. 始终在每个脚本中包含 use strict; 和 use warnings;。

2. 在处理单个文件时尽量不要使用两个while 循环。

   如果您的文件在文件的不同部分需要特殊处理逻辑，则只需使用状态变量即可。

在这种情况下，要打印出两个标记之间的文件行，您只需要Range operator ..：

#!/usr/bin/perl -w
use strict;
use warnings;
use diagnostics;
use autodie;

my $file = shift;

#open my $fh, "<", $file;
my $fh = \*DATA;

while (<$fh>) {
    if ( my $range = /^\.subckt a1/ .. /^\.ends/ ) {
        print if $range != 1 && $range !~ /E/;
    }
}

__DATA__
.subckt a1 x y z
  xa a b c1
  xb c d e1
  xc f g h1
.ends

.subckt c1 x y z
  xa a b f
  xb c d e
  xc f g h
.ends

.subckt e1 x y z
  xa a b c1
  xb c d k1
  xc f g h1
.ends

xa1 a s f a1

输出：

  xa a b c1
  xb c d e1
  xc f g h1

从评论中回答问题的附录

我有三个问题：

1. /E/ 的值在 $range 函数中代表什么？

阅读 Range operator .. 的 perldoc：

... Flip-flip 返回的值要么是空字符串表示假，要么是序列号（以 1 开头）表示真。对于遇到的每个范围，都会重置序列号。范围中的最终序列号附加了字符串“E0”，这不会影响其数值，但如果您想排除端点，则可以搜索一些内容。等待序列号大于1即可排除起点。

因此 /E/ 用于排除范围的末尾，因此我们不打印包含 .ends 的行。

1. 而您将输入文件用作脚本的一部分，那么__DATA__ 做了什么？

我注释掉了输入文件句柄，而是使用了对 *DATA 的引用。

#open my $fh, "<", $file;
my $fh = \*DATA;

*DATA 是一个特殊的文件句柄，包含脚本中__DATA__ 之后的所有内容。这可以方便地测试脚本并展示如何做某事，而无需创建实际文件来加载进行测试。

1. 另外，如果我的文件很大，我应该采用这种方法吗？

无论何时进行文件处理，他们都应该以逐行处理文件为目标。这就是这里所做的，因此这也适用于大文件。

Answer 2

我将使用不同的方法发布一个示例，而不是调整 IMO 有点复杂的代码。

#!/usr/bin/perl

use strict;
use warnings;

$/ = '';  # enable paragraph mode

while (<DATA>) {
    print if /^\.subckt a1/;
}

__DATA__

.subckt a1 x y z
  xa a b c1
  xb c d e1
  xc f g h1
.ends

.subckt c1 x y z
  xa a b f
  xb c d e
  xc f g h
.ends

.subckt e1 x y z
  xa a b c1
  xb c d k1
  xc f g h1
.ends

这里是我之前解决方案的略微修改版本，它逐行循环文件而不是 od 段落模式。

#!/usr/bin/perl

use strict;
use warnings;

while (<DATA>) {
    if (/^\.subckt a1/ .. /^\.ends/) {
        print;
        print $/ if /^\.ends/
    }
}

__DATA__
.subckt a1 x y z
  xa a b f
  xb c d e
  xc f g h
.ends

.subckt a1 x y z
  xa a b c1
  xb c d e1
  xc f g h1
.ends

.subckt c1 x y z
  xa a b f
  xb c d e
  xc f g h
.ends

.subckt e1 x y z
  xa a b c1
  xb c d k1
  xc f g h1
.ends

我有第三种方法，我可能会在您的 perlmonks 线程上发布。

Answer 3

试试下面的代码，如下所示：我刚刚在 InputFile 中添加了一个 subckt a1 并且还提供了预期的输出。你在找这个还是别的什么？

输入文件：

.subckt a1 x y z
       xa a b c1
       xb c d e1
       xc f g h1
     .ends

 .subckt c1 x y z
  xa a b f
  xb c d e
  xc f g h
.ends

.subckt e1 x y z
  xa a b c1
  xb c d k1
  xc f g h1
.ends

.subckt a1 p q r
        xa a b f
        xb c d e
        xc f g h
     .ends

xa1 a s f a1

您的代码已修改：

 use strict;
    use warnings;
    open my $fh , "<", "$ARGV[0]" or die "Could not open file: $!";
     sub getsub{
        my $sub = $_[0];
        print "sub entered for $sub\n";
        my $var = do {
             local $/ = undef;
             open my $fh1 , "<", "$ARGV[0]" or die "Could not open file: $!";
             <$fh1>;
            };

        while($var =~ /\.subckt\s*$sub(.*?)\.ends/isg) {
          print $1;
        }
    }

    while  (<$fh>) {
        #print $_;
      if ($_ =~ /^xa1/) {
        my $line = $_;
        print "line found to be $line\n";
        while ((my $nxt = (readline($fh)) =~ /^\+/)) {
          $line = $nxt;
          print "line changed to $line\n";
        }
        $line =~ s/\s+$//;
        print  "last line is $line\n";
        my $sub = (split '\s', $line)[-1];
        print "subcircuit found is $sub in $line\n"; 
        getsub($sub);
      }
    }

优化代码：

use strict;
use warnings;

my $document = do {
 local $/ = undef; 
 open my $fh , "<", "$ARGV[0]" or die "Could not open file: $!";
 <$fh>;
};

while($document =~ /\.subckt\s*a1(.*?)\.ends/isg)
 {
print $1;
  }

预期输出：

x y z
   xa a b c1
   xb c d e1
   xc f g h1

  p q r
    xa a b f
    xb c d e
    xc f g h