Search code examples
perlclosuressubclass

How do I define a subclass in Perl when I'm using a closure to limit access to the properties?


I'm trying to create a subclass, and create a new property in my subclass. Both the parent class and subclass use a closure to limit access to the internal properites.

### Superclass A ###
package A;

sub new
{
   my $class = shift;
   my $this  = { 'a' => 1 };
   my $closure = sub {
      my $field = shift;
      @_ and $this->{$field} = shift;
      return $this->{$field};
   };
   return bless($closure, $class);
}

### Subclass B ###
package B;

use parent 'A';

sub new
{
   my $class = shift;
   my $this = $class->SUPER::new();
   
   # Want to add a parameter "b" to this class.
   # This doesn't work:
   $this->{'b'} = 2;    # Get "Not a HASH reference at (this line number)"
   
   # This doesn't work:
   &$this('b', 2);   # Get "Not a HASH reference (in my closure sub)"
   # Doesn't matter whether I define $closure before or after this.

    my $closure = sub
    {
        my $field = shift;
        @_ and $this->{$field} = shift;
        return $this->{$field};
    };
    
    return bless($closure, $class);
}

I think I understand why it's not working, I just don't know the correct way to do it.


Solution

  • The following works for me:

    A.pm:

    package A;
    use strict;
    use warnings;
    use lib '.';
    
    sub new
    {
       my $class = shift;
       my $this = {}; 
       my $closure = sub {
          my $field = shift;
          @_ and $this->{$field} = shift;
          return $this->{$field};
       };
       $closure->('a', 1);
       return bless($closure, $class);
    }
    
    1;
    

    B.pm:

    package B;
    use strict;
    use warnings;
    use lib '.';
    use parent 'A';
    
    sub new
    {
       my $class = shift;
       my $this = $class->SUPER::new();
       $this->('b', 2);
       return $this;
    }
    
    1;
    

    main.pl:

    use feature qw(say);
    use strict;
    use warnings;
    use lib '.';
    use B;
    
    my $b = B->new();
    say "a = ", $b->('a');
    say "b = ", $b->('b');
    

    Output from running main.pl is:

    a = 1
    b = 2