How do I write Perl object with plugins?

Question

How do I write Perl objects with extensible code? Im thinking drivers, or some configuation, where the user can pass in a string "Classname::Class" or something. Thanks.

For example, for a graph class:

my $spg = Graph::ShortestPathGraph->new;
$spg->Algorithm( "Graph::DFS" );
$spg->solve;

$spg->Algorithm( "Graph::BFS" );
$spg->solve;

Answer 1

How do I write extensible code?

With planning. Let's say you are writing an algorithm for plotting a set of points. You need a source of those points, a place to plot them, and an algorithm for interpolating points that aren't in the set.

(And just a note, assume that "graph" means "chart" here, rather than a graph in the discrete math sense.)

Let's define roles that represent those operations. A source of points must be able to provide us with the points:

 package Graphomatic::PointSource;
 use Moose::Role;

 requires 'get_points'; # return a list of points

 1;

A plotter must allow us to plot a point:

 package Graphomatic::Plot;
 use Moose::Role;

 requires 'plot_point'; # plot a point
 requires 'show_graph'; # show the final graph

 1;

And an interpolater must give us a point when given two nearby points:

 package Graphomatic::Interpolate;
 use Moose::Role;

 requires 'interpolate_point';

 1;

Now, we just need to write our main application in terms of these roles:

 package Graphomatic;
 use Moose;

 use Graphomatic::PointSource;
 use Graphomatic::Plot;
 use Graphomatic::Interpolate;

 has 'source' => (
     is       => 'ro',
     does     => 'Graphomatic::PointSource',
     handles  => 'Graphomatic::PointSource',
     required => 1,
 );

 has 'plot' => (
     is       => 'ro',
     does     => 'Graphomatic::Plot',
     handles  => 'Graphomatic::Plot',
     required => 1,
 );

 has 'interpolate' => (
     is       => 'ro',
     does     => 'Graphomatic::Interpolate',
     handles  => 'Graphomatic::Interpolate',
     required => 1,
 );

 sub run { # actually render and display the graph
     my $self = shift;

     my @points = $self->get_points; # delegated from the PointSource
     for my $x (some minimum .. some maximum) {
         my ($a, $b) = nearest_points( $x, @points );
         $self->plot_point( $self->interpolate_point($a, $b, $x) );
     }

     $self->show_graph;
 }

 1;

Now it's a simple matter of defining some source implementations. Let's read points from a file:

package Graphomatic::PointSource::File;

use Moose;
use MooseX::FileAttribute;

# ensure, at compile-time, that this class is a valid point
# source
with 'Graphomatic::PointSource';

has_file 'dataset' => ( must_exist => 1, required => 1 );

sub get_points {
    my $self = shift;

    return parse $self->dataset->slurp;
}

1;

And plot to the Z window system:

package Graphomatic::Plot::Z;
use Moose;
use Z;

with 'Graphomatic::Plot';

has 'window' => ( is => 'ro', isa => 'Z::Window', lazy_build => 1);

sub _build_window { return Z->new_window }

sub plot_point {
    my ($self, $point) = @_;

    $self->window->plot_me_a_point_kthx($point->x, $point->y);
}

sub show_plot {
    my $self = shift;
    $self->window->show;
}

1;

And interpolate with a random number generator (hey, I'm lazy, and I'm not going to look up bicubic interpolation :P):

package Graphomatic::Interpolate::Random;
use Moose;

with 'Graphomatic::Interpolate';

sub interpolate_point {
    my ($self, $a, $b, $x) = @_;
    return 4; # chosen by fair dice roll.
              # guaranteed to be random.
}

1;

Now we can assemble all the pieces into a working program:

use Graphomatic::PointSource::File;
use Graphomatic::Plot::Z;
use Graphomatic::Interpolate::Random;

my $graphomatic = Graphomatic->new(
   source => Graphomatic::PointSource::File->new(
       file => 'data.dat',
   ),
   plot        => Graphomatic::Plot::Z->new,
   interpolate => Graphomatic::Interpolate::Random->new,
);

$graphomatic->run;

Now you can cleanly customize any of the parts without affecting the other parts, simply by implementing new classes that "do" the required roles. (If they say 'with ...' and they don't meet the requirements, you will get an error as soon as you load the class. If you try to use an instance as a parameter that doesn't "do" the right role, the constructor will die.

Type safety, it's a wonderful thing.)

As for handling config files, just read names and parameters somehow, and then:

my $interpolate_class = get_config('interpolate_class');
Class::MOP::load_class($interpolate_class);
my $interpolate = $interpolate_class->new( %interpolate_class_args );

my $graphomatic = Graphomatic->new( interpolate => $interpolate, ... );

MooseX::YAML is a nice way of automating this.

Answer 2

Module :: Pluggable可能会帮助您实现您想要的目标。

Answer 3

Checkout Moose , and MooseX::Types::LoadableClass

package MyClass;
use Moose;
use MooseX::Types::LoadableClass qw/ClassName/;

has 'algo' => (
    is => 'ro'
    , isa => ClassName
    , coerce => 1
);

sub solve {
    my $self = shift;
    my $algo = $self->algo->new;
    # stuff using algo
}


## These work:
Graph::ShortestPathGraph->new({ algo => 'Graph::DFS' })->solve;
Graph::ShortestPathGraph->new({ algo => 'Graph::BFS' })->solve;

## As does this:
my $gspg = Graph::ShortestPathGraph->new;
$gspg->algo('Graph::BFS');
$gspg->solve;

If the class does not exist, an error is thrown. If, however, you want to create the Algo classes yourself, you're probably much better off making them Traits .

There are a ton of pre-made solutions using Moose to solve this problem, look around on CPAN.

Answer 4

Here is a simple home made example. Once you understand it, you can move on to modules that are intended to take the tedium out of this sort of thing:

#!/usr/bin/perl

package Me::Mine;

use base 'Class::Accessor';

__PACKAGE__->mk_accessors( qw( dumper ) );

sub dump {
    my $self = shift;
    my $dumper = $self->dumper;
    eval "require $dumper";
    print "Dumping using $dumper\n", $dumper->Dump([ $self ]);
    return;
}

package main;

use strict; use warnings;

my $me = Me::Mine->new;
my $you = Me::Mine->new;

$me->dumper('Data::Dumper');
$you->dumper('YAML');

$_->dump for $me, $you;

Output:

Dumping using Data::Dumper
$VAR1 = bless( {
                 'dumper' => 'Data::Dumper'
               }, 'Me::Mine' );
Dumping using YAML
--- YAML
---
- !!perl/hash:Me::Mine
  dumper: YAML