Изящное ветвление или мощь Perl с ООП.

Это решение основано на создании хэша, с именами функций в значениях ключей. Приведу пример из cookbook, так как лучше один раз увидеть:

   1    #!/usr/bin/perl -w
   2    use CGI qw(param header);
   3    
   4    my $page=param('page');
   5    
   6    %States = (
   7        'Default' => \&front_page,
   8        'Shirt' => \&shirt,
   9        'Sweater' => \&sweater,
  10        'Checkout' => \&checkout,
  11        'Card' => \&credit_card,
  12        'Order' => \&order,
  13        'Cancel' => \&front_page
  14    );
  15    
  16    if ($States{$page}) {
  17    $States{$page}->(); # Вызвать нужную подпрограмму
  18    } else {
  19    no_such_page():
  20    }  

В зависимости от переданного в параметре page значения - вызывается соответствующая подпрограмма. Чем больше у нас подпрограмм, тем больше приходится писать в хэш %States. И хотя в cookbook это решение противопоставляется громоздкой конструкции if .. else ... есть более красивое решение, с использованием возможностей ООП в Perl.

Зачем собственно нам нужен хэш %States? Гораздо лаконичней и изящней сделать все через вызов методов класса (пакета). Для начала код самого скрипта:

   1    #!/usr/bin/perl -w
   2    use CGI qw(param header);
   3    use MyClass;
   4    
   5    my $act=MyClass->new();
   6    my $method=param('page');
   7    
   8    if($act->can($method)) {
   9        $act->$method;
  10    } else {
  11        $act->default;
  12    }

Далее мы просто добавляем методы в пакет MyClass и не обслуживаем никакие хэши. Пример пакета:

   1    package MyClass;
   2    
   3    sub new {
   4        my $class = shift;
   5        my $self = bless {}, $class;
   6        return $self;
   7    }
   8    
   9    # стартовая страница
  10    sub shirt {
  11        my $self=shift;
  12        # ... do something
  13    }
  14    
  15    sub default {
  16       my $self=shift;# имя класса 
  17    }

Можно было обойтись и без проверки can (из псевдокласса UNIVERSAL), тогда код самого скрипта был бы еще лаконичней, мы бы сразу вызывали $act->$method, но для случаев когда передан несуществующий метод, надо было добавить в наш класс метод AUTOLOAD, который запускал бы программу (метод) по умолчанию. Для реализации AUTOLOAD объявите в начале пакета переменную через our и добавьте метод:

   1    package MyClass;
   2    
   3    our $AUTOLOAD;
   4    
   5    sub AUTOLOAD {
   6    my $self = shift;
   7    return if our $AUTOLOAD=~/::DESTROY$/;
   8    $self->default;
   9    }

Важно - необходимо сразу делать возврат из AUTOLOAD, если происходит вызов деструктора (DESTROY).

Вариант с автозагрузкой (AUTOLOAD), конечно лаконичней, но чуть чуть медленней чем вариант с UNIVERSIAL::can, так как интерпретатор Perl проверяет сперва методы через UNIVERSAL и лишь затем вызывает AUTOLOAD, но в большинстве случаев - это не так принципиально.

Важное замечание, поступающие данные для инициализации $method нужно очищать. При этом важно очищать их от имени конструктора класса, в нашем примере - таким ялвяется new, иначе будет ошибка скрипта. К примеру:

$method=~s/^new$//i;# спасибо xorro за поправку

еще будет полезно очищать метод от символов :: , иначе кто-нибудь может попытаться вызвать конструкции типа: SUPER::new. Как окончательное решение - если имена методов содержат только символы в диапазоне a-z, то чистим так:

$method=~/[^a-z]+//g;

ну и так далее... НО, как говорят такая очистка убивает красоту приема, поэтому немного модифицируем конструктор MyClass:

   1    package MyClass;
   2    
   3    sub new { 
   4           my $class = shift;
   5           return $class->default if(ref $class);# проверка!
   6           my $self = bless {}, $class; 
   7           return $self; 
   8    } 

Теперь переменную $method можно не проверять, так как если будет вызван конструктор new второй раз, то переменная $class будет содержать ссылку, и мы это легко определим и вызовем метод по умолчанию.

 Думаю представленное мной решение обратит ваше внимание на возможности ООП в Perl еще раз.

P.S.

Кстати Java, насколько я знаю, так не может ;-)