Как мне реализовать таблицы диспетчеризации в Perl?

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

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

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

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

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

Так вы, ребята, могли бы дать мне несколько советов в целом? Конечно, если вы предоставите также некоторый пример кода, это будет очень полезно.

7 ответов

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

Если у вас есть методы для выполнения работы, скажем, с именем bit и ftp,

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

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

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

  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;

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

Правильный дизайн здесь - фабрика. Посмотрите, как 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;

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

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

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

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

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

Я устал от того, что шаблоны проектирования ОО усложняют решение проблем, которые никогда не приходят.

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

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

Другие вопросы по тегам