How can I set a required attribute of my base class using Class::Std? - perl

I am working with multiple different versions of Perl (all 5.8+) across different operating systems. I am unable to manage modules on various machines which has led me to use a combination of Class::Std and the base pragma to facilitate OO Perl and inheritance.
I want to set a required attribute of my base class when constructing the subclass object. Additionally, I want to do so without explicitly specifying the value within the arguments sent to my subclass since it will be the same for all objects of the given subclass.
The following code (followed by a question) illustrates this scenario:
My base class:
package Person;
use Class::Std;
# class data
my %person_title :ATTR( name => "title" );
my %person_name :ATTR( name => "name" );
1;
My subclass:
package Doctor;
use Class::Std;
# set inheritance
use base 'Person';
# class data
my %doctor_specialty :ATTR( name => "specialty" );
1;
My script (this currently fails with "Missing initializer label for Person: 'title'"):
use strict;
use warnings;
use Doctor;
my %args = (
"name" => "John Smith",
"specialty" => "Dentist",
);
Doctor->new(\%args);
When I create a Doctor object, I always want the 'title' to be 'Dr.'. How can this be accomplished?

Related

How to add an attribute to an object using the meta-object protocol?

I was trying to answer this question, and thought I could use the meta-object protocol to add attributes to a class. Here is a minimal example where I try to add an attribute test to the class Configuration after construction:
use v6;
class Configuration {
}
my $config = Configuration.new;
my $attr = Attribute.new(
:name('$.test'), # Trying to add a "test" attribute
:type(Str),
:has_accessor(1),
:package(Configuration)
);
$config.^add_attribute( $attr );
$config.^compose();
say "Current attributes: ", join ', ', $config.^attributes();
$attr.set_value( $config, "Hello" ); # <-- This fails with no such attribute '$.test'
say $config.test;
When I run this, I get:
Current attributes: $.test
P6opaque: no such attribute '$.test' on type Configuration in a Configuration when trying to bind a value
in block <unit> at ./p.p6 line 16
Attributes cannot be added after class composition time, which occurs at compile time when the closing } is reached when compiling the program. (This is the case for the P6opaque representation. It's not impossible that a representation could exist that allows this, but there's none specified at this time.)
Further to that, .^add_attribute is called on the meta-object, and for a class the attributes are per type, not per object; the code structure suggests that perhaps the expectation was per object. There's nothing that makes it impossible to have prototype object orientation (actually the MOP is designed so somebody could implement such an object system in Perl 6), but again there's nothing specified in Perl 6 itself that provides this.
Thus with the provided object system, such manipulation needs to be done at compile time, and before the closing }. That can be achieved as follows:
class Configuration {
BEGIN {
my $attr = Attribute.new(
:name('$!test'), # Trying to add a "test" attribute
:type(Str),
:has_accessor(1),
:package(Configuration)
);
Configuration.^add_attribute( $attr );
}
}
my $config = Configuration.new;
say "Current attributes: ", join ', ', $config.^attributes();
$config.^attributes[0].set_value( $config, "Hello" );
say $config.test;
This is one of the many places where Perl 6 is dynamic primarily by inviting the programmer to participate in compile time, rather than by making all things possible at runtime.
Finally, I'll note that there is a means to add attributes to an existing object, and on a per-object basis: by using does to mix a role in to it. That works by changing the type of the object along the way. There's some documentation on does here.

When and why would you use a class with no data members?

I have noticed some Perl modules use a class based structure, but don't manage any data. The class is simply used to access the methods within and nothing more.
Consider the following example:
Class.pm
package Class;
use Moose;
sub do_something {
print "Hi!\n";
}
1;
test.pl
use Class;
# Instantiate an object from the class
my $obj = Class->new();
$obj->do_something();
In this example you can see that you would first instantiate an instance of the class, then call the method from the created object.
The same end result can be achieved like so:
Module.pm
package Module;
use strict;
use warnings;
sub do_something {
print "Hi!\n";
}
1;
test.pl
use Module;
Module::do_something();
I am wondering why people write modules using the first approach, and if there is some benefit that it provides. To me it seems like it adds an extra step, because in order to use the methods, you first need to instantiate an object of the class.
I don't understand why people would program like this unless it has some benefit that I am not seeing.
One benefit is inheritance. You can subclass behavior of an existing class if it supports the -> style subroutine calls (which is a weaker statement than saying the class is object-oriented, as I said in a comment above).
package Class;
sub new { bless \__PACKAGE__,__PACKAGE__ }
sub do_something { "foo" }
sub do_something_else { 42 }
1;
package Subclass;
#Sublcass::ISA = qw(Class);
sub new { bless \__PACKAGE__,__PACKAGE__ }
sub do_something_else { 19 }
package main;
use feature 'say';
$o1 = Class->new;
$o2 = Subclass->new;
say $o1->do_something; # foo
say $o2->do_something; # foo
say $o1->do_something_else; # 42
say $o2->do_something_else; # 19
A prominent use of this technique is the UNIVERSAL class, that all blessed references implicitly subclass. The methods defined in the UNIVERSAL namespace generally take a package name as the first argument (or resolve a reference in the first argument to its package name), are return some package information. The DB class also does something like this (though the DB package also maintains plenty of state).

