Perl程序可以知道__DATA__开头的行号吗？

时间：2019-04-22 02:42:01

标签： perl

有没有一种方法可以获取编码 __ DATA __ 令牌的行号（也许还有文件名）？还是通过其他方式知道从 DATA 文件句柄读取的一行数据来自的原始源文件中的实际行号？

请注意，从$.文件句柄读取时，DATA从1开始计数。因此，如果将__DATA__令牌的行号添加到$.，那将是我想要的。

例如：

#!/usr/bin/perl
while (<DATA>) {
  my $n = $. + WHAT??;
  die "Invalid data at line $n\n" if /bad/;
}

__DATA__
something good
something bad

我希望它说的是“第9行的数据无效”，而不是“第2行”（如果单独使用$.，则会得到此结果。）

5 个答案:

答案 0 :(得分：7)

在支持/proc/<pid>虚拟文件系统的系统（例如Linux）中，您可以执行以下操作：

# find the file where <DATA> handle is read from
my $DATA_FILE = readlink("/proc/$$/fd/" . fileno(*DATA));

# find the line where DATA begins
open my $THIS, "<", $DATA_FILE;
my @THIS = <$THIS>;
my ($DATA_LINE) = grep { $THIS[$_] =~ /^__DATA__\b/ } 0 .. $#THIS;

答案 1 :(得分：3)

文件实际上没有行；它们只是字节序列。该操作系统甚至不提供从文件中获取行的功能，因此它没有行号的概念。

另一方面，

Perl确实跟踪每个句柄的行号。可通过$.访问它。

但是，Perl句柄DATA是从已经移动到数据开头的文件描述符创建的-这是Perl本身用来加载和解析文件的文件描述符-因此没有记录已经读了多少行。因此，DATA的第1行是__DATA__之后的第一行。

要更正行数，必须回溯到文件的开头，并逐行读取它，直到文件句柄回到与开始时相同的位置。

#!/usr/bin/perl
use strict;
use warnings qw( all );

use Fcntl qw( SEEK_SET );

# Determines the line number at the current file position without using «$.».
# Corrects the value of «$.» and returns the line number.
# Sets «$.» to «1» and returns «undef» if unable to determine the line number.
# The handle is left pointing to the same position as when this was called, or this dies.
sub fix_line_number {
   my ($fh) = @_;
   ( my $initial_pos = tell($fh) ) >= 0
      or return undef;
   seek($fh, 0, SEEK_SET)
      or return undef;

   $. = 1;
   while (<$fh>) {
      ( my $pos = tell($fh) ) >= 0
         or last;

      if ($pos >= $initial_pos) {
         if ($pos > $initial_pos) {
            seek($fh, $initial_pos, SEEK_SET) 
               or die("Can't reset handle: $!\n");
         }

         return $.;
      }
   }

   seek($fh, $initial_pos, SEEK_SET)
      or die("Can't reset handle: $!\n");

   $. = 1;
   return undef;
}

my $prefix = fix_line_number(\*DATA) ? "" : "+";

while (<DATA>) {
   printf "%s:%s: %s", __FILE__, "$prefix$.", $_;
}

__DATA__
foo
bar
baz

输出：

$ ./a.pl
./a.pl:48: foo
./a.pl:49: bar
./a.pl:50: baz

$ perl <( cat a.pl )
/dev/fd/63:+1: foo
/dev/fd/63:+2: bar
/dev/fd/63:+3: baz

答案 2 :(得分：2)

Perl跟踪创建每个符号的文件和行。通常在解析器/编译器第一次遇到符号时会创建一个符号。但是，如果在另外创建Took 18.608µs Took 2.873µs 之前遇到__DATA__，则将创建符号。我们可以利用此优势来设置与DATA中的文件句柄关联的行号。

对于DATA本身不使用Package::DATA句柄的情况，Package.pm令牌的行号可以通过{{3 }} __DATA__上：

DATA
$ cat Foo.pm
package Foo;

1;
__DATA__
good
bad

在文件本身中引用了$ perl -I. -MFoo -MB -e ' my $ln = B::svref_2object(\*Foo::DATA)->LINE; warn "__DATA__ at line $ln\n"; Foo::DATA->input_line_number($ln); while(<Foo::DATA>){ die "no good" unless /good/ } ' __DATA__ at line 4 no good at -e line 1, <DATA> line 6. 句柄的情况下，可能的麻烦是使用B::GV->LINE：

DATA
$ cat DH.pm
package DH;

