Как реализовать таблицы отправки в Perl?

Question

Мне нужно написать приложение, связанное с хранилищем, в Perl. Приложение должно загружать файлы с локальной машины на некоторые другие узлы хранения. В настоящее время метод загрузки - FTP, но в будущем он может быть bittorrent или неизвестным методом пересылки файлов.

Для каждого файла, который необходимо загрузить, есть файл конфигурации, который определяет имя файла, узел хранения, к которому будет загружен файл, и какой метод переноса должен использоваться во время загрузки.

Конечно, я могу использовать следующий метод, чтобы решить мою проблему:

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

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

Могли бы вы, ребята, дать мне совет вообще? Конечно, если вы предоставите некоторый пример кода, это будет большой помощью.

Answer 1

Во-первых, тестирование равенства строк в Perl равно eq, а не ==.

Если у вас есть методы, чтобы сделать работу, скажем, с именем бит и FTP,

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

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

Answer 2

OO было бы излишним. Мое решение вероятно, будет выглядеть примерно так:

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}}->(...); 
} 

Answer 3

Вы можете использовать хэш для этого ...

1. Пусть каждый метод передачи зарегистрировать себя в хэш. Вы можете сделать это OO (путем вызова метода на каком-либо фабричном методе передачи) или процедурно (просто сделайте хеш переменной пакета, или вы можете даже поместить его в основной пакет, если вы не хотите модулировать).

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

2. В каждом способе передачи используется согласованный API. Возможно, это просто функция, или это может быть интерфейс объекта.

3. Позвоните на передачу через хэш.

   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; 

(Ни один из этого кода не проверяются, пожалуйста, простите недостающую запятую)

Answer 4

Правильный дизайн здесь является фабрикой. Посмотрите, как это делает DBI. Вы закончите с классом TransferAgent, который создаст одно из любого числа классов TransferAgent::*. Очевидно, вам понадобится дополнительная проверка ошибок, чем приведенная ниже реализация. Использование такой фабрики означает, что вы можете добавлять новые типы агентов передачи без необходимости добавлять или изменять какой-либо код.

TransferAgent.Вторая половина дня - завод класс:

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; 

Answer 5

Вы сказали, что сначала он будет использовать FTP и перейти к другим методам передачи позже. Я бы не стал «элегантным», пока вам не понадобится добавить вторую или третью технологию. Этот второй способ передачи никогда не понадобится. :-)

Если вы хотите сделать это как «научный проект», то здорово.

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

Оберните первый способ передачи в методе uploadFile. Добавьте a, если then else для второго метода. Получите элегантный и рефакторинг по третьему методу. К тому времени у вас будет достаточно примеров, что ваше решение, вероятно, будет довольно общим.

Конечно, мое главное, что второй и третий методы никогда не потребуются.

Answer 6

См. Implementing Dispatch Tables и MJD's treatment of dispatch tables in HOP.

Answer 7

У меня есть несколько примеров в Mastering Perl в разделах динамических подпрограмм.