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

Ответ 1

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

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

$ 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 [email protected] if [email protected];
$data->input_line_number($ln);
print "$.: $_" while <$data>;
__DATA__
...

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

Ответ 2

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

Ответ 3

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

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

Ответ 4

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

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

Ответ 5

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