#!/usr/bin/perl -w
package mytie;
use Scalar::Util qw( weaken );
sub TIESCALAR {
print "TIESCALAR\n";
my $class = shift;
my $self = {'myiobj' => shift};
weaken($self->{'myiobj'});
return bless($self, $class);
}
sub FETCH {
print "FETCH\n";
my $obj = $_[0]->{'myiobj'};
print "going to untie\n";
print "tied() is ".tied($obj->{'tiedScalar'})."\n";
untie($obj->{'tiedScalar'});
print "tied() is ".tied($obj->{'tiedScalar'})."\n";
print "untied\n";
$obj->{'tiedScalar'} = $obj->GetFinalValue();
}
sub STORE {
print "STORE\n";
}
sub DESTROY {
print "DESTROY\n";
}
sub UNTIE {
print "UNTIE\n";
}
package myObj;
sub new {
bless({'tiedScalar'=> undef, 'finalValScalar' => "final value\n"});
}
sub tiescalar {
my $self = shift;
tie($self->{'tiedScalar'}, 'mytie', $self);
}
sub untiescalar {
my $self = shift;
untie($self->{'tiedScalar'});
}
sub GetFinalValue {
my $self = shift;
return $self->{'finalValScalar'};
}
sub DESTROY {
print "myObj destroyed\n";
}
package main;
{
my $o = myObj::new();
$o->tiescalar();
#comment one and uncomment the other below
print '$o->{\'tiedScalar\'} is '.$o->{'tiedScalar'};
#$o->untiescalar();
print tied($o->{'tiedScalar'})?"tiedScalar is still tied\n":"tiedScalar is now untied\n";
}
0;
####
C:\Documents and Settings\Owner\Desktop>perl n8.pl
TIESCALAR
FETCH
going to untie
Use of uninitialized value in concatenation (.) or string at n8.pl line 19.
tied() is
DESTROY
Use of uninitialized value in concatenation (.) or string at n8.pl line 21.
tied() is
untied
$o->{'tiedScalar'} is final value
tiedScalar is now untied
myObj destroyed
C:\Documents and Settings\Owner\Desktop>
####
C:\Documents and Settings\Owner\Desktop>perl n8.pl
TIESCALAR
UNTIE
DESTROY
tiedScalar is now untied
myObj destroyed
C:\Documents and Settings\Owner\Desktop>