"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/


Reply via email to