From 50d2a3dc296b57abf159c7970ae3f9aacb1197ef Mon Sep 17 00:00:00 2001 From: Chad Granum Date: Wed, 20 Mar 2013 16:01:43 -0700 Subject: [PATCH 1/2] Add code for coderef info lookup --- lib/perl5i/2/CODE.pm | 24 +++++++++++++++++++- lib/perl5i/2/Signatures.pm | 5 ++++- t/codref.t | 45 ++++++++++++++++++++++++++++++++++++++ 3 files changed, 72 insertions(+), 2 deletions(-) create mode 100644 t/codref.t diff --git a/lib/perl5i/2/CODE.pm b/lib/perl5i/2/CODE.pm index f01b3b0..7ac567f 100644 --- a/lib/perl5i/2/CODE.pm +++ b/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; diff --git a/lib/perl5i/2/Signatures.pm b/lib/perl5i/2/Signatures.pm index 5591b37..fc421a8 100644 --- a/lib/perl5i/2/Signatures.pm +++ b/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; } diff --git a/t/codref.t b/t/codref.t new file mode 100644 index 0000000..1d2640d --- /dev/null +++ b/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; From 5f73dc320dbf320b6a6b497048dade6626d0c74b Mon Sep 17 00:00:00 2001 From: Chad Granum Date: Wed, 20 Mar 2013 16:06:14 -0700 Subject: [PATCH 2/2] Forgot this bit in my last commit --- lib/perl5i/2/Signatures.pm | 43 ++++++++++++++++++++------------------ 1 file changed, 23 insertions(+), 20 deletions(-) diff --git a/lib/perl5i/2/Signatures.pm b/lib/perl5i/2/Signatures.pm index fc421a8..e5a5c8d 100644 --- a/lib/perl5i/2/Signatures.pm +++ b/lib/perl5i/2/Signatures.pm @@ -12,8 +12,8 @@ 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; @@ -21,14 +21,14 @@ sub import { # 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,51 +53,54 @@ 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(