Can a Perl program know the line number where __DATA__ begins?

Question

Is there a way to get the line number (and maybe filename) where a __DATA__ token was coded? Or some other way to know the actual line number in the original source file where a line of data read from the DATA filehandle came from?

Note that $. counts from 1 when reading from the DATA filehandle. So if the line number of the __DATA__ token were added to $. it would be what I'm looking for.

For example:

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

__DATA__
something good
something bad

I want this to say "Invalid data at line 9", not "line 2" (which is what you get if $. is used by itself).

Answer 1

In systems that support /proc/<pid> virtual filesystems (e.g., Linux), you can do:

# 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

File don't actually have lines; they're just sequences of bytes. The OS doesn't even offer the capability of getting a line from a file, so it has no concept of line numbers.

Perl, on the other hand, does keep track of a line number for each handle. It is accessed via $..

However, the Perl handle DATA is created from a file descriptor that's already been moved to the start of the data —it's the file descriptor that Perl itself uses to load and parse the file— so there's no record of how many lines have already been read. So the line 1 of DATA is the first line after __DATA__.

To correct the line count, one must seek back to the start of the file, and read it line by line until the file handle is back at the same position it started.

#!/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

Output:

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