http://www.perlmonks.org?node_id=348189

OO Perl is almost always based on a hash for class data. Someone new to Perl object programming might not be exposed to any other way of doing it. However, it's possible to bless a lot more references than just hashes. This meditation demonstrates the use of a closure to provide an accessor/mutator to the internal class data. This technique provides enforced encapsulation to class data from any external source.

Below are the requirements for the object and some test code to go with each one. The tests assume 'ClosureObj' is the class implementing this, which defines internal data named 'foo', 'bar', and 'baz' and has two methods 'foo' and 'foop', which are both simple accessors/mutators. Note that 'foop' does not exist as valid class data (it's there to test the case where you've made a typo in accessing the data). 'SubClosureObj' is a subclass of 'ClosureObj' and defines the method 'bar', which is also a simple accessor/mutator.

  1. Constructor returns a 'ClosureObj' (start out with the basics)
    my $obj = ClosureObj->new(); isa_ok( $obj => 'ClosureObj' );
  2. Accessing the internal data directly from an external source is a fatal error.
    eval { $obj->('foo') }; ok( $@ =~ /^Attempt to access private class data/, "Stop from accessing class data" );
  3. Accessing non-existant class data is a fatal error.
    eval { $obj->foop() }; ok( $@ =~ /^No such field/, "Stop from accessing non-existant data" );
  4. Method 'foo' can get/set the internal value of 'foo'.
    $obj->foo(3); ok( $obj->foo == 3, "Foo is set" );
  5. Setting an attribute to 'undef' is OK (this can be broken in subtle ways, such as $field{foo} = $foo if defined $foo).
    { no warnings; # About unintitlized vars $obj->foo(undef); ok( $obj->foo == undef, "Foo can be set to undef" ); }
  6. Setting data in one object won't change another (i.e., we're not implementing a singleton--an early version of my implementation triped over this one).
    my $obj2 = ClosureObj->new(); isa_ok( $obj2 => 'ClosureObj' ); $obj->foo(2); $obj2->foo(3); ok( ($obj->foo == 2) && ($obj2->foo == 3), "Change in one object doesn't affect other" );
  7. Subclasses can get/set values.
    my $sub_obj = SubClosureObj->new(); isa_ok( $sub_obj => 'SubClosureObj' ); $sub_obj->bar(4); ok( $sub_obj->bar == 4, "Sub object can set values" );

Implementation

Most of the magic of this technique is in the constructor. Notice that the internal closure isn't called as a normal class method, so it doesn't have a way of figuring out what class it is part of. To provide this, we put the name of the class as another piece of class data. We also make sure that this data cannot be changed. (We could use __PACKAGE__, but that breaks subclasses).

sub new { my $class = shift; my %field = ( foo => 1, bar => 1, baz => 1, class => $class, ); bless sub { my $name = shift; my ($package, $filename, $line) = caller; die "Attempt to access private class data " . "for $field{class} at $filename line $line\n" unless UNIVERSAL::isa( $package => __PACKAGE__ ); die "No such field '$name' at $filename line $line\n" unless exists $field{$name}; die "You can't change the class name " . "at $filename line $line\n" if $name eq 'class'; $field{$name} = shift if @_; $field{$name}; } => $class; }

How the closure accesses the internal data is encapsulated even to the rest of the class. Depending on how much effort you're willing to put into the implementation, you should be able to switch from a hash to an array without changes to the rest of the class or subclasses.

If you want to make a singleton, you can move %fields to a code block outside the constructor:

{ my %fields = ( . . . ); sub new { my $class = shift; $fields{class} = $class; bless sub { # Same as before } => $class; } }

With the above, the same lexical is referenced to each time a new object is created. OTOH, the regular constructor will create a new lexical each time the constructor is called.

The foo and foop methods are nearly the same as you would see in a traditional hash-based object. Remember, foop is here for the purpose of testing the case where a field is accessed that doesn't exist.

sub foo { my $self = shift; $self->('foo', shift) if @_; $self->('foo'); } sub foop { my $self = shift; $self->('foop', shift) if @_; $self->('foop'); }

Note that I don't advocate spreading accessors/mutators all over your classes. That's usually an indication of sloppy design. However, this being an overview of the technique, it is useful in this case.

We also need a subclass with a bar method. This is also straightforward:

package SubClosureObj; use base qw( ClosureObj ); sub bar { my $self = shift; $self->('bar', shift) if @_; $self->('bar'); }

Putting everything together, including the tests, in a non-singleton implementation:


#!/usr/bin/perl package ClosureObj; use strict; use warnings; sub new { my $class = shift; my %field = ( foo => 1, bar => 1, baz => 1, class => $class, ); bless sub { my $name = shift; my ($package, $filename, $line) = caller; die "Attempt to access private class data " . "for $field{class} at $filename line $line\n" unless UNIVERSAL::isa( $package => __PACKAGE__ ); die "No such field '$name' at $filename line $line\n" unless exists $field{$name}; die "You can't change the class name " . "at $filename line $line\n" if $name eq 'class'; $field{$name} = shift if @_; $field{$name}; } => $class; } sub foo { my $self = shift; $self->('foo', shift) if @_; $self->('foo'); } sub foop { my $self = shift; $self->('foop', shift) if @_; $self->('foop'); } package SubClosureObj; use base qw( ClosureObj ); sub bar { my $self = shift; $self->('bar', shift) if @_; $self->('bar'); } package main; use Test::More tests => 9; my $obj = ClosureObj->new(); isa_ok( $obj => 'ClosureObj' ); eval { $obj->('foo') }; ok( $@ =~ /^Attempt to access private class data/, "Stop from accessing class data" ); eval { $obj->foop() }; ok( $@ =~ /^No such field/, "Stop from accessing non-existant data" ); $obj->foo(3); ok( $obj->foo == 3, "Foo is set" ); { no warnings; # About unintitlized vars $obj->foo(undef); ok( $obj->foo == undef, "Foo can be set to undef" ); } my $obj2 = ClosureObj->new(); isa_ok( $obj2 => 'ClosureObj' ); $obj->foo(2); $obj2->foo(3); ok( ($obj->foo == 2) && ($obj2->foo == 3), "Change in one object doesn't affect other" ); my $sub_obj = SubClosureObj->new(); isa_ok( $sub_obj => 'SubClosureObj' ); $sub_obj->bar(4); ok( $sub_obj->bar == 4, "Sub object can set values" );

Implications

You could argue that this enforced encapsulation goes against the orginal idea that you should stay out of the living room because you weren't invited, not because there is a guy with a shotgun. That may be the case, but I think this philosophy needs to be rethought. Apoc. 12 noted that Perl6 will definately have ways of keeping the uninvited out with a shotgun.

Keeping the internal representation away from even the class itself could be quite powerful. Classes that once conflicted because they were implemented using different datatypes could work together, assuming you're willing to do enough work in the closure to put them together (the technique may not necessarily be fast, but it should at least work). This failure to work together is one of the major problems with Perl OO, and the technique above could potentially fix it.

I suspect there are a lot of yet undiscovered uses for this technique that will only be revealed with time and community acceptance. If nothing else, it will shutup the Java people claiming that Perl OO has poor encapsulation.

Update: Small spelling fix.

Replies are listed 'Best First'.
Re: May Thy Closures Be Blessed
by dragonchild (Archbishop) on Apr 26, 2004 at 15:09 UTC
    An interesting discussion would be the differences between this and Inside-out classes. Both are based on lexical scoping to enforce encapsulation. What are the benefits/drawbacks of either method?

    ------
    We are the carpenters and bricklayers of the Information Age.

    Then there are Damian modules.... *sigh* ... that's not about being less-lazy -- that's about being on some really good drugs -- you know, there is no spoon. - flyingmoose

      An interesting discussion would be the differences between this and Inside-out classes. Both are based on lexical scoping to enforce encapsulation. What are the benefits/drawbacks of either method?

      Off the top of my head:

      • You don't have to mess around with DESTROY with the closure based method, which makes maintenance easier.
      • Inside out objects are more space efficient than closures.
      • Accessing object state is a subroutine call with closure objects, and a hash access with inside-out objects. The latter will be a fair bit faster.
      • You can subclass an existing non-inside-out object and add inside-out based state to the objects in the subclass. You can't do this with without delegation with closures.
      • You need a bit more mechanism than the proposal hardburn showed above to get separate namespaces for state in different subclasses. This comes for free with inside-out.
      • You don't get compile-time checking of your instance variable naming with closures.
      • added 16:58 GMT+1:Inside out instance variables are scoped to the class they are declared in. With the mechanism outlined in the OP instance variables can also be accessed in subclasses.

        Inside Out objects are faster than the closure based - but compared to "traditional" objects, the difference is small:
        #!/usr/bin/perl use strict; use warnings; use Benchmark qw /cmpthese/; use Carp; package Class_Closure; sub new { my $class = shift; my %args = @_; my %field = ( name => $args {name} || "abigail", colour => $args {colour} || "pink", age => $args {age} || 100, class => $class, ); bless sub { my $name = shift; my ($package, $filename, $line) = caller; die "Attempt to access private class data " . "for $field{class} at $filename line $line\n" unless UNIVERSAL::isa ($package => __PACKAGE__); die "No such field '$name' at $filename line $line\n" unless exists $field{$name}; die "You can't change the class name at $filename line $line\n +" if $name eq 'class'; $field {$name} = shift if @_; $field {$name} } => $class; } sub name {my $self = shift; $self -> (name => @_)} sub colour {my $self = shift; $self -> (colour => @_)} sub age {my $self = shift; $self -> (age => @_)} sub format { my $self = shift; join " " => $self -> ('name'), $self -> ('colour'), $self -> ('age +'); } package Class_Inside_Out; my %name; my %colour; my %age; sub new { my $key = bless \(my $dummy) => shift; my %args = @_; $name {$key} = $args {name} || "abigail"; $colour {$key} = $args {colour} || "pink"; $age {$key} = $args {age} || 100; $key; } sub name { my $key = shift; $name {$key} = shift if @_; $name {$key}; } sub colour { my $key = shift; $colour {$key} = shift if @_; $colour {$key}; } sub age { my $key = shift; $age {$key} = shift if @_; $age {$key}; } sub format { my $key = shift; join " " => $name {$key}, $colour {$key}, $age {$key}; } package Class_Traditional; sub new { my $class = shift; my %args = @_; bless {name => $args {name} || "abigail", colour => $args {colour} || "pink", age => $args {age} || 100} => $class; } sub name { my $self = shift; $self -> {name} = shift if @_; $self -> {name} } sub colour { my $self = shift; $self -> {colour} = shift if @_; $self -> {colour} } sub age { my $self = shift; $self -> {age} = shift if @_; $self -> {age} } sub format { my $self = shift; join " " => @$self {qw /name colour age/}; } package main; our $obj_c = Class_Closure -> new; our $obj_i = Class_Inside_Out -> new; our $obj_t = Class_Traditional -> new; our @names = ("Larry Wall", "Damian Conway", "Nicholas Clark", "Gurusamy Sarathy", "Chip Salzenberg", "Rafael Garcia-Suarez"); our @colours = qw /red green blue white yellow orange brown purple vio +let/; # # Test. # my $name = $names [rand @names]; my $colour = $colours [rand @colours]; my $age = 1 + int rand 100; foreach my $i ([obj_c => $obj_c], [obj_i => $obj_i], [obj_t => $obj_t] +) { $i -> [1] -> name ($name); $i -> [1] -> colour ($colour); $i -> [1] -> age ($age); die $i -> [0] unless "$name $colour $age" eq $i -> [1] -> format; } our $dummy; cmpthese -1 => { closure => 'foreach my $n (@names) { foreach my $c (@colours) { my $age = 1 + int rand 100; $obj_c -> name ($n); $obj_c -> colour ($c); $obj_c -> age ($age); $dummy = $obj_c -> format; } }', inside_out => 'foreach my $n (@names) { foreach my $c (@colours) { my $age = 1 + int rand 100; $obj_i -> name ($n); $obj_i -> colour ($c); $obj_i -> age ($age); $dummy = $obj_i -> format; } }', traditional => 'foreach my $n (@names) { foreach my $c (@colours) { my $age = 1 + int rand 100; $obj_t -> name ($n); $obj_t -> colour ($c); $obj_t -> age ($age); $dummy = $obj_t -> format; } }', }; __END__ Rate closure inside_out traditional closure 355/s -- -25% -75% inside_out 473/s 33% -- -67% traditional 1436/s 304% 203% --

        Abigail

      Both are based on lexical scoping to enforce encapsulation.
      But an entire different kind of encapsulation! The closure based method as outline does data inheritance. By default, and you'll need to do work to prevent it. Inside Out objects don't do data inheritance (except if you define your subclass in the same lexical scope as your superclass - but you probably have good reasons to do so).

      Furthermore, Inside Out objects don't require their superclass, or subclasses, to cooperate. With the Inside Out technique, you can subclass anything, including a closure, without interfering. Even if the superclass changes its implementation, you're safe. The closure based strategy only works if the entire inheritance tree uses the same closure.

      Inside Objects are about maximizing freedom - it does not impose, and it does not require. ;-)

      Abigail

        I wasn't at all surprised at the many comparisons to Inside-Out Objects that popped up in this thread. They both see basically the same thing wrong with Perl's object system as it is normally used and try to fix it in different ways. I must admit that the closure method didn't do some things as well as I thought it would when the idea first popped into my head a few days ago.

        With Inside-Out Objects, everything starts to look like a hash. With Closure Objects, everything starts to look like a subroutine. A subroutine call is ultimately more flexible than a hash lookup (unless you want to open the can-of-worms that is a tied interface). However, you have to put more work into it.

        IMHO, Inside-Out Objects rely on subtle behavior on Perl's part that make some people feel uneasy. Further, the technique isn't necessarily easy to grasp, even to those that have already mastered Perl's regular object system. Closures aren't necessarily easy, but I suspect they will be easier to think about than the Inside-Out technique. They may also appeal more to those with a functional programming background.

        Yes, Closure Objects do impose that the heirarchracy all use the closure technique. I think it's a net gain for freedom, even over Inside-Out Objects. It will ultimately depend on what you're trying to accomplish, though I suspect either technique will solve your problem if you put enough effort into it. Further, which technique is easier for your project may not be clear from the start.

        ----
        : () { :|:& };:

        Note: All code is untested, unless otherwise stated

        Furthermore, Inside Out objects don't require their superclass, or subclasses, to cooperate.

        They do need to co-operate over DESTROY.

Re: May Thy Closures Be Blessed
by diotalevi (Canon) on Apr 26, 2004 at 15:20 UTC

    Why did you make 'class' a member variable in $fields{'class'}? You already had access to it in $class and I think that since it is not member data that it shouldn't be treated that way.

    Please also note that I wrote Stealing lexicals - best practice suggestions with the idea of violating the sort of encapsulation you just proposed here. Nothing is absolute. The code I've seen that really, truely encapsulates is Protect your subs... from *EVIL*.. This assumes the idea of "encapsulation" means "Prevent a determined programmer who is willing to write unmaintainable code from gaining access to private variables" and not "Prevent a normal programmer from gaining access accidentally or otherwise."

      Why did you make 'class' a member variable in $fields{'class'}?

      I belive my orginal reasoning had to do with an earlier version of the code that couldn't get access to $class. So my only excuse is hysterical reasons that I should have removed in the final post.

      . . . violating the sort of encapsulation you just proposed here. Nothing is absolute.

      I know it's possible to dig into someone else's lexical scope, but it's far more difficult than doing $obj->{foo}. Ultimately, I can't do anything to stop someone from tralling through /dev/mem or the equivilent on another system.

      ----
      : () { :|:& };:

      Note: All code is untested, unless otherwise stated

        I know it's possible to dig into someone else's lexical scope, but it's far more difficult than doing $obj->{foo}. Ultimately, I can't do anything to stop someone from tralling through /dev/mem or the equivilent on another system.
        It may be useful to point this out to Java users sometimes. Java's privacy rules have been successfully violated in the past using that loophole - everything is public at some point.

        I know it's possible to dig into someone else's lexical scope, but it's far more difficult than doing $obj->{foo}. Ultimately, I can't do anything to stop someone from tralling through /dev/mem or the equivilent on another system.

        You don't have to go as far as that in this particular instance. All you need do is fake being in the appropriate package, which isn't hard ;-)

        As you point out, this isn't really the issue - the issue is accidental interference rather than deliberate trespass.

Re: May Thy Closures Be Blessed
by flyingmoose (Priest) on Apr 26, 2004 at 16:32 UTC
    I've always been big on the "shotgun quote" not because of the idea that enforcement in not neccessary, but that writing accessors and mutators ad nauseum is silly

    ... i.e, by convention a blessed hash with internal data should only be accessed externally by class methods, and if the functions don't exist, it's at-your-own-risk. Internal hash-access, thereby being unacceptable/against-convention/etc ...

    Bottom line -- everything is private if you agree to stay out of the living room, and that's a great design point. Once you start saying "I have a shotgun, but you can come in if", you start walking down the road of non-OO-OO, aka java-esque accessor/mutator hell.

    I suspect there are a lot of yet undiscovered uses for this technique that will only be revealed with time and community acceptance. If nothing else, it will shutup the Java people claiming that Perl OO has poor encapsulation.

    As much as I hate Java, I won't defend a failing in Perl when I see it. Perl does have horrible encapsulation, primiarly because of what you had to write to achieve it. Perhaps if stuff like this was in the core module distribution, a la "use ObjectVoodoo" or somesuch, we could argue the language did it well, but as it stands, the language does it poorly, and it becomes the role of the coder to fix the language ... hence (at least) Java speaks it more fluently. Usually java coders get it all wrong though -- and by no means is java a shining example of OO.

      I am fully in support of this type of encapsulation. Programmers ought not to be fiddling with an object's member variables without being invited first. Programmers doing that deserve the heck they get from it. I do it sometimes because the implementation on CPAN wasn't precient enough to suit my needs so a mutation is needed. I also do it because it is fun.

      I don't do it in places that matter. (well maybe except LWP::Simple::Cookies, LWP::Simple::Post, and B::Deobfuscate but those are exceptions and well enough defined exception areas.

      Perl does not enforce private and public parts of its modules as you may have been used to in other languages like C++, Ada, or Modula-17. Perl doesn't have an infatuation with enforced privacy. It would prefer that you stayed out of its living room because you weren't invited, not because it has a shotgun.
      I like the shotgun quote. I fully support it. That's why I hate Perl's OO system. Do you remember where the shotgun quote is? It's not in the manual about objects - it's in the manual about modules. Modules all have their own namespaces - the living rooms. With objects however, this is different. A superclass might not invite the subclass in its living room, but it's as much the living room of the subclass as it is the superclass'.

      Abigail