#!/usr/bin/perl -w
use strict;

use Data::Dumper;

package tobj;
use Scalar::Util qw( weaken );
use Data::Dumper;
sub TIESCALAR {
    my $class = shift;
    my $parentObj = \shift;
     weaken($parentObj);    
    my $self = {'parent' => $parentObj};
     print "tie parent= ".$self->{'parent'}." deref ". ${$self->{'parent'}}."\n";
    die " not a parentObj reference"
        if ! ${$self->{'parent'}}->isa('parentObj');
    return bless($self, $class);
}

sub FETCH {
    my $self = shift;
    print "fetch of tobj\n";
    print Dumper($self);
    #print Dumper([[caller 0], [caller 1], [caller 2]]);
    print "fetch parent= ".$self->{'parent'}." deref ";
    my $res = eval q!return ${$self->{'parent'}};!;
    print "eval failed" if !$res;
    print ((defined($res)?$res:'')." $@\n");
    my $result = "tied result data";
    return $result;
}

sub STORE {
    my $self = shift;
}
sub DESTROY {
     print "tobj destory\n";
}
package parentObj;
use Data::Dumper;
sub new {
     my $class = shift;
     my $self = {'slice' => '', 'parentdata' => 'some parent data'};
     bless($self, $class);
     tie($self->{'slice'}, 'tobj', $self);
     return $self;
}

sub DESTROY {
     my $self = shift;
     print "from parentObj's destroy parent data is '".$self->{parentdata}."'\n";
     print "parentObj's destroy print slice is '".$self->{'slice'}."'\n";
}
package main;

my $parentObj = new parentObj;
     print "from main, getting parentObj's slice '".$parentObj->{'slice'}."'\n";
adxddsad();


##</code><code>##

C:\Documents and Settings\Owner\Desktop>perl tw.pl
tie parent= REF(0x18f0cd4) deref parentObj=HASH(0x3580fc)
fetch of tobj
$VAR1 = bless( {
                 'parent' => \bless( {
                                        'parentdata' => 'some parent data',
                                        'slice' => ''
                                      }, 'parentObj' )
               }, 'tobj' );
fetch parent= REF(0x18f0cd4) deref parentObj=HASH(0x3580fc)
from main, getting parentObj's slice 'tied result data'
Undefined subroutine &main::adxddsad called at tw.pl line 58.
from parentObj's destroy parent data is 'some parent data'
fetch of tobj
$VAR1 = bless( {
                 'parent' => \undef
               }, 'tobj' );
fetch parent= SCALAR(0x18f0cd4) deref eval failed
parentObj's destroy print slice is 'tied result data'
tobj destory

C:\Documents and Settings\Owner\Desktop>

##</code><code>##

 	perl512.dll!Perl_sv_kill_backrefs(interpreter * my_perl=0x003542a4, sv * const sv=0x01903c54, av * const av=0x0182b694)  Line 5433	C
 	perl512.dll!Perl_magic_killbackrefs(interpreter * my_perl=0x003542a4, sv * sv=0x01903c54, magic * mg=0x01822664)  Line 2211 + 0x14	C
 	perl512.dll!Perl_mg_free(interpreter * my_perl=0x003542a4, sv * sv=0x01903c54)  Line 540 + 0x12	C
 	perl512.dll!Perl_sv_clear(interpreter * my_perl=0x003542a4, sv * const sv=0x01903c54)  Line 5757 + 0xd	C
 	perl512.dll!Perl_sv_free2(interpreter * my_perl=0x003542a4, sv * const sv=0x01903c54)  Line 5985 + 0xd	C
 	perl512.dll!Perl_sv_free(interpreter * my_perl=0x003542a4, sv * const sv=0x01903c54)  Line 5962 + 0xd	C
 	perl512.dll!Perl_sv_clear(interpreter * my_perl=0x003542a4, sv * const sv=0x0182b6c4)  Line 5686 + 0xd	C
 	perl512.dll!Perl_sv_free2(interpreter * my_perl=0x003542a4, sv * const sv=0x0182b6c4)  Line 5985 + 0xd	C
 	perl512.dll!Perl_sv_free(interpreter * my_perl=0x003542a4, sv * const sv=0x0182b6c4)  Line 5962 + 0xd	C
 	perl512.dll!Perl_hv_free_ent(interpreter * my_perl=0x003542a4, hv * hv=0x0182b6a4, he * entry=0x0035f534)  Line 1476 + 0xd	C
 	perl512.dll!S_hfreeentries(interpreter * my_perl=0x003542a4, hv * hv=0x0182b6a4)  Line 1796 + 0x11	C
 	perl512.dll!Perl_hv_undef(interpreter * my_perl=0x003542a4, hv * hv=0x0182b6a4)  Line 1863 + 0xd	C
 	perl512.dll!Perl_sv_clear(interpreter * my_perl=0x003542a4, sv * const sv=0x0182b6a4)  Line 5791 + 0xd	C
 	perl512.dll!Perl_sv_free2(interpreter * my_perl=0x003542a4, sv * const sv=0x0182b6a4)  Line 5985 + 0xd	C
 	perl512.dll!Perl_sv_free(interpreter * my_perl=0x003542a4, sv * const sv=0x0182b6a4)  Line 5962 + 0xd	C
 	perl512.dll!Perl_sv_clear(interpreter * my_perl=0x003542a4, sv * const sv=0x01903ee4)  Line 5686 + 0xd	C
 	perl512.dll!Perl_sv_free2(interpreter * my_perl=0x003542a4, sv * const sv=0x01903ee4)  Line 5985 + 0xd	C
 	perl512.dll!Perl_sv_free(interpreter * my_perl=0x003542a4, sv * const sv=0x01903ee4)  Line 5962 + 0xd	C
