"Chas Owens" schreef:
> www.nas.nasa.gov/News/Techreports/2000/PDF/nas-00-008.pdf.
Recently I was playing with something similar, when context-variables
were discussed on perl6.language:
#!/usr/bin/perl5 -l
use strict;
use warnings;
sub context {
sub bad_scope { $_[0] .q/->context, bad scope [/. $_[1] .q/]/ }
my $not_init = __PACKAGE__ .q/->context->{init}() not called yet/;
my $bad_init = q/no re-init allowed/;
my ($scope, $value);
{ id => \$scope,
init => sub {
if ($scope) {
$scope eq caller or die bad_scope $scope, caller;
die $bad_init;
}
$scope = caller;
return;
},
set => sub {
$scope or die $not_init;
$scope eq caller or die bad_scope $scope, caller;
$value = $_[0];
return;
},
get => sub {
$scope or die $not_init;
$scope eq caller or die bad_scope $scope, caller;
return $value;
},
};
}
my ($id, $init, $set, $get) = @{ context() }{ qw/id init set get/ };
print "id:$id";
$init->();
print $get->() || q/<undef>/;
$set->('foo');
print $get->();
$set->('bar');
print $get->();
# { no strict 'refs';
# use Data::Dumper;
# print Dumper( \*{'main::'}{HASH} );
# }
print '------';
package Test;
# $set->('baz');
# print $get->();
# print '======';
my ($id1, $init1, $set1, $get1) = @{ main->context() }{ qw/id init set
get/ };
print "id1:$id1";
$init1->();
print $get1->() || q/<undef>/;
$set1->('foo');
print $get1->();
$set1->('bar');
print $get1->();
$set1->('baz');
print $get1->();
print '======';
__END__
My next step was to add locking, but I got busy elsewhere.
See also: Scalar::Readonly, Readonly and Readonly::XS, attributes.
--
Affijn, Ruud
"Gewoon is een tijger."
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
http://learn.perl.org/