Как мне написать объект Perl с плагинами?

Question

Как мне написать Perl-объекты с расширяемым кодом? Я думаю о драйверах или какой-то конфигурации, где пользователь может передать строку "Classname :: Class" или что-то в этом роде. Спасибо.

Например, для класса графа:

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

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

Answer 1

Как написать расширяемый код?

С планированием.Допустим, вы пишете алгоритм для построения набора точек.Вам нужен источник этих точек, место для их построения и алгоритм для интерполяции точек, которых нет в наборе.

(И просто примечание, предположим, что «график» означает «график» здесь, а не граф в дискретном математическом смысле.)

Давайте определим роли, которые представляют эти операции.Источник точек должен быть в состоянии предоставить нам точки:

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

 requires 'get_points'; # return a list of points

 1;

Построитель должен позволить нам построить точку:

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

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

 1;

И интерполятор должен дать нам точкукогда даны две соседние точки:

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

 requires 'interpolate_point';

 1;

Теперь нам просто нужно написать наше основное приложение в терминах этих ролей:

 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;

Теперь просто определить некоторые реализации исходного кода.,Давайте прочитаем точки из файла:

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;

И нанесем на график систему Z Window:

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;

И интерполируем с генератором случайных чисел (эй, я ленивый, и яне собираюсь искать бикубическую интерполяцию: 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;

Теперь мы можем собрать все части в рабочую программу:

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;

Теперь вы можете чисто настроить любой изчасти, не влияющие на другие части, просто путем реализации новых классов, которые «выполняют» требуемые роли.(Если они говорят «с ...» и не соответствуют требованиям, вы получите сообщение об ошибке, как только загрузите класс. Если вы попытаетесь использовать экземпляр в качестве параметра, который не «делает»Правильно, конструктор умрет.

Безопасность типов, это замечательно.)

Что касается обработки файлов конфигурации, просто как-то читайте имена и параметры, а затем:

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 - хороший способ автоматизировать это.

Answer 2

Оформление заказа Moose и 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;

Если класс не существует, выдается ошибка. Однако, если вы хотите создать классы Algo самостоятельно, вам, вероятно, гораздо лучше сделать их Черты .

Существует множество готовых решений, использующих Moose для решения этой проблемы, посмотрите на CPAN.

Answer 3

Module :: Pluggable может помочь вам достичь того, что вы хотите.

Answer 4

Вот простой домашний пример. Как только вы поймете это, вы можете перейти к модулям, которые предназначены для снятия скуки из такого рода вещей:

#!/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;

Выход:

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