Perl：測試是否存在類

Question

我有一個叫做Question的類，還有一些子類，這取決於問題的類型。我可以創建針對子類的對象，但我不應該能夠創建類的對象問題本身：

#! /usr/bin/env perl 

use strict; 
use warnings; 

# 
# LOAD IN YOUR QUESTIONS HERE 
# 

my @list_of_questions; 
for my $question_type qw(Science Math English Dumb) { 
    my $class = "Question::$question_type"; 
    my $question = $class->new; 
    push @list_of_questions, $question; 
} 

package Question; 
use Carp; 

sub new { 
    my $class = shift; 

    my $self = {}; 

    if ($class = eq "Question") { 
     carp qq(Need to make object a sub-class of "Question"); 
     return; 
    } 

    bless $self, $class; 
    return $self; 
} 
yadda, yadda, yadda... 

package Question::Math; 
use parent qw(Question); 
yadda, yadda, yadda... 

package Question::Science; 
use parent qw(Question); 
yadda, yadda, yadda... 

package Question::English; 
use parent qw(Question); 
yadda, yadda, yadda... 

注意這些都不模塊，而僅僅是我定義的類是用在我的程序中。因此，我無法在運行時測試模塊加載。

當我運行上面，我得到：

Can't locate object method "new" via package "Question::Dumb" (perhaps you forgot to load "Question::Dumb"?)

有沒有辦法趕上這個特定的錯誤，所以我能應付自己嗎？我知道我可以創建一個有效類型的數組，但我希望能夠添加新的問題類型，而不必記住更新我的數組。

Answer 1

這裏就是我終於做到：

package Question; 
use Carp; 

sub new { 
    my $class = shift; 
    my %params = @_; 

    # 
    # Standardize the Parameters 
    # Remove the dash, double-dash in front of the parameter and 
    # lowercase the name. Thus, -Question, --question, and question 
    # are all the same parameter. 
    # 

    my %option_hash; 

    my $question_type; 
    for my $key (keys %params) { 

     my $value = $params{$key}; 

     $key =~ s/^-*//; #Remove leading dashes 
     $key = ucfirst (lc $key); #Make Key look like Method Name 

     if ($key eq "Type") { 
      $question_type = ucfirst (lc $value); 
     } 
     else { 
      $option_hash{$key} = $value; 
     } 
    } 

    if (not defined $question_type) { 
     carp qq(Parameter "type" required for creating a new question.); 
     return; 
    } 

    # 
    # The real "class" of this question includes the question type 
    # 

    my $self = {}; 
    $class .= "::$question_type"; 
    bless $self, $class; 

    # 
    # All _real does is return a _true_ value. This method is in this 
    # class, so all sub-classes automatically inherit it. If the eval 
    # fails, this isn't a subclass, or someone wrote their own `_real_ 
    # method in their sub-class. 
    # 

    eval { $self->_real; }; 
    if ($@) { 
     carp qq(Invalid question type of $question_type); 
     return; 
    } 

    # 
    # Everything looks good! Let's fill up our question object 
    # 

    for my $method (keys %option_hash) { 
     my $method_set; 
     eval { $method_set = $self->$method($option_hash{$method}) }; 
     if ($@ or not $method_set) { 
      carp qq(Can't set "$method" for question type "$question_type"); 
      return; 
     } 
    } 

    return $self; 
} 

現在，我設置我的問題是這樣的：

my $question = Question->new(
    --type  => Integer, 
    --question => "Pick a number between 1 and 10.", 
    --help  => "Try using the top row of your keyboard...", 
    --from  => "1", 
    --to  => "10", 
); 

if (not defined $question) { 
    die qq(The question is invalid!); 
} 

Darch使用Try::Tiny的是好的。它看起來比將所有東西都包裝在eval中更好。不幸的是，它不是一個標準模塊。這個程序將運行在幾乎100個獨立的系統上，使用CPAN模塊太困難了。由於這些系統位於防火牆之後並且無法訪問CPAN網站，因此尤其如此。

我基本上是用達奇的方法，除了我創造我的超類_real的方法，我嘗試後，我祝福的對象。如果它執行了（這就是我真正關心的），那麼這是我的超類的一個子類。

這做什麼，我真的想：隱藏我的子類我父背後 - 很像File::Spec一樣。我的大多數類都有相同的方法，少數有一個或兩個額外的方法。例如，我的Regex問題類型有一個Pattern方法，可以讓我確保給出的答案與給定的模式匹配。

Answer 2

AFAICT你想要做的是檢查符號表，看看你的「類」（又名「包」）是否已被定義。手動操作並不困難，但Class :: Load提供了更多的可讀糖，並應用了「啓發式」 - 無論如何。如果你不想使用這個模塊，那麼is_class_loaded的源代碼將會引導你找到你正在尋找的任何答案。

use Class::Load qw(is_class_loaded); 

for my $question_type (qw(Math English Science Dumb)) { 
    my $class = "Question::$question_type"; 
    if(!is_class_loaded($class)) { 
     # construct your new package at runtime, then 
    } 

    new_question($class); 

} 

你的變量名（ 「class_type」）很奇怪，所以我固定它。我也不知道Module :: Load是否更好，但我們在工作中使用Class :: Load。

編輯：bare qw（）s在較新的Perls（5.14？）中被棄用。這是一個愚蠢的貶低，但它在那裏，所以我們都必須學會現在將我們的qw（）foreachs包裝在parens中。

Answer 3

你不能像Invalid::Class->new()表達不扔在調用代碼的異常，但你可以在異常處理包裝，幷包，一個方法內。該標準模式是提供描述所述子類您其中創建到工廠方法「類型」的說法。一種常見的反模式是將該工廠方法放在基類上，從而創建一個循環依賴關係，並且不得不做更多的工作。

通常在接口類上有工廠方法，並讓它構造一個不相關的專用基類的子類，當它失敗時可能會發出警告或拋出。在代碼中，看起來非常像這樣：

package Question; 

use Try::Tiny; 
use Carp qw/carp/; 

sub new { 
    my ($class, $type, @args) = @_; 

    # could do some munging on $type to make it a class name here 
    my $real_class = "Question::$type"; 

    return try { 
     $real_class->new(@args); 
    } catch { 
     # could differentiate exception types here 
     carp qq(Invalid Question type "$type"); 
    }; 
} 

package Question::Base; 

sub new { 
    my ($class) = @_; 

    return bless {} => $class; 
} 

package Question::Math; 
use base 'Question::Base'; # `use parent` expects to load a module 

package main; 

use Test::More tests => 2; 
use Test::Warn; 

isa_ok(Question->new('Math'), 'Question::Math'); 
warning_like(
    sub { Question->new('Dumb') }, # I hear there's no such thing 
    qr/^Invalid Question/ 
);