Perl: Testing whether Class Exists

Question

I have a class called Question, and a bunch of sub-classes depending on the type of question. I can create objects against the sub-classes, but I shouldn't be able to create an object of class Question itself:

#! /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...

Notice these are not modules, but merely classes I've defined to be used in my program. Thus, I can't test module loading at runtime.

When I run the above, I get:

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

Is there any way to catch for this particular error, so I can handle it myself? I know I could create an array of valid types, but I was hoping someway of being able to add new question type without having to remember to update my array.

Answer 1

AFAICT what you want to do is check the symbol table to see if your "class" (aka "package") has been defined or not. Doing it manually is no hardship, but Class::Load provides slightly more readable sugar and applies "heuristics" - whatever that means. If you don't want to use this module then the source code for is_class_loaded will lead you to whatever answer you're actually seeking.

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

} 

Your variable name ("class_type") was weird, so I fixed it. I also don't know whether Module::Load is better, but we use Class::Load for this at work.

Edit: bare qw()s are deprecated in one of the newer Perls (5.14?). It's a stupid deprecation, but it's there, so we all have to learn to wrap our qw() foreachs in parens now.

Answer 2

Here's what I finally did:

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;
}

Now, I'm setting my question like this:

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 use of the Try::Tiny is nice. It looks way better than wrapping everything in an eval. Unfortunately, it's not a standard module. This program is going on almost 100 separate systems, and using CPAN modules is too difficult. This is especially true since these systems are behind a firewall and can't access the CPAN website.

I basically use Darch's method except I create a _real method in my super-class that I try after I bless the object. If it executes (that's all I really care), then this is a sub-class of my super-class.

This does what I really want: Hide my sub-classes behind my superclass -- much like File::Spec does. Most of my classes have the same methods, and a few have one or two extra methods. For example, my Regex question type has a Pattern method that allows me to make sure the answer given matches a given pattern.

Answer 3

You can't have an expression like Invalid::Class->new() not throw an exception in the calling code, but you can wrap it in exception handling and wrap that inside a method. The standard pattern is to supply a 'type' argument describing the subclass you which to create to a factory method. A common anti-pattern is to put that factory method on the base class, creating a circular dependency and having to do more work than should be required.

It is usual to have the factory method on the interface class and to have it construct sub-classes of an unrelated, dedicated base class, possibly warning or throwing when it fails. In code, that looks pretty much like so:

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