$. - smarter than you might think

[GrandFather]

A discussion in the CB about the use of $. (input line number) led me to an improved understanding of this infrequently used special variable. Consider the following code (yes, yes, I know it's an awful inefficient way to do it):

use warnings;
use strict;

open testFile, '>', 'delme.txt';
print testFile <<TEST;
Test file line 1
Test file line 2
Test file line 3
TEST
close testFile;

open testFile, '<', 'delme.txt';
while (<DATA>) {
    my $current = $_;
    chomp $current;
    print "$.\n";
    
    while (<testFile>) {
        print "$_" if $. == $current;
    }

    seek (testFile, 0, 0);
    $. = 0;
}

close testFile;

__DATA__
3
1
2

which prints:

1
Test file line 3
2
Test file line 1
3
Test file line 2

Note that the contents of $. is set to the line number for the most recently accessed file handle and that a seek counts as an access. Not only that, but the variable can be set for the current file handle by assigning to $.. Consider:

use warnings;
use strict;

open testFile, '>', 'delme.txt';
print testFile <<TEST;
Test file line 1
Test file line 2
Test file line 3
TEST
close testFile;

open testFile, '<', 'delme.txt';
<DATA>;
print "DATA: $.\n";
<testFile>;
print "Test: $.\n";
<testFile>;
<testFile>;
print "Test: $.\n";
<DATA>;
print "DATA: $.\n";
seek testFile, 0, 0;
$. = 0;
print "Test: $.\n";
<DATA>;
print "DATA: $.\n";

close testFile;

__DATA__
3
1
2
5

which prints:

DATA: 1
Test: 1
Test: 3
DATA: 2
Test: 0
DATA: 3

Note that these tests were run using ActiveState Perl version 5.8.7 build 813. YMMV.

[ikegami]

If one has to spend significant time trying to undertstand the test snippet, how can one really know what is really being tested. What follows are tests which are much more straightforward:

{
   open(local *FILE, '>', 'delete_me.txt') or die;
   print FILE "Test file line $_\n"
      for 1..4;
}

{
   print("Two Handles\n\n");

   open(local *FILE1, '<', 'delete_me.txt') or die;
   open(local *FILE2, '<', 'delete_me.txt') or die;
   print scalar <FILE1>;
   print scalar <FILE1>;
   print scalar <FILE1>;
   print("$.\n");                       # 3 (Line num for FILE1)
   print scalar <FILE2>;
   print("$.\n");                       # 1 (Line num for FILE2)
   print scalar <FILE2>;
   print("$.\n");                       # 2 (Line num for FILE2)
   print scalar <FILE1>;
   print("$.\n");                       # 4 (Line num for FILE1)
}

print("--\n");

{
   print("Does 'seek' Count As an Access?\n\n");

   open(local *FILE1, '<', 'delete_me.txt') or die;
   open(local *FILE2, '<', 'delete_me.txt') or die;
   print scalar <FILE1>;
   print scalar <FILE1>;
   print scalar <FILE1>;
   print("$.\n");                       # 3 (Line num for FILE1)
   seek(FILE2, 0, 0) or die;            # seek counts as an access.
   print("$.\n");                       # 0 (Line num for FILE2)
   print scalar <FILE1>;
   print("$.\n");                       # 4 (Line num for FILE1)
}

print("--\n");

{
   print("Does 'eof' Count As an Access?\n\n");

   open(local *FILE1, '<', 'delete_me.txt') or die;
   open(local *FILE2, '<', 'delete_me.txt') or die;
   print scalar <FILE1>;
   print scalar <FILE1>;
   print scalar <FILE1>;
   print("$.\n");                       # 3 (Line num for FILE1)
   eof(FILE2);                          # eof counts as an access.
   print("$.\n");                       # 0 (Line num for FILE1)
   print scalar <FILE1>;
   print("$.\n");                       # 4 (Line num for FILE1)
}

print("--\n");

{
   print("Does 'read' Count As an Access?\n\n");

   open(local *FILE1, '<', 'delete_me.txt') or die;
   open(local *FILE2, '<', 'delete_me.txt') or die;
   print scalar <FILE1>;
   print scalar <FILE1>;
   print scalar <FILE1>;
   print("$.\n");                       # 3 (Line num for FILE1)
   read(FILE2, my $buf='', 1) or die;   # read doesn't count
   print("$.\n");                       # 3 (Line num for FILE1)
   print scalar <FILE1>;
   print("$.\n");                       # 4 (Line num for FILE1)
}

print("--\n");

{
   print("Assigning to \$.\n\n");

   open(local *FILE, '<', 'delete_me.txt') or die;
   print scalar <FILE>;
   print scalar <FILE>;
   print scalar <FILE>;
   print("$.\n");                       # 3
   $. = 7;                              # Works like "#line"
   print("$.\n");                       # 7
   print scalar <FILE>;                 # Prints the 4th line.
   print("$.\n");                       # 8
}

unlink 'delete_me.txt';

[shmem]

You can even assign to it and cheat about the line number:

#!/usr/bin/perl
<DATA>;
$.= 39;
print "$. $_" while <DATA>;
__DATA__

line 1
line 2
line 3

BTW, the DATA filehandle is funny as well. This prints it's source along with line numbers (perl 5.8.8):

#!/usr/bin/perl

seek DATA,0,0;
print "$. $_" while <DATA>;
__DATA__

line 1
line 2
line 3

gives

1 #!/usr/bin/perl
2 
3 seek DATA,0,0;
4 print "$. $_" while <DATA>;
5 __DATA__
6 
7 line 1
8 line 2
9 line 3

Bug or feature? :-)

