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>

##</code><code>##

$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

##</code><code>##

#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, CopSTASHPV(PL_curcop));
    if(self) XSRETURN_UV((UV)self);
    else XSRETURN_UNDEF;


##</code><code>##

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 export
# 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 @EXPORT_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__

##</code><code>##

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 export
# 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 @EXPORT_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 undef\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__


##</code><code>##

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 module
       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'}
);