#!/usr/bin/perl -w
my $perl = $^X;
my $pid;
my $tmpfile = "/tmp/attachperl-$$";

if (@ARGV == 1) {
    ($pid) = @ARGV;
} elsif (@ARGV == 2) {
    ($perl, $pid) = @ARGV;
} else {
    die "Usage: $0 [ /path/to/perl ] <pid>\n";
}

# construct the gdb script
open F, ">$tmpfile" or die "$tmpfile: $!\n";
print F <<GDB;
p ((COP*)PL_curcop)->cop_line
p ((XPVGV*)((COP*)PL_curcop)->cop_filegv->sv_any)->xgv_name
quit
GDB
close F;

my $call = "gdb -q -x $tmpfile $perl $pid 2>/dev/null";
my @data = map /^\$\d+ = (.*)$/ ? $1 : (), `$call`;
my $line = $data[0] =~ /^\d+$/ ? $data[0] : 'unknown';
my $file = $data[1] =~ /^0x\w+ "_<(.*)"$/ ? $1 : 'unknown';
print "pid $pid: line $line of file '$file'\n";

unlink $tmpfile;

##</code><code>##

  pid 9256: line 1 of file '(eval 1)'