How to implement a class constant that is different for each subclass?

In my class hierarchy, I need a common attribute where each subclass needs to provide a different value that is constant for all objects of that class. (This attribute serves as a key to an existing hierarchy that I'm mirroring -- not the best OO design, but I need to preserve this link.)
One way to implement this is with attributes, like this:
package TypeBase;
use Moose::Role;
has type => (
is => 'ro',
isa => enum([qw(A B)]),
builder => '_type',
init_arg => nil,
required => 1,
);
1;
#####
package TypeA;
use Moose;
with 'TypeBase';
sub _type { 'A' };
1;
#####
package TypeB;
use Moose;
with 'TypeBase';
sub _type { 'B' };
1;
Is there a better way to do this? I could just have requires 'type' in the base class, which each concrete class would have to provide, except that this loses me the type constraint that I had with the attribute route.
My solution is equivalent to yours in terms of the external interface. The main difference is the use of constant to better reflect what you are doing. (Note that TYPE can still be called like a method.) Because if is using requires it should also give you a compile-time rather than runtime error if you haven't implemented TYPE in one of your classes.
package TypeBase;
use Moose::Role;
requires 'TYPE';
package TypeA;
use Moose;
with 'TypeBase';
use constant TYPE => 'A';
package TypeB;
use Moose;
with 'TypeBase';
use constant TYPE => 'B';

Perl Moose Hash traits

I have a parameter object in Moose which has attributes of file wildcards to glob
So I had a method to do this
sub getInputFileParams{
my ($self) = #_;
#the only parameters passed in are in fact the input files
return keys(%{$self->{extraParams}});
}
but then I though why not iterate the attributes as a hash?
has 'extraParams' => (
is => 'ro',
isa => 'JobParameters::Base',
default => sub { {} },
traits => ['Hash'],
handles => {
keys_extraParams => 'keys',
},
);
However that chokes as its not a hash reference. have I missed something or is using the object as a hash bad
Yes, using objects as plain hashes is bad.
You're accessing their internal state directly, which bypasses any interface that they may present and makes your class closely coupled to the internal representation of the JobParameters::Base class.
If you need to be able to get the contents of a JobParameters::Base object as a hash, then add a to_hash method to JobParameters::Base, and delegate to that method in your attribute...
This means that if later you add caching (for example!) to JobParameters::Base, and use a __cache key to store internal data, you can safely make this change by also changing the to_hash method to remove the internal data from the hash it returns.
It is fine to store an attribute as just a hash, but if you're storing a blessed hash, then don't reach into it's guts..
You've got all tools in place in your Moose class definition, you just aren't using them - try this:
return $self->keys_extraParams

Modifing inherited accessors and retaining around modifiers

I'm trying to inherit and extend a base class with a more specific child class that removes the required attribute from an accessor and specifies a lazily built default. However, when doing so, the derived class no longer wraps the around subroutine around calls to the accessor.
What am I doing wrong in my definition?
Edit: I should state that I can simply inherit the accessor without modifying it and the around modifier still works, and I'm aware I can do something like set the accessor to have a getter, then define a getter method with the name of the accessor (i.e. sub attr { my $self = shift; my $value = $self->_get_attr; return "The value of attr is '$value'"; }). I'm simply surprised the around modifier gets dumped so easily.
use strict;
use warnings;
use 5.010;
package My::Base;
use Moose;
has 'attr' => (is => 'ro', isa => 'Str', required => 1);
around 'attr' => sub {
my $orig = shift;
my $self = shift;
my $response = $self->$orig(#_);
return "The value of attr is '$response'"
};
package My::Derived;
use Moose;
extends 'My::Base';
has '+attr' => (required => 0, lazy_build => 1);
sub _build_attr {
return "default value";
}
package main;
my $base = My::Base->new(attr => 'constructor value');
say $base->attr; # "The value of attr is 'constructor value'"
my $derived = My::Derived->new();
say $derived->attr; # "default value"
Per a response from stvn for the same question on perlmonks, the issue is:
Actually, it is not removing the 'around' modifier, you are simply
creating a new accessor in your derived class, which itself is not
around-ed. Allow me to explain ...
When you create an attribute, Moose compiles the accessor methods for
you and installs them in the package in which they are defined. These
accessor methods are nothing magical (in fact, nothing in Moose is
very magical, complex yes, but magical no), and so they are inherited
by subclasses just as any other method would be.
When you "around" a method (as you are doing here) Moose will extract
the sub from the package, wrap it and replace the original with the
wrapped version. This all happens in the local package only, the
method modifiers do not know (or care) anything about inheritance.
When you change an attributes definition using the +attr form, Moose
looks up the attribute meta-object in the superclass list and then
clones that attribute meta-object, applying the changes you requested
and then installs that attributes into the local class. The result is
that all accessor methods are re-compiled into the local class,
therefore overriding the ones defined in the superclass.
It doesn't go the other way around, where the accessor is built from the bottommost class in the ISA, then the around modifiers up the ISA stack are applied in turn.