C:\Documents and Settings\Owner\Desktop\calltest>perl t.pl attempting to go inside obj $VAR1 = [ [ "main", "t.pl", 9 ], [ "main", "t.pl", 9, "calltest::tied::FETCH", 1, "", undef, undef, 1794, "UUUUUUUUUUUU\5", undef ], [] ]; FETCH: bad caller "main" returning undef on going inside obj $res is not defined attempting to XS getValue $VAR1 = [ [ "main", "t.pl", 12 ], [ "main", "t.pl", 12, "calltest::tied::FETCH", 1, "", undef, undef, 1794, "UUUUUUUUUUUU\5", undef ], [] ]; FETCH: bad caller "main" returning undef Use of uninitialized value in subroutine entry at t.pl line 12. from getValue value is 0, package is main on XS getValue $res is not defined attempting to getValueWrap $VAR1 = [ [ "calltest", "calltest.pm", 36 ], [ "calltest", "calltest.pm", 36, "calltest::tied::FETCH", 1, "", undef, undef, 132610, "UUUUUUUUUUUU\5", { "feature_say" => 1, "feature_state" => 1, "feature_switch" => 1 } ], [ "main", "t.pl", 15, "calltest::getValueWrap", 1, "", undef, undef, 1794, "UUUUUUUUUUUU\5", undef ] ]; FETCH: good caller "calltest" returning 5 from getValue value is 5, package is calltest on getValueWrap $res is defined and is 5 using getValuePurePerl attempting to getValuePurePerl $VAR1 = [ [ "calltest", "calltest.pm", 39 ], [ "calltest", "calltest.pm", 39, "calltest::tied::FETCH", 1, "", undef, undef, 132610, "UUUUUUUUUUUU\5", { "feature_say" => 1, "feature_state" => 1, "feature_switch" => 1 } ], [ "main", "t.pl", 23, "calltest::getValuePurePerl", 1, "", undef, undef, 1794, "UUUUUUUUUUUU\5", undef ] ]; FETCH: good caller "calltest" returning 5 from getValuePurePerl value is 5 on getValuePurePerl $res is defined and is 5 C:\Documents and Settings\Owner\Desktop\calltest>
$VAR1 = [ [ "DB::DbgrProperties", "C:\\Program Files\\ActiveState Komodo IDE 4\\lib\\support +\\dbgp\\perllib/DB/DbgrProperties.pm", 462 ], [ "DB::DbgrProperties", "C:\\Program Files\\ActiveState Komodo IDE 4\\lib\\support +\\dbgp\\perllib/DB/DbgrProperties.pm", 462, "calltest::tied::FETCH", 1, 0, undef, undef, 0, "\0\0\0\0\0\0\0\0\0\0\0\0", undef ], [ "DB::DbgrProperties", "C:\\Program Files\\ActiveState Komodo IDE 4\\lib\\support +\\dbgp\\perllib/DB/DbgrProperties.pm", 616, "DB::DbgrProperties::getFullPropertyInfoByValue", 1, 0, undef, undef, 256, "\0\0\0\0\0\0\0\0\0\0\0\0", undef ] ]; FETCH: bad caller "DB::DbgrProperties" returning undef
#include "EXTERN.h" #include "perl.h" #include "XSUB.h" MODULE = calltest PACKAGE = calltest void hello( ) CODE: printf("hello"); void getValue( self ) SV * self PPCODE: if (SvROK(self) && SvTYPE(SvRV(self))==SVt_PVHV) self = SvRV(self); else Perl_croak(aTHX_ "%s: %s is not a hash reference", "calltest::getValue", "self"); if(!(self = (SV *)hv_fetch((HV *)self, "value", sizeof("value")-1, +0))){ self = NULL; Perl_croak(aTHX_ "hash has no value slice????"); } else {self = (SV *)SvUV(*((SV **)self));} printf("from getValue value is %u, package is %s\n", self, CopSTAS +HPV(PL_curcop)); if(self) XSRETURN_UV((UV)self); else XSRETURN_UNDEF;
package calltest; use 5.010000; use strict; use warnings; use calltest::tied; require Exporter; our @ISA = qw(Exporter); # Items to export into callers namespace by default. Note: do not expo +rt # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. # This allows declaration use calltest ':all'; # If you do not need this, moving things directly into @EXPORT or @EXP +ORT_OK # will save memory. our %EXPORT_TAGS = ( 'all' => [ qw( ) ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = qw( ); our $VERSION = '0.01'; require XSLoader; XSLoader::load('calltest', $VERSION); # Preloaded methods go here. sub getValueWrap { return $_[0]->getValue(); } sub getValuePurePerl { my $val = $_[0]->{'value'}; print "from getValuePurePerl value is $val \n"; return $val; } sub new { my $self = {}; bless($self, $_[0]); tie($self->{'value'}, 'calltest::tied', $self); return $self; } 1; __END__
package calltest::tied; use 5.010000; use strict; use warnings; use Data::Dumper; use Scalar::Util qw( weaken ); require Exporter; our @ISA = qw(Exporter); # Items to export into callers namespace by default. Note: do not expo +rt # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. # This allows declaration use calltest ':all'; # If you do not need this, moving things directly into @EXPORT or @EXP +ORT_OK # will save memory. our %EXPORT_TAGS = ( 'all' => [ qw( ) ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = qw( ); our $VERSION = '0.01'; sub hello2 { print "h2\n"; } # Preloaded methods go here. sub TIESCALAR { my $class = shift; my $self = {'calltestObj' => shift}; weaken($self->{'calltestObj'}); return bless($self, $class); } sub FETCH { my $self = shift; print Dumper([[caller()],[caller(0)],[caller(1)]]); if((caller())[0] ne "calltest") { print "FETCH: bad caller \"".(caller())[0]."\" returning und +ef\n"; return undef } else { print "FETCH: good caller \"".(caller())[0]."\" returning 5\ +n"; } my $newvalue = 5; my $newSelf = {'calltestObj' => $self->{'calltestObj'}}; untie($newSelf->{'calltestObj'}->{'value'}); $newSelf->{'calltestObj'}->{'value'} = $newvalue; return $newvalue; } sub STORE { my $self = shift; my $newSelf = {'calltestObj' => $self->{'calltestObj'}}; untie($newSelf->{'calltestObj'}->{'value'}); $newSelf->{'calltestObj'}->{'value'} = $_[0]; return $_[0]; } sub UNTIE { my $self = shift; } 1; __END__
use 5.010000; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => 'calltest', VERSION_FROM => 'calltest.pm', # finds $VERSION PREREQ_PM => {}, # e.g., Module::Name => 1.1 ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'calltest.pm', # retrieve abstract from modul +e AUTHOR => 'A. U. Thor <a.u.thor@a.galaxy.far.far.away>' +) : ()), LIBS => [''], # e.g., '-lm' DEFINE => '', # e.g., '-DHAVE_SOMETHING' INC => '-I.', # e.g., '-I. -I/usr/include/other' # Un-comment this if you add C files to link with later: # OBJECT => '$(O_FILES)', # link all the C files too PM => {'calltest.pm' => '$(INST_LIBDIR)/calltest/calltest.pm', ' +tied.pm' => '$(INST_LIBDIR)/calltest/tied.pm'} );
In reply to XSUBs, caller(), packages, and tied scalars by patcat88
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |