Category: OO Programming
Author/Contact Info Gargle
Description:

Decorator pattern...

A quick example of a decorator pattern in perl

As the GOF says: a flexible alternative to subclassing for extending functionality

the constructor isn't overkill I think. TEXT and itsPrint are privates so classes which might inherit cannot touch them directly. However, we do need a public method to access the variable TEXT in the example given here. itsPrint can only set by the constructor of the PrintHtml and PrintLatex classes.

the base class we'll decorate

package Print;

# Print class to print a string 

use warnings;
use strict;
use Carp;

sub new {
        my $type = shift;
        my $class = ref $type || $type;
        # TEXT is private!
        my $self = {
                TEXT => undef,
        };
        my $closure = sub {
                my $field = shift;
                if (@_) { $self->{$field} = shift; }
                return $self->{$field};
        };
        bless ($closure,$class);
        return $closure;
}

# a public accessor to set and get TEXT
sub text { &{ $_[0] }("TEXT", @_[1 .. $#_]) }

# a public method to print TEXT

sub print { 
        my $self = shift;
        print $self->text . "\n";
}

1;

A HTML version

package PrintHtml;

# Print class to print a string in html format 

use warnings;
use strict;
use Carp;
use Print;

sub new {
        my $type = shift;
        my $class = ref $type || $type;
        # itsPrint is private!
        my $itsPrint = shift;
        my $self = {
                itsPrint => $itsPrint,
        };
        my $closure = sub {
                my $field = shift;
                return $self->{$field};
        };
        bless ($closure,$class);
        return $closure;
}

sub print {
        my $self = shift;
        print "<p>\n";
        &{ $_[0]}("itsPrint")->print;
        print "</p>\n";
}
1;

A Latex version

package PrintLatex;

# Print class to print a string in latex format 

use warnings;
use strict;
use Carp;
use Print;

sub new {
        my $type = shift;
        my $class = ref $type || $type;
        # itsPrint is private!
        my $itsPrint = shift;
        my $self = {
                itsPrint => $itsPrint,
        };
        my $closure = sub {
                my $field = shift;
                return $self->{$field};
        };
        bless ($closure,$class);
        return $closure;
}

sub print {
        my $self = shift;
        print "\\begin{paraf}\n";
        &{ $_[0]}("itsPrint")->print;
        print "\\end{paraf}\n";
}

1;

The caller...

#!/usr/bin/perl

use warnings;
use strict;
use Print;
use PrintHtml;
use PrintLatex;

print "Text...\n";
my $print = Print->new();
$print->text("hello");
$print->print;

print "\nHTML...\n";
my $html = PrintHtml->new($print);
$html->print;

print "\nLatex...\n";
my $latex = PrintLatex->new($print);
$latex->print;
Replies are listed 'Best First'.
Re: The decorator pattern
by merlyn (Sage) on Aug 20, 2005 at 14:18 UTC
      Damn, got me there ;) Good point actually...

      It's because of remarks like this that I always come back to Perl Monks. Thanks for the link!
Re: The decorator pattern
by punkcraft (Pilgrim) on Dec 21, 2005 at 12:49 UTC
    The "my $self = shift;" should be removed from the subclassed print() subroutines if you are going to use $_[0] to call the parent class's print().