unshift @INC, sub {
        my ($sub, $fname) = @_;
        for(@INC){
                if(open my $fh, '<', my $fpath = "$_/$fname"){
                        $INC{$fname} = $fpath;
                        return \'', $fh, sub {
                                our (%ln, %pos);
                                if($_){ $pos{$fname} += length; ++$ln{$fname} }
                        }
                }
        }
};

$ cat Bar.pm
package Bar;

print while <DATA>;

1;
__DATA__
good
bad

为了完整起见，如果您要做可以控制文件，则可以使用以下命令轻松完成所有操作：

$ perl -I. -MDH -MBar -e '
    my $fn = "Bar.pm";
    warn "__DATA__ at line $DH::ln{$fn} pos $DH::pos{$fn}\n";
    seek Bar::DATA, $DH::pos{$fn}, 0;
    Bar::DATA->input_line_number($DH::ln{$fn});
    while (<Bar::DATA>){ die "no good" unless /good/ }
'
good
bad
__DATA__ at line 6 pos 47
no good at -e line 6, <DATA> line 8.

如果您通过print "$.: $_" while <DATA>; BEGIN { our $ln = __LINE__ + 1; DATA->input_line_number($ln) } __DATA__ ... 引用了B::GV句柄，也可以使用第一个DATA解决方案：

eval

这些解决方案均未假设源文件是可搜索的（除非您要多次读取use B; my ($ln, $data) = eval q{B::svref_2object(\*DATA)->LINE, \*DATA}; die $@ if $@; $data->input_line_number($ln); print "$.: $_" while <$data>; __DATA__ ... （如在第二个示例中所做的那样），或尝试重新解析文件，等等。< / p>

答案 3 :(得分：0)

将文件末尾与其自身进行比较可能会满足您的要求：

#!/usr/bin/perl
open my $f, "<", $0;
my @lines;
my @dataLines;
push @lines ,$_ while <$f>;
close $f;
push @dataLines, $_ while <DATA>;

my @revLines= reverse @lines;
my @revDataLines=reverse @dataLines;
my $count=@lines;
my $offset=0;

$offset++ while ($revLines[$offset] eq $revDataLines[$offset]);
$count-=$offset;

print "__DATA__ section is at line $count\n";

__DATA__
Hello there
"Some other __DATA__
lkjasdlkjasdfklj
ljkasdf

运行给出的输出为：

__DATA__ section is at line 19

以上脚本将自己读取（使用$0作为文件名）到@lines数组中，并将DATA文件读取到@dataLines数组中。

反转数组，然后逐个元素比较直到它们不同。在$offset中跟踪行数，这是从$count变量减去的，该变量是文件中的行数。

结果是DATA节开始的行号。希望有帮助。

答案 4 :(得分：0)

感谢@mosvy的聪明才智。

以下是可在任何地方使用的整合解决方案。它使用符号引用而不是eval以避免在编译时提及“ DATA”，但在其他方面则使用与mosvy相同的思想。

重要的一点是，包含__DATA__的程序包中的代码不得按名称引用DATA符号，以便在编译器看到__DATA__令牌之前不会创建该符号。避免提及DATA的方法是使用在运行时创建的文件句柄引用。

# Get the DATA filehandle for a package (default: the caller's), 
# fixed so that "$." provides the actual line number in the 
# original source file where the last-read line of data came
# from, rather than counting from 1.
#
# In scalar context, returns the fixed filehandle.
# In list context, returns ($fh, $filename)
#
# For this to work, a package containing __DATA__ must not 
# explicitly refer to the DATA symbol by name, so that the 
# DATA symbol (glob) will not yet be created when the compiler 
# encounters the __DATA__ token.
#
# Therefore, use the filehandle ref returned by this 
# function instead of DATA!
#
sub get_DATA_fh(;$) {
  my $pkg = $_[0] // caller;

  # Using a symbolic reference to avoid mentioning "DATA" at
  # compile time, in case we are reading our own module's __DATA__
  my $fh = do{ no strict 'refs'; *{"${pkg}::DATA"} };

  use B;
  $fh->input_line_number( B::svref_2object(\$fh)->LINE );

  wantarray ? ($fh, B::svref_2object(\$fh)->FILE) : $fh
}

用法示例：

my $fh = get_DATA_fh;  # read my own __DATA__
while (<$fh>) { print "$. : $_"; }

或

my ($fh,$fname) = get_DATA_fh("Otherpackage");
while (<$fh>) {  
    print " $fname line $. : $_";
}
相关问题
最新问题