in reply to Re: A quicker way to have protected and private fields?
in thread A quicker way to have protected and private fields?

But I can subclass already by doing:

package src::bo::Rubber;

use strict;
use warnings;

use Carp;

use src::bo::Duck;
use base qw/src::bo::Duck/;

use src::bo::CannotFly;
use src::bo::CanSqeek;

sub new {
    my $class   = shift;
    my $extends = $class->SUPER::new(@_);
    $extends->setFlyBehaviour( src::bo::CannotFly->new() );
    $extends->setQuackBehaviour( src::bo::CanSqeek->new() );
    bless( $extends, $class );
    return $extends;
}

[download]

In the case of this strategy pattern I don't think I would gain much. Maybe you know of other cases?

--
if ( 1 ) { $postman->ring() for (1..2); }

Replies are listed 'Best First'.
Re^3: A quicker way to have protected and private fields?
by chromatic (Archbishop) on Feb 28, 2006 at 20:14 UTC

    Suppose I want to subclass your original class to add a single attribute. What does the code look like to do that? What does the code look like to use the object?

[reply]

      Something like this I'd guess:

      sub new {
    my $class   = shift;

    my $extends = $class->SUPER::new(@_);
    $extends->setFlyBehaviour( src::bo::CannotFly->new() );
    $extends->setQuackBehaviour( src::bo::CanSqeek->new() );
    
    my $self = {
        COLOR   => undef,
    };
    my @protected = qw/COLOR/;
    my @private   = qw//;

    my $closure = sub {
        my $field = shift;
        if ( exists $self->{$field} ) {
            grep( /$field$/, @private ) and caller(0) eq __PACKAGE__ 
                || confess "$field is private";
            grep( /$field/, @protected ) and caller(0)->isa(__PACKAGE_
+_)
                || confess "$field is protected";
            if (@_) { $self->{$field} = shift; }
            return $self->{$field};
        }
        else {
            return $extends->( $field, @_ );
        }
    };

    bless( $closure, $class );
    return $closure;
}

sub setColor {
    my $closure = shift;
    my $color   = shift;
    &{ $closure }("COLOR", $color);
}

sub getColor {
    my $closure = shift;
    return &{ $closure }("COLOR");
}

      [download]

      Ok, I have to repeat the incantation to mark the private and protected fields as such... for as long as I want to go that far. Here I don't use privates so I could drop the @private and the grep for private fields. In fact I could drop the grep as well and just test on the name before calling confess.

      It would be neat to have a cpan class that would do this automagically though...

      --
      if ( 1 ) { $postman->ring() for (1..2); }
[reply]
[d/l]

      To use the class:

      my $duck = src::bo::Duck->new();
is( ref($duck), "src::bo::Duck", "A duck object" );
throws_ok { $duck->setFlyBehaviour( src::bo::CannotFly->new() ) }
  qr/setFlyBehaviour is protected/, "setFlyBehaviour is protected";
throws_ok { $duck->( "FLYBEHAVIOUR", src::bo::CannotFly->new() ) }
  qr/FLYBEHAVIOUR is protected/, "FLYBEHAVIOUR is protected";

#is( $duck->doFly(), "cannot fly", "the duck cannot fly" );

my $rubber = src::bo::Rubber->new();
is( ref($rubber),       "src::bo::Rubber", "A rubber duck object" );
is( $rubber->doFly(),   "cannot fly",      "the rubber duck cannot fly
+" );
is( $rubber->doQuack(), "can sqeek",       "the rubber duck sqeeks" );

my $whistle = src::bo::Whistle->new();
is( ref($whistle),       "src::bo::Whistle", "A whistle object" );
is( $whistle->doFly(),   "cannot fly",       "the whistle doesn't fly"
+ );
is( $whistle->doQuack(), "cannot quack",     "the whistle doesn't quac
+k" );

throws_ok { $whistle->setQuackBehaviour( src::bo::CanQuack->new() ) }
  qr/setQuackBehaviour is protected/, "setQuackBehaviour is protected"
+;
throws_ok { $whistle->( "QUACKBEHAVIOUR", src::bo::CanQuack->new() ) }
  qr/QUACKBEHAVIOUR is protected/, "QUACKBEHAVIOUR is protected";

$rubber->setColor("green");
is( $rubber->getColor(), "green", "it's a green rubber duck!" );

      [download]

      Ok, you have to imagine the 'use strict, use warnings, use Test::More, use Test::Exception, and all the use src::bo::somethings...

      --
      if ( 1 ) { $postman->ring() for (1..2); }
[reply]
[d/l]

In Section Seekers of Perl Wisdom