Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Add code for coderef info lookup

  • Loading branch information...
commit 50d2a3dc296b57abf159c7970ae3f9aacb1197ef 1 parent 4519fb2
@exodist authored
Showing with 72 additions and 2 deletions.
  1. +23 −1 lib/perl5i/2/CODE.pm
  2. +4 −1 lib/perl5i/2/Signatures.pm
  3. +45 −0 t/codref.t
View
24 lib/perl5i/2/CODE.pm
@@ -4,10 +4,12 @@ use 5.010;
use strict;
use warnings;
+require B;
+
# Can't use sigantures here, Signatures needs CODE.
use Hash::FieldHash qw(fieldhashes);
-fieldhashes \my(%Signatures);
+fieldhashes \my ( %Signatures, %Endline );
sub __set_signature {
$Signatures{$_[0]} = $_[1];
@@ -17,4 +19,24 @@ sub signature {
return $Signatures{$_[0]};
}
+sub start_line {
+ return B::svref_2object( $_[0] )->START->line;
+}
+
+sub __set_end_line {
+ return $Endline{$_[0]} = $_[1];
+}
+
+sub end_line {
+ return $Endline{$_[0]};
+}
+
+sub original_name {
+ return B::svref_2object( $_[0] )->GV->NAME;
+}
+
+sub original_package {
+ return B::svref_2object( $_[0] )->GV->STASH->NAME;
+}
+
1;
View
5 lib/perl5i/2/Signatures.pm
@@ -105,7 +105,10 @@ sub set_signature {
is_method => $args{is_method},
);
- perl5i::2::CODE::__set_signature($args{code}, $sig);
+ perl5i::2::CODE::__set_signature( $args{code}, $sig );
+
+ perl5i::2::CODE::__set_end_line( $args{code}, $args{end_line} )
+ if $args{end_line};
return $sig;
}
View
45 t/codref.t
@@ -0,0 +1,45 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use perl5i::latest;
+use Test::More;
+
+# Note, do not let the line number for these subs change!
+sub foo { 1 }
+my $foo2 = sub { 1 };
+method a_method {
+ print "1";
+ print "2";
+}
+func a_func {
+ print "1";
+ print "2";
+}
+
+my $code = __PACKAGE__->can('foo');
+
+is( $code->original_name, 'foo', "Can get original name" );
+is( $code->original_package, 'main', "Can get original package" );
+is( $code->start_line, 9, "Can get start line" );
+is( $code->end_line, undef, "No end line set" );
+
+$code = $foo2;
+is( $code->original_name, '__ANON__', "Can get original name (has none)" );
+is( $code->original_package, 'main', "Can get original package" );
+is( $code->start_line, 10, "Can get start line" );
+is( $code->end_line, undef, "No end line set" );
+
+$code = __PACKAGE__->can('a_method');
+is( $code->original_name, 'a_method', "Can get original name" );
+is( $code->original_package, 'main', "Can get original package" );
+is( $code->start_line, 11, "Can get start line" );
+is( $code->end_line, 14, "Can get end line" );
+
+$code = __PACKAGE__->can('a_func');
+is( $code->original_name, 'a_func', "Can get original name" );
+is( $code->original_package, 'main', "Can get original package" );
+is( $code->start_line, 16, "Can get start line (or first statement line)" );
+is( $code->end_line, 18, "Can get end line" );
+
+done_testing;
Please sign in to comment.
Something went wrong with that request. Please try again.