Как мне реализовать таблицы диспетчеризации в 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;
Вы можете использовать хеш для этого...
Сделайте так, чтобы каждый метод передачи регистрировался в хэше. Вы можете сделать это OO (вызывая метод на некоторой фабрике методов передачи) или процедурно (просто сделайте хэш переменной пакета, или вы даже можете поместить его в основной пакет, если вы не хотите использовать модульность).
package MyApp::Transfer::FTP; $MyApp::TransferManager::METHODS{ftp} = \&do_ftp; sub do_ftp { ... } 1;
Каждый метод передачи использует согласованный API. Может быть, это просто функция или объектный интерфейс.
Вызовите перевод через хеш.
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 для второго метода. Получить элегантный и рефакторинг по третьему способу. К тому времени у вас будет достаточно примеров, и ваше решение, вероятно, будет довольно общим.
Конечно, моя главная мысль в том, что второй и третий методы могут никогда не потребоваться.