Может ли Perl-программа знать номер строки, где начинается __DATA__?

Question

Есть ли способ получить номер строки (и, возможно, имя файла), где был закодирован токен __ DATA __ ? Или каким-то другим способом узнать фактический номер строки в исходном исходном файле, откуда взялась строка данных, прочитанная из файлового дескриптора DATA ?

Обратите внимание, что $. считается от 1 при чтении из файлового дескриптора DATA. Так что, если бы номер строки __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» (это то, что вы получите, если $. используется само по себе).

Answer 1

В системах, которые поддерживают /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;

Answer 2

Файл на самом деле не имеет строк;это просто последовательности байтов.ОС даже не предлагает возможность получения строки из файла, поэтому она не имеет понятия номеров строк.

Perl, с другой стороны, отслеживает номер строки для каждого дескриптора.Доступ к нему осуществляется через $..

Однако дескриптор Perl DATA создается из файлового дескриптора, который уже перемещен в начало данных - это файловый дескриптор, которыйСам Perl использует для загрузки и анализа файла - поэтому нет записи о том, сколько строк уже прочитано.Таким образом, строка 1 из DATA является первой строкой после __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

Answer 3

Perl отслеживает файл и строку, в которой создается каждый символ. Символ обычно создается, когда парсер / компилятор впервые сталкивается с ним. Но если __DATA__ встречается до того, как DATA будет создано иначе, это создаст символ. Мы можем воспользоваться этим, чтобы установить номер строки, связанный с дескриптором файла, в DATA.

Для случая, когда дескриптор Package::DATA равен , а не , используемый в самом Package.pm, номер строки токена __DATA__ можно получить через B::GV->LINE on ручка 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.

---

В случае, когда на дескриптор DATA ссылаются в самом файле, возможный kludge мог бы использовать @INC hook :

$ 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__
...

Ни одно из этих решений не предполагает, что исходный файл доступен для поиска (кроме случаев, когда вы хотите прочитать DATA более одного раза, как я делал во втором примере), или попытаться проанализировать ваши файлы и т. Д.

Answer 4

Спасибо @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 $. : $_";
}

Answer 5

Сравнение конца файла с самим собой в обратном порядке может сделать то, что вы хотите:

#!/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. Надеюсь, это поможет.