Question

我有一个名为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

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。

编辑：裸的qw（）s在其中一个较新的Perls（5.14？）中被弃用。这是一个愚蠢的弃用，但它就在那里，所以我们都必须学会将我们的qw（）foreachs包装成parens吧。

Answer 2

这是我最终做的：

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网站。

我基本上使用Darch的方法，除了我在我的超类中创建一个_real方法，我在我祝福该对象后尝试。如果它执行（这就是我真正关心的），那么这就是我的超类的子类。

这就是我真正想要的：隐藏我的超类后面的子类 - 就像File::Spec一样。我的大多数类都有相同的方法，少数有一两个额外的方法。例如，我的正则表达式问题类型有一个Pattern方法，允许我确保给出的答案与给定的模式匹配。

Answer 3

你不能让像Invalid::Class->new()之类的表达式在调用代码中抛出异常，但你可以将它包装在异常处理中并将其包装在方法中。标准模式是提供一个'type'参数，描述要为工厂方法创建的子类。一个常见的反模式是将该工厂方法放在基类上，创建循环依赖，并且必须完成比应有的更多的工作。

通常在接口类上使用工厂方法，并使其构造一个不相关的专用基类的子类，可能在失败时发出警告或抛出。在代码中，看起来非常像：

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/
);

Perl：测试是否存在类

3 个答案: