#80 method methods

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;

lib/perl5i/2/Signatures.pm

@@ -12,23 +12,23 @@ use Sub::Name;
 sub import {
     my $class = shift;
 
-    my %opts  = @_;
-    $opts{into}     ||= caller;
+    my %opts = @_;
+    $opts{into} ||= caller;
     $opts{invocant} ||= '$self';
 
     my %def_opts = %opts;
     delete $def_opts{invocant};
 
     # Define "method"
     $class->install_methodhandler(
-      name => 'method',
-      %opts
+        name => 'method',
+        %opts
     );
 
     # Define "func"
     $class->install_methodhandler(
-      name => 'func',
-      %def_opts
+        name => 'func',
+        %def_opts
     );
 }
 
@@ -44,7 +44,7 @@ sub parse_proto {
     my $invocant = $self->{invocant};
 
     my $inject = '';
-    if( $invocant ) {
+    if ($invocant) {
         $invocant = $1 if $proto =~ s{^(\$\w+):\s*}{};
         $inject .= "my ${invocant} = shift;";
     }
@@ -53,59 +53,65 @@ sub parse_proto {
     return $inject;
 }
 
-
 sub code_for {
-    my ($self, $name) = @_;
+    my ( $self, $name ) = @_;
 
     my $signature = $self->{perl5i}{signature};
     my $is_method = $self->{invocant} ? 1 : 0;
 
-    if (defined $name) {
+    if ( defined $name ) {
         my $pkg = $self->get_curstash_name;
         $name = join( '::', $pkg, $name )
-          unless( $name =~ /::/ );
+            unless ( $name =~ /::/ );
         return sub (&) {
             my $code = shift;
+            ( undef, undef, my $end_line ) = caller();
             # So caller() gets the subroutine name
             no strict 'refs';
             *{$name} = subname $name => $code;
 
             $self->set_signature(
-                code            => $code,
-                signature       => $signature,
-                is_method       => $is_method,
+                code      => $code,
+                signature => $signature,
+                is_method => $is_method,
+                end_line  => $end_line,
             );
 
             return;
         };
-    } else {
+    }
+    else {
         return sub (&) {
             my $code = shift;
+            ( undef, undef, my $end_line ) = caller();
 
             $self->set_signature(
-                code            => $code,
-                signature       => $signature,
-                is_method       => $is_method,
+                code      => $code,
+                signature => $signature,
+                is_method => $is_method,
+                end_line  => $end_line,
             );
             return $code;
         };
     }
 }
 
-
 sub set_signature {
     my $self = shift;
     my %args = @_;
 
-    my $sig = perl5i::2::CODE::signature($args{code});
+    my $sig = perl5i::2::CODE::signature( $args{code} );
     return $sig if $sig;
 
     $sig = perl5i::2::Signature->new(
         signature => $args{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;
 }

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;