>	perl512.dll!Perl_mg_free(interpreter * my_perl=0x003542a4, sv * sv=0x00357f6c)  Line 548 + 0x10	C
 	perl512.dll!Perl_sv_clear(interpreter * my_perl=0x003542a4, sv * const sv=0x00357f6c)  Line 5757 + 0xd	C
 	perl512.dll!Perl_sv_free2(interpreter * my_perl=0x003542a4, sv * const sv=0x00357f6c)  Line 5985 + 0xd	C
 	perl512.dll!Perl_sv_free(interpreter * my_perl=0x003542a4, sv * const sv=0x00357f6c)  Line 5962 + 0xd	C
 	perl512.dll!Perl_hv_free_ent(interpreter * my_perl=0x003542a4, hv * hv=0x00357f4c, he * entry=0x0035f4ec)  Line 1476 + 0xd	C
 	perl512.dll!S_hfreeentries(interpreter * my_perl=0x003542a4, hv * hv=0x00357f4c)  Line 1796 + 0x11	C
 	perl512.dll!Perl_hv_undef(interpreter * my_perl=0x003542a4, hv * hv=0x00357f4c)  Line 1863 + 0xd	C
 	perl512.dll!Perl_sv_clear(interpreter * my_perl=0x003542a4, sv * const sv=0x00357f4c)  Line 5791 + 0xd	C
 	perl512.dll!Perl_sv_free2(interpreter * my_perl=0x003542a4, sv * const sv=0x00357f4c)  Line 5985 + 0xd	C
 	perl512.dll!Perl_sv_free(interpreter * my_perl=0x003542a4, sv * const sv=0x00357f4c)  Line 5962 + 0xd	C
 	perl512.dll!do_clean_objs(interpreter * my_perl=0x003542a4, sv * const ref=0x01903c54)  Line 498 + 0xd	C
 	perl512.dll!S_visit(interpreter * my_perl=0x003542a4, void (interpreter *, sv *)* f=0x28149ed0, const unsigned long flags=2048, const unsigned long mask=2048)  Line 440 + 0xb	C
 	perl512.dll!Perl_sv_clean_objs(interpreter * my_perl=0x003542a4)  Line 548 + 0x18	C
 	perl512.dll!perl_destruct(interpreter * my_perl=0x003542a4)  Line 770 + 0x9	C
 	perl512.dll!RunPerl(int argc=2, char * * argv=0x00242478, char * * env=0x00242a20)  Line 274 + 0x9	C++
 	perl.exe!main(int argc=2, char * * argv=0x00242478, char * * env=0x00242dd0)  Line 23 + 0x12	C
 	perl.exe!mainCRTStartup()  Line 398 + 0xe	C
 	kernel32.dll!_BaseProcessStart@4()  + 0x23