Closing the Perl Class

Question

I am trying to create a closure inside an object, as described in perltoot . I copied it exactly, even copied and pasted it, but I can still access the object in the usual way, $obj->('NAME') . I look to lose patience!

I do not understand something? I have been using perl for many years for personal projects and have just begun to deal with classes and OOP in general.

 package Person; sub new { my $that = shift; my $class = ref($that) || $that; my $self = { NAME => undef, AGE => undef, PEERS => [], }; my $closure = sub { my $field = shift; if (@_) { $self->{$field} = shift } return $self->{$field}; }; bless($closure, $class); return $closure; } sub name { &{ $_[0] }("NAME", @_[ 1 .. $#_ ] ) } sub age { &{ $_[0] }("AGE", @_[ 1 .. $#_ ] ) } sub peers { &{ $_[0] }("PEERS", @_[ 1 .. $#_ ] ) } 1; 

Answer 1

For the part of the software intended for educational purposes, this is illogical. Most of the ambiguity is the methods after new . Something like

 sub name { &{ $_[0] }("NAME", @_[ 1 .. $#_ ] ) } 

opaque and not needed. Modern equivalent

 sub name { my $self = shift; $self->('NAME', @_); } 

It also discusses whether $self should be a hash link, as it is, or a link to a blissful subroutine in which I believe it should be.

If I rename the hash link $data (it does not have a name at all, except for the closure code) and the $self subroutine, then maybe you will see something more recognizable? I also added a suitable boiler and some extra space.

person.pm

 use strict; use warnings; package Person; sub new { my $class = shift; $class = ref($class) || $class; my $data = { NAME => undef, AGE => undef, PEERS => [], }; my $self = sub { my $fname = shift; my $field = $data->{$fname}; $data->{$fname} = shift if @_; return $field; }; return bless $self, $class; } sub name { my $self = shift; $self->('NAME', @_); } sub age { my $self = shift; $self->('AGE', @_); } sub peers { my $self = shift; $self->('PEERS', @_); } 1; 

program.pl

 use strict; use warnings; use Person; my $person = Person->new; $person->name('Jason'); $person->age(23); $person->peers([qw/ Norbert Rhys Phineas /]); printf "%s is %d years old.\n", $person->name, $person->age; my $peers = $person->peers; print "His peers are: ", join(", ", @$peers), "\n"; 

I hope this is clearer. You can bless only a scalar link, but while this is usually a hash link, here it is a closure link that is part of the code along with the data that it had access to at the time it was closed.

Each method call of the class new creates and defines a new lexical variable $data . Usually this variable (and the anonymous hash that it refers to) will go beyond the scope at the end of the routine and will be deleted. But in this case, new returns the subroutine reference to the calling code.

It is this calling code that stores the link that is transmitted. Calling any method of the new class is pretty pointless if the return object is not saved. In this case, the closure is deleted because nothing can access it anymore, and the $data variable and anonymous hash are also deleted for the same reason.

All Perl routine references are closures, regardless of whether the relevant data is used. It contains an implicit link to $data , which will be maintained as long as anything contains a link to this closure. All this means is the string

 return $data->{$field}; 

will refer to the same $data that existed at the time new executed, so the hash is constant, and it can be populated and checked by calls to the close routine.

All other methods execute a subroutine from a closure using the specified first parameter. For example, a call

 $person->name('trolley') 

does Person::name($person, 'trolley') , which in turn removes $person from the @_ parameters @_ and calls it (because it is a subroutine reference), using the defined first parameter instead, and copying the rest an array of parameters, Like $person->('NAME', 'trolley') .

Hope this helps solve the correct interpretation of your question.

Answer 2

Being a closure in itself, does not prohibit access from external callers , it just makes the interface more obscure in order to force foreign subscribers to make several additional transitions in order to obtain an internal state.

However, the fact that the internal state is only accessible by closure means that you can do certain things in the closure function that apply access controls.

For example, you can look at the caller return value in the close callback to make sure that the person causing the close is in the allowed white list of classes.

Then, to get around this, you need to learn more in order to somehow get your code code.

For example, you can force yourself to end up in one package simply:

 sub foo { package Person; #haha, hax. $object->('NAME'); } 

And that will mean [caller]->[0] , about which the calling packet is executing code.

When it comes to it, there are not many ways that you can reliably hide the state so that it is impenetrable , and it is also somewhat disadvantageous for this.

For example, by obscuring private access, you greatly complicate written tests , and you make it difficult for other people to use their code in tests, because the usual thing people do in tests is tweak their internal state in various ways to avoid dependence on more complex and uncontrolled of things.

And there are several ways to restrict access control for private values

For example, I have known to use the Tie :: Hash :: Method to provide basic access control, for example, but not limited to:

• Warning / Decrease when hash keys other than the predefined list were created / written to / read
• Warning / death when untrusted packets access the internal state

And these methods can help smooth out code errors, and not just provide access restrictions, as they can help you reorganize things and diagnose where legacy code still uses legacy interfaces.

Perhaps this rather simple code may give some inspiration:

 use strict; use warnings; use utf8; { package Foo; use Tie::Hash::Method; use Carp qw(croak); use Class::Tiny qw(name age), { peers => sub { [] } }; sub _access_control { my $caller = [ caller(2) ]->[0]; if ( $caller ne 'Foo' ) { local @Foo::CARP_NOT; @Foo::CARP_NOT = ( 'Foo', 'Tie::Hash::Method' ); croak "Private access to hash field >$_[1]<"; } } sub BUILD { my ( $self, $args ) = @_; # return # uncomment for production! tie %{$self}, 'Tie::Hash::Method', STORE => sub { $self->_access_control( $_[1] ); return $_[0]->base_hash->{ $_[1] } = $_[2]; }, EXISTS => sub { $self->_access_control( $_[1] ); return exists $_[0]->base_hash->{ $_[1] }; }, FETCH => sub { $self->_access_control( $_[1] ); return $_[0]->base_hash->{ $_[1] }; }; } } my $foo = Foo->new(); print qq[has name\n] if defined $foo->name(); print qq[has age\n] if defined $foo->age(); print qq[has peers\n] if defined $foo->peers(); $foo->name("Bob"); $foo->age("100"); print $foo->{name}; # Dies here.