Perl: Testing whether Class Exists - perl

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.

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.

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

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.

Related

Seek Perl idiom to check that $self is a class or object

In Perl, I just got bitten by something that looked like the bug below:
package Foo;
sub method {
my $self = shift;
my #args = #_;
...
}
where I called it as a subroutine, not a method:
Foo::method( "arg1", "arg2" );
rather than calling it as a method - in this case, it was a "class method":
Foo->method( "arg1", "arg2" );
Calling Foo::method("arg1","arg2") resulted in "arg1" getting dropped.
Similar considerations can arise with an "object method":
my $object = Foo->new();
$obj->method( "arg1", "arg2" );
Is there a friendly, concise, Perl idiom for checking that the first argument, conventionally called $self, is in fact an object in the class (package), and/or the class/package name?
The best I have come up with is:
package Foo;
sub method {
my $self = ($_[0]->isa(__PACKAGE__) ? shift #_ : die "...error message...";
my #args = #_;
...
}
which is not much more concise than
package Foo;
sub method {
my $self = shift;
die "...error message..." if $self->isa(__PACKAGE__);
my #args = #_;
...
}
or
package Foo;
use Carp::Assert;
sub method {
my $self = shift;
assert($self->isa(__PACKAGE__));
my #args = #_;
...
}
Notes:
I know about Perl signatures, but dislike using experimental features.
I know about use attributes and :method. Is that the best way to go? Similar concerns about "evolving" features.
I know about Moose - but I don't think that Moose enforces this. (Did I miss anything.)
The problem with Perl is that there are so many ways to do something.
The best answer is to not mix functions and methods in a single package. "Hybrid modules", as they're known, are problematic. Everything which you might want to make a function should instead be a class method call.
There should be little need to fully qualify a function call in day-to-day programming.
The most concise way is to use Moops which is the new way to use Moose with syntax-sugar.
use Moops;
class Foo {
method something() {
print("something called\n");
}
}
Foo->new->something();
Foo::something();
# something called
# Invocant $self is required at /Users/schwern/tmp/test.plx line 10.
Moops is marked as unstable, but that's the interface, not the signatures themselves. Signatures have been around and usable in production for a long time, longer than they've been built in. More worrying is there hasn't been a release in over a year, however the author writes good stuff. Your call.
Otherwise, like with anything else, write a function.
use Carp;
use Scalar::Util qw(blessed);
sub check_invocant {
my $thing = shift;
my $caller = caller;
if( !defined $thing ) {
croak "The invocant is not defined";
}
elsif( !ref $thing ) {
croak "The invocant is not a reference";
}
elsif( !blessed $thing ) {
croak "The invocant is not an object";
}
elsif( !$thing->isa($caller) ) {
croak "The invocant is not a subclass of $caller";
}
return $thing;
}
Since this returns the invocant and handles the exception for you it can be used very concisely.
package Foo;
sub method {
my $self = ::check_invocant(shift);
...
}
I'll add to what Schwern has written to say that you could also take a look at Safe::Isa, which lets you safely call isa on something which you cannot be sure is an object.
I'm going to try to follow the advice of #Schwern and "not mix functions and methods in a single package". That said, here's an example using the fun method approach from Function::Parameters. The example is of course contrived and a bit awkward, but it illustrates the idea.
Function::Parameters requires a compiler version of at least perl5.14. It's still perl (and XS) so it will not magically make your code "strongly typed". But, with attributes and type constraints via Type::Tiny, you can separate your methods and functions by more than name only. Even just using different names for different types of subroutines - fun and method by default - can be really helpful.
Using the ':strict' keyword and/or default function/method "types" (fun => { ... } and method => { ... } below, as well as others such as method_lax) obviates the need for passing values to settings when the module is imported, so the code below can be made shorter.
use v5.22;
package My::Package {
use DDP;
use attributes 'get';
use Function::Parameters {
fun => { strict => 1, } ,
method => { strict => 1,
invocant => 1,
shift => '$class',
attributes => ':method',} ,
} ;
fun func_test ( # ) {
warn "must be called as a function"
if $_[0] eq __PACKAGE__ && get(__SUB__) ne "method";
print "args = ", np #_ ;
}
method meth_test ( # ) {
warn "must be called as a method"
unless $class eq __PACKAGE__ && get(__SUB__) eq "method";
say "\$class = $class" if length $class ;
say "args = ", np #_ ;
}
}
say "\nCalling meth_test as method:";
My::Package->meth_test( ["foo", "bar"] );
say "\nCalling meth_test as function:";
My::Package::meth_test( ["foo", "bar"] );
say "\nCalling func_test as a function:";
My::Package::func_test( qw/baz fuz/ );
say "\nCalling func_test as a method:";
My::Package->func_test( qw/baz fuz/ );
Output:
Calling meth_test as method:
$class = My::Package
args = [
[0] [
[0] "foo",
[1] "bar"
]
]
Calling meth_test as function:
must be called as a method at FunctionParameters-PackageCheck-SO.pl line 24.
$class = ARRAY(0x801cfa330)
args = []
Calling func_test as a function:
args = [
[0] "baz",
[1] "fuz"
]
Calling func_test as a method:
must be called as a function at FunctionParameters-PackageCheck-SO.pl line 17.
args = [
[0] "My::Package",
[1] "baz",
[2] "fuz"
]

Multiple data members in a perl class

I am new to perl and still learning oop in perl. I usually code in C, C++. It is required to bless an object to notify perl to search for methods in that package first. That's what bless does. And then every function call made with help of -> passes the instance itself as first parameter. Now I have a doubt in writing the constructor for a new object. Normally a constructor would normally look like:
sub new {
my %hash = {};
return bless {%hash}; #will automatically take this package as the class
}
Now I want to have two data members in my class so I can do something like this:
sub new {
my %hash = {};
$hash->{"table_header"} = shift #_; #add element to hash
$hash->{"body_content"} = shift #_;
return bless {%hash}; #will automatically take this package as the class
}
My question is that is this the only possible way. Can't we have multiple data members like in C and C++ and we do have to use strings like "table_header" and "body_content".
EDIT:
In C or C++ we can directly reference the data member(assume its public for now). Here there is one extra reference which has to be made. I wanted to know if there is any way we can have a C like object.
sub new {
my $table_header = shift #_;
my $body_content = shift #_;
#bless somehow
}
Hope this clears some confusion.
There are modules that make OOP in Perl easier. The most important is Moose:
use strict; use warnings;
package SomeObject;
use Moose; # this is now a Moose class
# declare some members. Note that everything is "public"
has table_header => (
is => 'ro', # read-only access
);
has body_content => (
is => 'rw', # read-write access
);
# a "new" method is autogenerated
# some method that uses these fields.
# Note that the members can only be accessed via methods.
# This guards against typos that can't be easily caught with hashes.
sub display {
my ($self) = #_;
my $underline = "=" x (length $self->table_header);
return $self->table_header . "\n" . $underline . "\n\n" . $self->body_content . "\n";
}
package main;
# the "new" takes keyword arguments
my $instance = SomeObject->new(
table_header => "This is a header",
body_content => "Some body content",
);
$instance->body_content("Different content"); # set a member
print $instance->display;
# This is a header
# ================
#
# Different content
If you get to know Moose, you will find an object system that is far more flexible than that in Java or C++, as it takes ideas from Perl6 and the Common Lisp Object System. Of course, this is fairly ugly, but it works well in practice.
Because of the way Perl OOP works, it isn't possible to have the instance members accessible as variables on their own. Well, almost. There is the experimental mop module which does exactly that.
use strict; use warnings;
use mop;
class SomeObject {
# Instance variables start with $!..., and behave like ordinary variables
# If you make them externally accessible with "is ro" or "is rw", then
# appropriate accessor methods are additionally generated.
# a private member with public read-only accessor,
# which has to be initialized in the constructor.
has $!table_header is ro = die 'Please specify a "table_header"!';
# a private member with public read-write accessor,
# which is optional.
has $!body_content is rw = "";
# new is autogenerated, as in Moose
method display() {
# arguments are handled automatically, so we could also do $self->table_header.
my $underline = "=" x (length $!table_header);
return "$!table_header\n$underline\n\n$!body_content\n";
}
}
# as seen in Moose
my $instance = SomeObject->new(
table_header => "This is a header",
body_content => "Some body content",
);
$instance->body_content("Different content"); # set a member, as in Moose
print $instance->display;
# This is a header
# ================
#
# Different content
Although it has pretty syntax, don't use mop right now for serious projects and stick to Moose instead. If Moose is too heavyweight for you, then you might enjoy lighter alternatives like Mouse or Moo (these three object systems are mostly compatible with each other).
You are getting confused between hashes and hash references. You are also forgetting that the first parameter to any method is the object reference or the name of the package. Perl constructors are inherited like any other method, so you must bless the new object into the correct package for polymorphism to work properly. This code is what you intended
sub new {
my $package = shift;
my %self;
$self{table_header} = shift;
$self{body_content} = shift;
bless \%self, $package;
}
I am not clear what you mean by “directly reference the data member”, but if you hoped that you could avoid writing $self everywhere so that every variable was implicitly an element of the hash then you cannot. Perl is far more flexible than most languages, and can use any blessed reference as an object instance. It is most common to use a hash, but occasionally a reference to an array, a scalar, or even a file handle is more appropriate. The cost of this flexibility is specifying exactly when you are referring to a member of the blessed hash. I don't see that it's too great a burden.
You can always write your code more concisely. The method above can be written
sub new {
my $package = shift;
my %self;
#self{qw/ table_header body_content /} = #_;
bless \%self, $package;
}

Is it possible to get all valid methods for a particular Perl class?

Is it possible to get all valid methods for a particular Perl class?
I am trying to manipulate the symbol table of a class and get all of its methods. I found I can separate out the subroutines from the non-subroutines via the $obj->can($method), but that doesn't do exactly what I think it does.
The following returns:
subroutine, Property, croak, Group, confess, carp, File
However, subroutine isn't a method, (just a subroutine), and croak, confess, and carp were all imported into my package.
What I really want to print out is:
Property,Group, File
But I'll take:
subroutine, Property,Group, File
Below is my program:
#! /usr/bin/env perl
use strict;
use warnings;
use feature qw(say);
my $sections = Section_group->new;
say join ", ", $sections->Sections;
package Section_group;
use Carp;
sub new {
return bless {}, shift;
}
sub Add {
my $self = shift;
my $section = shift;
}
sub Sections {
my $self = shift;
my #sections;
for my $symbol ( keys %Section_group:: ) {
next if $symbol eq "new"; # This is a constructor
next if $symbol eq "Add"; # Not interested in this method
next if $symbol eq "Sections"; # This is it's own method
push #sections, $symbol if $self->can($symbol);
}
return wantarray ? #sections : \#sections;
}
sub subroutine {
my $param1 = shift;
my $param2 = shift;
}
sub Group {
my $self = shift;
my $section = shift;
}
sub File {
my $self = shift;
my $section = shift;
}
sub Property {
my $self = shift;
my $section = shift;
}
This is fairly trivial. We only want to keep those sub names that were originally defined in our package. Every CV (code value) has a pointer to the package where it was defined. Thanks to B, we can examine that:
use B ();
...
if (my $coderef = $self->can($symbol)) {
my $cv = B::svref_2object $coderef;
push #sections, $symbol if $cv->STASH->NAME eq __PACKAGE__;
}
# Output as wanted
That is, we perform introspection using svref_2object. This returns a Perl object representing an internal perl data structure.
If we look into a coderef, we get a B::CV object, which represents the internal CV. The STASH field in a CV points to the Stash where it was defined. As you know, a Stash is just a special hash (internally represented as a HV), so $cv->STASH returns a B::HV. The NAME field of a HV contains the fully qualified package name of the Stash if the HV is a Stash, and not a regular hash.
Now we have all the info we need, and can compare the wanted package name to the name of the stash of the coderef.
Of course, this is simplified, and you will want to recurse through #ISA for general classes.
Nobody likes polluted namespaces. Thankfully, there are modules that remove foreign symbols from the Stash, e.g. namespace::clean. This is no problem when the CVs of all subs you are calling are known at compile time.
What are you trying to do? Why does it matter how a class defined or implements a method it responds to?
Perl is a dynamic language, so that means that methods don't have to exist at all. With AUTOLOAD, a method might be perfectly fine and callable, but never show up in the symbol table. A good interface would make can work in those cases, but there might be cases where a class or an object decides to respond to that with false.
The Package::Stash module can help you find defined subroutines in a particular namespace, but as you say, they might not be defined in the same file. The methods in a class might come from an inherited class. If you care about where they come from, you're probably doing it wrong.

Perl create class object by using variable as class name

Is this possible using Perl:
my #array = ($class1,$class2,$class3);
foreach my $c (#array)
{
my $temp = $c->new();
$temp->run($var1,$var2);
}
The idea behind this is that the array will always contain different class names. I would then like to create an object of that class and run a method from it. Each class is somewhat similar but contains its own logic in the run method?
If this is not possible, is there a different way i could do this?
Is this bad programming?
You need to make sure that the run-Method is always accessible:
my #array = ($class1,$class2,$class3);
foreach my $class (#array) {
my $temp = $class->new();
if ($temp->can('run') {
$temp->run($var1,$var2);
} else {
...
}
}
What makes a class in perl is the bless statement. You bless a reference with a name of a class, and wham!, it's that class. Nothing too special about it.
Of course, you could end up with a class with no methods which might be a bit of a problem. However, I do this for subclasses where subclasses share a common parent class, but the type of the class changes the behavior of the class:
Package Main_class;
use Carp;
sub new {
my $class = shift; #We'll ignore this one
my $subclass = shift; #This is my actual class
my $self = {};
my $class .= "::$subclass";
bless $self, $class; #Now, it's my class!
if ( not $self->isa($class) ) {
croak qw(Subclass "$subclass" is an invalid subclass);
}
return $self;
}
In my program, I'll do this:
my $object = Main_class->new($subclass);
And, if I don't want my program to die...
my $object;
eval {
$object = Main_class->new($subclass);
}
if ( $# ) {
Here be dragons.... #What do you do if that object creation failed...
}
Here's an example of a program where I do this.
Here I'm reading in a file of questions and their types. I read in the macro name, and the type of question it is. I then use my parent class to create the object, but I bless it with the correct subclass. What is important is to use the isa universal method available to all classes. I test whether the object I created is actually a subclass to my class.
Previous answers cover what you are looking for, but I would probably add that Module::Runtime can be helpful if you'd rather not need to explicitly use()/require() each class' package when doing this sort of thing:
use Module::Runtime;
for my $cls (#classes) {
my $obj = use_module($cls)->new;
...
}
use strict;
use warnings;
use class1;
use class2;
use class3;
my #array = qw(class1 class2 class3);
foreach my $c (#array)
{
my ($var1, $var2) = (12,34);
my $temp = eval { $c->new };
$temp->run($var1,$var2);
}
untested but this is the sort of things you should be investigating. You do need to 'use' any class you are using and always use strict to save yourself hours future problems

What is the default parameter for AUTOLOAD in Perl?

I've been playing with AUTOLOAD to create my accessors in Perl and I have encountered this confusion (I have searched google and perldoc already).
I have this code:
package Class;
sub new {
..code for constructor here.
}
sub AUTOLOAD {
my $name= shift;
print $name;
}
But when I do something like : my $a=Class->new; The autoload subroutine still executes, and prints Class=HASH(some weird number);
I thought AUTOLOAD only runs when there is an undefined method or subroutine?
And also I did this:
my $class = our $AUTOLOAD;
print $class #prints ::DESTROY
Am I right when I assumed that DESTROY is the value of $AUTOLOAD when no undefined function is passed?
Using Autoload is inherently difficult. If you want a solid object system that makes accessors for you then please use Moose, Mouse, Moo, or just loop over your fields and install the accessors yourself:
BEGIN {
my #fields = qw/foo bar baz/;
for my $field (#fields) {
no strict 'refs';
# install a closure in the package stash.
*{ __PACKAGE__ . "::" . $field } = sub {
my $self = shift;
$self->{$field} = shift if #_;
return $self->{$field};
};
}
}
If a class that can AUTOLOAD encounters an undefined method, the AUTOLOAD sub is called with the arguments of the missing sub. The fully qualified name of the requested sub is passed in the $AUTOLOAD package variable.
A typical Autoload sub would look like:
use Carp;
my %fields_allowed = map {$_ => 1} qw/foo bar baz/;
sub AUTOLOAD {
my $field = our $AUTOLOAD;
$field =~ s/.*:://; # strip the package name
$fields_allowed{$field}
or croak qq(Can't locate object method $field via package "#{[__PACKAGE__]}");
my $self = shift;
$self->{$field} = shift if #_;
return $self->{$field};
}
There remain two problems:
When the reference count of an object drops to zero, or when a thread terminates, the DESTROY method is called on the object if it provides one. We can prevent autoloading of DESTROY by providing an empty implementation: sub DESTROY {}.
We can ask any object if it can perform a certain method, like say "Good dog" if $dog->can("roll"). Therefore, we have to override can to support our autoloading. The can method is useful for safe duck typing. Every object inherits from UNIVERSAL, which provides default implementations for can and isa.
The contract of can is that it takes the name of a method. It will return undef when the object cannot perform the method, or a code reference to that method if it can. A suitable implementation would be
sub can {
my ($self, $name) = #_;
# check if it's a field of ours
if ($fields_allowed{$name}) {
return sub {
my $self = shift;
$self->{$name} = shift if #_;
return $self->{$name};
};
}
# Ask SUPER implementation of can if we can do $name
if (my $meth = $self->SUPER::can($name)) {
return $meth;
}
return; # no method found
}
We can now simplify AUTOLOAD to
sub AUTOLOAD {
my $field = our $AUTOLOAD;
$field =~ s/.*:://; # strip the package name
my $code = $self->can($field)
or croak qq(Can't locate object method $field via package "#{[__PACKAGE__]}");
goto &$code; # tail call; invisible via `caller()`.
}
This is a lot of complexity to get right. Verdict: Don't use Autoload because you think it might be less work. It never is. It is quite useful for implementing a proxy pattern, but that is a bit advanced.
I urge you to dabble around with OO basics, and the Moose object system, before diving deep into Perl's unique and strange features.