Category: OO Programming
Author/Contact Info Gargle
Description: Visitor pattern

A quick example of the visitor pattern in perl, based on the wikipedia entry.
package Wheel;

# class for storing information about a Wheel

use warnings;
use strict;
use Carp;

sub new {
    my $class = shift;
    my $name = shift;
    my $self = {
        NAME => $name,
    };
    my $closure = sub {
        my $field = shift;
        if (@_) { $self->{$field} = shift; }
        return $self->{$field};
    };
    bless ($closure,$class);
    return $closure;
}

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

sub accept {
    my $self = shift;
    my $visitor = shift;
    $visitor->visitWheel($self);
}

1;
package Body;

# class for storing information about a Body

use warnings;
use strict;
use Carp;

sub new {
    my $class = shift;
    my $self = {};
    bless $self, $class;
    return $self;
}

sub accept {
    my $self = shift;
    my $visitor = shift;
    $visitor->visitBody($self);
}

1;
package Engine;

# class for storing information about an Engine

use warnings;
use strict;
use Carp;

sub new {
    my $class = shift;
    my $self = {};
    bless $self,$class;
    return $self;
}

sub accept {
    my $self = shift;
    my $visitor = shift;
    $visitor->visitEngine($self);
}

1;
package Car;

# class for storing information about a Car 

use warnings;
use strict;
use Carp;

sub new {
    my $class = shift;
    my $self = {
        ENGINE => undef, 
        BODY => undef,
        WHEELS => undef, # a list of wheels
    };
    my $closure = sub {
        my $field = shift;
        if (@_) { $self->{$field} = shift; }
        return $self->{$field};
    };
    bless ($closure,$class);
    return $closure;
}

# public accessors
sub engine { &{ $_[0] }("ENGINE", @_[1 .. $#_]) }
sub body   { &{ $_[0] }("BODY", @_[1 .. $#_]) }
sub wheels { &{ $_[0] }("WHEELS", @_[1 .. $#_]) }

sub accept {
    my $self = shift;
    my $visitor = shift;
    $visitor->visitCar($self);
    $self->engine->accept($visitor);
    $self->body->accept($visitor);
     map { $_->accept($visitor) } @{$self->wheels};
}

1;
package PrintVisitor;

# class for grouping together all the different print messages for car
+ parts 

use warnings;
use strict;
use Carp;

sub new {
    my $class = shift;
    my $self = {};
    bless $self,$class;
    return $self;
}

sub visitWheel {
    my $self = shift;
    my $wheel = shift;
    print "Visiting " . $wheel->name . " wheel\n";
}

sub visitEngine {
    my $self = shift;
    my $engine = shift;
    print "Visiting engine\n";
}

sub visitBody {
    my $self = shift;
    my $body = shift;
    print "Visiting body\n";
}

sub visitCar {
    my $self = shift;
    my $car = shift;
    print "Visiting car\n";
}

1;
#!/usr/bin/perl

# Using the visitor class

use strict;
use warnings;

use Car;
use PrintVisitor;
use Wheel;
use Body;
use Engine;

my $car = Car->new();
$car->engine( Engine->new() );
$car->body( Body->new() );
$car->wheels( [Wheel->new("front left"), 
               Wheel->new("front right"), 
               Wheel->new("back left"), 
               Wheel->new("back right")] );

my $visitor = PrintVisitor->new();
$car->accept($visitor);
Replies are listed 'Best First'.
Re: The visitor pattern
by gargle (Chaplain) on Aug 23, 2005 at 13:50 UTC
    I've added this code to the wikipedia entry (it shows first, then python, then java and c++)