cheers,
--shmem

Update: this is covered implicitly in perl561delta, Potential to leak DATA filehandles:

       Using the "__DATA__" token creates an implicit filehandle to th
+e file
       that contains the token.  It is the program's responsibility to
+ close it
       when it is done reading from it.

[GrandFather]

Ohh, that's nice, if you expect it. :)

So you can have a Perl script print itself by:

use warnings;
use strict;

seek DATA, 0, 0;
print while <DATA>;
__END__

so long as __END__ or __DATA__ are present.

Of course that also means that you have to my $dataStart = tell DATA; if you want to seek DATA back to the data start rather than script start.

[shmem]

heh.. that makes me think about a $SIG{__DIE__} handler which not only says harshly "Can't do method foo in context bar in file quux line 1024" or such, but prints the 3 lines above and below the error as well...

don't talk nonsense at blah.pl line 23.
  21 learn('nothing');
  22 sub blah (\[&]) {
  23     warn "don't talk nonsense";
> 24     $_[0]->();
  25 } 
  26 sub learn {
  27     my $self->teach(shift);
Can't use string ("bar") as a subroutine ref while "strict refs" in us
+e at blah.pl line 24.

I discovered this playing with your code, btw. Thanks!

cheers,
--shmem

<Reveal this spoiler or all in this thread>

[sh1tn]

or maybe LINE:

#!/usr/bin/perl

use strict;
use warnings;


print 'at this line - ', __LINE__, ' - D time stopped', $/;

[codeacrobat]

I love $., specially because it works so well with the scalar form of the .. operator. For example, to extract the subroutines of a script and label the lines with linenumbers one could use this:

$ cat test2.pl
#!/usr/bin/perl

my $god;

sub test {
     my ($param) = @_;
     print $param;
     return
}
__END__

$ cat test.pl | perl -ne 'print "$. $_" if /^sub/ .. /[}]/'
5 sub test {
6      my ($param) = @_;
7      print $param;
8      return
9 }

[GrandFather]

so long as there are no blocks, quoted strings or regexen containing } in the sub. A pretty unusual sib. :)

But, especially after I found out about how 'smart' $. is, I agree about it's potential usefulness.