Search code examples
perlperl-io

Can I get a handle to - source?


It looks like there is a symbol in main called '_<-' (without the quotes) in the same fashion as the other things that look like they could be handles: '_</usr/perl/lib/Carp.pm', for example.

Is there some way to use it?

Or would I have to use a source filter if I hope to read the input source?


In reply to mob: I don't know where Debug would be getting turned on. After I dump out the base table, a dump of %INC shows:

$VAR1 = {
      'warnings/register.pm' => 'C:/strawberry/perl/lib/warnings/register.pm',
      'XSLoader.pm' => 'C:/strawberry/perl/lib/XSLoader.pm',
      'English.pm' => 'C:/strawberry/perl/lib/English.pm',
      'Tie/Hash/NamedCapture.pm' => 'C:/strawberry/perl/lib/Tie/Hash/NamedCapture.pm',
      'unicore/lib/Perl/_PerlIDS.pl' => 'C:/strawberry/perl/lib/unicore/lib/Perl/_PerlIDS.pl',
      'unicore/Heavy.pl' => 'C:/strawberry/perl/lib/unicore/Heavy.pl',
      'warnings.pm' => 'C:/strawberry/perl/lib/warnings.pm',
      'utf8.pm' => 'C:/strawberry/perl/lib/utf8.pm',
      'Config.pm' => 'C:/strawberry/perl/lib/Config.pm',
      'overloading.pm' => 'C:/strawberry/perl/lib/overloading.pm',
      'Symbol.pm' => 'C:/strawberry/perl/lib/Symbol.pm',
      'Carp.pm' => 'C:/strawberry/perl/lib/Carp.pm',
      'bytes.pm' => 'C:/strawberry/perl/lib/bytes.pm',
      'Exporter/Heavy.pm' => 'C:/strawberry/perl/lib/Exporter/Heavy.pm',
      'utf8_heavy.pl' => 'C:/strawberry/perl/lib/utf8_heavy.pl',
      'strict.pm' => 'C:/strawberry/perl/lib/strict.pm',
      'Exporter.pm' => 'C:/strawberry/perl/lib/Exporter.pm',
      'vars.pm' => 'C:/strawberry/perl/lib/vars.pm',
      'constant.pm' => 'C:/strawberry/perl/lib/constant.pm',
      'Errno.pm' => 'C:/strawberry/perl/lib/Errno.pm',
      'overload.pm' => 'C:/strawberry/perl/lib/overload.pm',
      'Data/Dumper.pm' => 'C:/strawberry/perl/lib/Data/Dumper.pm'
    };

Solution

  • Or would I have to use a source filter if I hope to read the input source?

    If the source file has an __END__ or __DATA__ tag, then the DATA filehandle is available. ...that in and of itself is boring. What's interesting is that you can seek to position 0, and that will take you to the top of the source file:

    use Carp;
    
    print "Just another Perl hacker,\n";
    
    eval { 
        no warnings qw/unopened/;
        seek DATA, 0, 0 
          or croak "Script lacking __END__ or __DATA__ tag has no DATA filehandle.";
    };
    if( !$@ ) {
        while(<DATA>){
            print;
        }
    }
    else {
        carp $@;
    }
    
    __END__
    

    This script will execute (printing 'Just another Perl hacker,'), and then will finish up by printing its own source.

    In the code above, if the eval block does trap an exception, the fallback could be to use FindBin and $0, open the source file, and then read it. Putting it all together, here's how it looks:

    BEGIN {
        use Carp;
    
        sub read_source {
            my $source;
            local $/ = undef;
            eval {
                no warnings qw( unopened );
                my $DATA_position = tell DATA;
                croak "'tell DATA' failed: Probably no __END__ or __DATA__ segment."
                  if $DATA_position < 0;
                seek DATA, 0, 0
                  or croak
                  "'seek DATA' failed: Probably no __END__ or __DATA__ segment.";
                $source = <DATA>;
                seek DATA, $DATA_position, 0 or croak    # Must leave *DATA usable.
                  "seek to reset DATA filehandle failed after read.";
            };
            if ($@) {
                croak $@ if $@ =~ /reset/;    # Unstable state: Shouldn't be possible.
                eval {
                    require FindBin;
                    no warnings 'once';
                    open my $source_fh, $FindBin::Bin . '/' . $0 or croak $!;
                    $source = <$source_fh>;
                };
                croak "Couldn't read source file from *DATA or \$0: $@" if $@;
            }
            return $source;
        }
    };
    
    print read_source(), "\n";
    

    This snippet first tries to read from DATA, which eliminates the need to load FindBin and open a new file handle. If that fails, then it tries the FindBin approach. If both fail, it throws an exception. The final successful state slurps the entire source file into $source_code. The DATA handle will also be restored to the same state it was in before calling this snippet.

    That should robustly handle the question of how to read the source file without resorting to a source filter.