我该如何在Perl中实现调度表？

Question

我需要用Perl编写一个与存储相关的应用程序。该应用程序需要将本地计算机上的文件上传到其他存储节点。目前，上传方法是FTP，但未来可能使用比特流或某些未知的超级文件传输方法。

对于每个需要上传的文件，都有一个配置文件，其中定义了文件名、文件将要上传到的存储节点以及上传过程中应使用的传输方法。

当然，我可以使用以下方法来解决我的问题：

{
  if ( $trans_type == "ftp" ) { ###FTP the FILE}
  if ( $trans_type == "bit" ) { ###BIT the FILE}
  ### etc ###
}

但是即使我在学校学过基本的面向对象编程知识，我仍然觉得这不是一个好的设计。（问题标题可能有点误导。如果你认为我的问题可以用非面向对象的解决方案优雅地解决，那对我来说也很好。实际上，这会更好，因为我对面向对象编程的了解有限。）

所以，你们能给我一些一般性的建议吗？当然，如果你能提供一些示例代码，那就太棒了。

- Haiyuan Zhang

Answer 1

首先，在Perl中进行字符串相等性测试使用的是eq而不是==。

如果你有执行此任务的方法，比如说命名为bit和ftp，

my %proc = (
    bit => \&bit,
    ftp => \&ftp,
);

my $proc = $proc{$trans_type};
$proc->() if defined $proc;

- xcramps

---

不需要定义，因为没有任何假值是有效的coderef。此外，如果在查找表中找不到该方法，则应发出警告。另一种选择是将所有方法放入类中并使用“can”。 - Sinan Ünür

@Sinan Ünür- 如果 $trans_type eq "fronobulax?" 那么怎么办呢？换句话说，这是一种他没有预料到或者没有预期的类型？ - xcramps

@xcramps，然后你会收到一个神秘的错误信息“在__FILE__的第__LINE__行调用了未定义的子例程&main::”，这比让程序在未知状态下继续运行要好。如果你要检查是否已定义，则应提供自己的警告或错误提示。 - Chas. Owens

使用exists检查，否则对$proc的赋值将改变您的数据结构。如果（存在$proc{$trans_type}）{my $proc = $proc{$trans_type};＃在此处验证$proc; $proc->()} - daotoad

@daotoad：不，它不会。也许你在想if ($proc {$trans_type} {'process_file'})将不存在的$proc {$trans_type}转换为一个空哈希的引用，但是仅仅查找哈希中的值并不会在那里创建哈希元素。 - ysth

Answer 2

您可以使用哈希来实现这个功能...

1. Have each transfer method register itself in the hash. You can do this OO (by calling a method on some transfer method factory) or procedurally (just make the hash a package variable, or you could even put it in the main package if you don't want to modularize).

   package MyApp::Transfer::FTP;
   $MyApp::TransferManager::METHODS{ftp} = \&do_ftp;
   sub do_ftp { ... }
   1;
   

2. Each transfer method uses a consistent API. Maybe its just it a function, or it could be an object interface.

3. Call the transfer through the hash.

   sub do_transfer {
       # ...
       my $sub = $MyApp::TransferManager::METHODS{$method}
           or croak "Unknown transfer method $method";
       $sub->($arg1, $arg2, ...);
       # ...
   }
   

顺便说一下：OO注册方法看起来会像这样：

package MyApp::TransferManager;
use Carp;
use strict;

my %registered_method;

sub register {
    my ($class, $method, $sub) = @_;

    exists $registered_method{$method}
        and croak "method $method already registered";

    $registered_method{$method} = $sub;
}

# ...

1;

这段代码没有经过测试，请原谅缺少分号。

- derobert

---

哈希仍然存在一个问题，即您正在列出可能的传输代理。没有理由硬编码此列表。只需创建TransferAgent :: FTP，TransferAgent :: SCP，TransferAgent :: BitTorrent等。然后，工厂类可以负责实例化正确的类。 - Chas. Owens

@Chas. Owens：我在哪里硬编码了列表？每个方法实现都负责注册自己。如果您想要那种级别的自定义（例如，也许您想关闭一个非常依赖重的模块），则可以很容易地使用配置文件指定要加载哪些传输模块，或者加载给定目录中的所有.pm文件（如果您想要那种魔术级别）。 - derobert

@derobert 个别类如何运行？如果我有一个需要传输到多个服务器类型的程序，我是否必须在我的程序中将每种类型作为单独的use语句指定？类不能注册自己直到它们被使用。这意味着你必须在某个地方硬编码给定程序可以使用哪些类（例如配置文件）。通过仅在被要求时要求类，您不需要那种硬编码。 - Chas. Owens

包变量是全局的。 - jrockway

@Chas. Owens：我认为你错过了最后一部分，即加载给定目录中的所有.pm文件（例如，将它们视为插件）。以这种方式执行任务的一个例子是Catalyst。即使您选择在配置文件中明确列出，也不会太糟糕，因为您已经在这样做了（您的配置需要提供连接详细信息）。<br><br>@jrockway 是的，你说得对，他们是。我会修复... - derobert

Answer 3

这里的正确设计是工厂模式。看一下DBI如何处理这个问题。你会得到一个TransferAgent类，它可以实例化任意数量的TransferAgent::*类。显然，你需要比下面的实现提供更多的错误检查。使用这样的工厂模式意味着你可以添加新的传输代理类型，而无需添加或修改任何代码。

TransferAgent.pm - 工厂类：

package TransferAgent;

use strict;
use warnings;

sub connect {
    my ($class, %args) = @_;

    require "$class/$args{type}.pm";

    my $ta = "${class}::$args{type}"->new(%args);
    return $ta->connect;
}

1;

TransferAgent/Base.pm - 包含 TransferAgent::* 类的基本功能：

package TransferAgent::Base;

use strict;
use warnings;

use Carp;

sub new {
    my ($class, %self) = @_;
    $self{_files_transferred} = [];
    $self{_bytes_transferred} = 0;
    return bless \%self, $class;
}

sub files_sent { 
    return wantarray ?  @{$_[0]->{_files_sent}} : 
        scalar @{$_[0]->{_files_sent}};
}

sub files_received { 
    return wantarray ?  @{$_[0]->{_files_recv}} : 
        scalar @{$_[0]->{_files_recv}};
}

sub cwd    { return $_[0]->{_cwd}       }
sub status { return $_[0]->{_connected} }

sub _subname {
    return +(split "::", (caller 1)[3])[-1];
}

sub connect    { croak _subname, " is not implemented by ", ref $_[0] }
sub disconnect { croak _subname, " is not implemented by ", ref $_[0] }
sub chdir      { croak _subname, " is not implemented by ", ref $_[0] }
sub mode       { croak _subname, " is not implemented by ", ref $_[0] }
sub put        { croak _subname, " is not implemented by ", ref $_[0] }
sub get        { croak _subname, " is not implemented by ", ref $_[0] }
sub list       { croak _subname, " is not implemented by ", ref $_[0] }

1;

TransferAgent/FTP.pm - 实现一个(模拟) FTP 客户端：

package TransferAgent::FTP;

use strict;
use warnings;

use Carp;

use base "TransferAgent::Base";

our %modes = map { $_ => 1 } qw/ascii binary ebcdic/;

sub new {
    my $class = shift;
    my $self  = $class->SUPER::new(@_);
    $self->{_mode} = "ascii";
    return $self;
}

sub connect    { 
    my $self = shift;
    #pretend to connect
    $self->{_connected} = 1;
    return $self;
}

sub disconnect {
    my $self = shift;
    #pretend to disconnect
    $self->{_connected} = 0;
    return $self;
}

sub chdir { 
    my $self = shift;
    #pretend to chdir
    $self->{_cwd} = shift;
    return $self;
}

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

    if (defined $mode) {
        croak "'$mode' is not a valid mode"
            unless exists $modes{$mode};
        #pretend to change mode
        $self->{_mode} = $mode;
        return $self;
    }

    #return current mode
    return $self->{_mode};
}

sub put {
    my ($self, $file) = @_;
    #pretend to put file
    push @{$self->{_files_sent}}, $file;
    return $self;
}

sub get {
    my ($self, $file) = @_;
    #pretend to get file
    push @{$self->{_files_recv}}, $file;
    return $self;
}

sub list {
    my $self = shift;
    #pretend to list remote files
    return qw/foo bar baz quux/;
}

1;

script.pl - 如何使用TransferAgent：

#!/usr/bin/perl

use strict;
use warnings;

use TransferAgent;

my $ta = TransferAgent->connect(
    type     => "FTP",
    host     => "foo",
    user     => "bar",
    password => "baz",
);

print "files to get: ", join(", ", $ta->list), "\n";
for my $file ($ta->list) {
    $ta->get($file);
}
print "files gotten: ", join(", ", $ta->files_received), "\n";

$ta->disconnect;

- Chas. Owens

---

我认为你不想在FTP类中使用use base "TransferAgent"这行代码。特别是因为你的工厂连接方法在派生类中无法正常工作（会得到错误的类值，甚至更糟糕的是一个实例）。也许你想在require和new行中使用__PACKAGE__代替？ - derobert

你也可以使用CPAN上的Class::Factory来实现这个功能。这是一个非常小巧的模块，但非常容易实现和使用。 - Chris Winters

@derobert 是的，那时已经很晚了，而且我还没有睡觉。这个模式应该有一个单独的类来获得基本功能（这也是我打算让TransferAgent成为工厂之外的东西）。现在我已经纠正了代码并加以完善，因为我现在已经清醒了。 - Chas. Owens

@Chris Winters 我以前从未使用过Class::Factory。它看起来很有趣，但是快速浏览似乎表明它并不比哈希解决方案更好。它似乎需要您注册可以由其创建的类。在我看来，这就打败了使用工厂类的主要原因（即您不需要事先知道可能存在哪些实现）。 - Chas. Owens

Answer 4

我在动态子例程的章节中看到了一些示例，这些示例出现在《掌握Perl》中。

- brian d foy

Answer 5

请参阅实现分派表和MJD在HOP中对分派表的处理。

- Sinan Ünür

Answer 6

面向对象编程可能有些过度设计。我的解决方案可能会像这样：

sub ftp_transfer { ... }
sub bit_transfer { ... }
my $transfer_sub = { 'ftp' => \&ftp_transfer, 'bit' => \&bit_transfer, ... };
...
sub upload_file {
    my ($file, ...) = @_;
    ...
    $transfer_sub->{$file->{trans_type}}->(...);
}

- tetromino

---

我认为在哈希表中的子程序前面需要加上 '，否则 Perl 会将 &ftp_transfer 返回的值分配给 $transfer_sub{ftp}，而不是一个对子程序的引用。 - Chris Lutz

@Chris：&subname 返回 subname 的引用。请参阅 perlref，"Making References"。 - derobert

在编程中，拥有一些面向对象（OO）的东西很少会过度。而这个例子明显需要用面向对象的方式来解决。 - innaM

Answer 7

你说最初会使用FTP，然后转移到其他传输方法。在你真正需要添加第二或第三种技术之前，我不会考虑“优雅”。也许永远不需要第二种传输方法。:-)

如果你想把它做成一个“科学项目”，那太好了。

我厌倦了看到OO设计模式使解决问题变得复杂，而这些问题从未出现过。

将第一种传输方法包装在uploadFile方法中。为第二种方法添加if-then-else语句。在第三种方法上进行优化和重构。到那时，你将有足够的例子，你的解决方案可能会非常通用。

当然，我的主要观点是第二和第三种方法可能永远不会被需要。

- DanM

---

“我之后再把它弄好”的方法存在一个问题，那就是在你需要把它弄好的时候，已经有一堆现有程序在使用不太好的接口了。当然，你必须始终权衡未来需求和简单地完成任务的需要。在这种情况下，工厂设计模式被广泛理解，并且实现起来相当简单，因此为未来提供漂亮的接口并不会耗费太多时间。 - Chas. Owens