I have class attribute, e. g., counter of created objects in some base class,
package A;
our $counter = Counter->new; # not just a counter in fact, so initialization code should be inherited by descendants as well
sub new {
$counter++;
bless {}
}
sub get_counter {
$counter
}
package B;
use base 'A';
package main;
B->get_counter();
I want package B to have his own copy of this class attribute (e. g., counting objects of B class only), and all inherited methods from package A should deal with this copy. What is the correct way to implement this in plain perl and in Moo/Moose? Seems like MooX::ClassAttribute can not be inherited.
One ugly solution found is to repeat attribute initialization code in each descendant and use symbolic dereference like ${"${class}::counter"} in ancestor's methods to access this attribute with actual package name. But seems like there should be more elegant way.
The default Perl object model has no concept of class attributes. And there's no kind of hook like “when a new subclass is created, run this code”.
Instead, the base class could maintain a hash of counters, using the class name as keys:
package A;
my %counters;
sub new {
my ($class) = #_;
my $counter = $counters{$class} //= Counter->new;
$counter++;
return bless {} => $class;
}
sub get_counter {
my ($self_or_class) = #_;
my $class = (ref $self_or_class) || $self_or_class;
$counters{$class};
}
package B;
use parent -norequire, 'A';
This will create a new counter when an instance of a subclass is created. Note that the first argument to a method is either the class name or the object instance. We need to use that in new() as the hash key. In get_counter() I've written this in a way that the method can be called on both a class and an object to the same effect.
A similar technique is known as inside-out objects, where store object fields in a hash held by the class, so that the object itself doesn't contain any data.
(Why parent instead of base? The parent module only does inheritance, whereas base also integrates with the fields pragma which you should not use.)
Related
I'm aware that Perl is not statically typed when I want to apply this mechanism to a Perl object of a derived class:
Say I have a base class B and a derived class D inheriting from B.
Also I have an object $obj that holds a D object.
A function Bf() is expecting a parameter of type B.
Obviously (by the rules of polymorphism) I can pass $obj to Bf() like Bf($obj), but unlike to a static-typed language Bf() will see the whole D object (and not just the elements of B).
Is there a (rather clean and simple) solution for this problem in Perl? The solution should "hide" the attributes (and methods) a B does not have from D in Bf(), not restricting modifications of the original B (which is D actually).
Adult Programmers only (added 2020-03-06)
OK, people wanted a more concrete description.
Unfortunately (as pointed out) the original program is highly complex and uses reflection-like mechanisms to generate getters, setters and formatters automatically, to I really can't give a minimum working example here, because it would not be minimal.
First I have a class MessageHandler that handle messages (no surprise!).
Then I have a function log_message($$$) that expects (among others) a MessageHandler object as first argument.
Then I have this hierarchy of classes (it's much more complex in reality):
MessageHandler
ControlMessageHandler (ISA: MessageHandler)
ControlMessageResponseHandler (ISA: ControlMessageHandler)
Now if log_message wants a MessageHandler I can pass a ControlMessageResponseHandler as it conforms to MessageHandler.
But doing so exposes all the attributes of ControlMessageResponseHandler to log_message that are non-existent in MessageHandler.
The danger is that log_message might (by mistake) access an attribute of ControlMessageResponseHandler that is not present in MessageHandler. To prevent errors I'd like to prevent that, or at least get some warning (like I would get in a statically-typed language as Eiffel).
Dirty Details inside
Just in case it matters, I'll sketch how my array objects are built (a lot of extra code would be needed for a working example):
First the array indices are allocated automatically like this:
use constant I_VERBOSITY => IS_NEXT->(); # verbosity level
use constant I_TAG => IS_NEXT->(); # additional tag
use constant I_TAG_STACK => IS_NEXT->(); # tag stack
use constant I_MSG_DEBUG => IS_NEXT->(); # handler for debug messages
...
use constant I_LAST => IS_LAST->(); # last index (must be last)
I_LAST is needed for inheritance.
The attributes are defines like this:
use constant ATTRIBUTES => (
['verbosity', I_VERBOSITY, undef],
['tag', I_TAG, \&Class::_format_string],
['tag_stack', I_TAG_STACK, undef],
['msg_debug', I_MSG_DEBUG, \&Class::_format_code],
...
);
The definition contains a hint how to format each attribute.
This information is used to set up formatters to format each attribute like this:
use constant FORMATTERS =>
(map { Class::_attribute_string($_->[0], $_->[1], undef, $_->[2]) }
ATTRIBUTES); # attribute formatters
Getters and setters are automatically defined like this:
BEGIN {
foreach (ATTRIBUTES) {
Class::_assign_gs_ai(__PACKAGE__, $_->[0], $_->[1]);
}
}
The constructor would use the following lines:
my $self = [];
$#$self = I_LAST;
$self->[I_VERBOSITY] = $verbosity;
...
And finally my object print routine goes like this:
sub as_string($)
{
my $self = shift;
my $a_sep = ', ';
return join($a_sep, map { $_->($self, $a_sep) } FORMATTERS);
}
With inheritance it looks like this:
sub as_string($)
{
my $self = shift;
my $a_sep = ', ';
return join($a_sep, $self->SUPER::as_string(),
map { $_->($self, $a_sep) } FORMATTERS);
}
I'm not sure what your problem is, although I think you took the long way to say "I have a function that expects a B object, and I want to pass it a D object."
If you only want objects of a certain exact type, don't accept anything else:
use Carp qw(croak);
sub Bf {
croak "Bad object! I only like B" unless ref $_[0] eq 'B';
...
}
But, that's a bad idea. A derived class should be just as good as the base class. The clean solution is to not care what type you get.
sub Bf {
croak "Bad object! Doesn't respond to foo!" unless $_[0]->can('foo');
...
}
Since this Bf method works with the base class, why would it look for something in some derived class it didn't know about? If the derived class has changed the interface and no longer acts like its parent, then maybe it's isn't a good fit for inheritance. There are many problems like this that are solved by a different architecture.
I think you'll have to come up with a concrete example where the derived class wouldn't work.
It sounds like for some reason you need your D object to behave like a B object, but at the same time not like a D object. As the existing answers and comments indicate, it's a very common to use a sub-class where the base class is expected, and most algorithms shouldn't care whether what you actually passed is D or B. The only reason I can think of why you would want otherwise is that D overrides (redefines) some methods in an incompatible way, and you want the methods from B instead.
package Dog;
sub new {
my ($class, %args) = #_;
return bless \%args, $class;
}
sub bark { print "Bark!\n"; }
package Dingo;
use parent 'Dog';
sub bark { print "...\n"; }
package main;
my $dingo = Dingo->new;
$dingo->bark; # "..."
(n.b., I've left off the recommended use strict; and use warnings; for terseness, they should be used in all packages)
You may be aware from reading perldoc perlootut and perldoc perlobj that an object in Perl is just a blessed reference of some sort; in the example above, we use a hash reference. If you are trying to get the "attributes" that only exist in B, I think you would have to write some sort of translation method. But, if you care about the methods that exist in B, all you have to do is re-bless it into the parent class.
my $dingo = Dingo->new;
$dingo->bark; # "..."
bless $dingo, "Dog";
$dingo->bark; # "Bark!"
Note that bless does not return a new reference, but modifies that reference in-place; if you want it to behave like a Dingo again, you have to bless it back.
Perhaps more conveniently you can define a method to create a copy for you and bless it into the appropriate class:
package Dog;
sub as_dog {
my ($self) = #_;
# The {} below create a shallow copy, i.e., a new reference
return bless { %{$self} }, __PACKAGE__;
}
#...
package main;
my $dingo = Dingo->new;
$dingo->bark; # ...
$dingo->as_dog->bark; # Bark!
$dingo->bark; # ...
While there doesn't seem to be a perfect solution, temporary "re-blessing" the object seems to get quite close to what is asked for:
sub Bf($) # expects a "B" object (or descendant of "B" (like "D"))
{
my $B = shift;
my $type = ref($B); # save original type
die "unexpected type $type" unless ($B->isa('B'));
bless $B, 'B'; # restrict to "B"'s features
$B->whatever(...);
#...
bless $B, $type; # restore original type
}
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).
I have a question related to multi-level inheritance in Perl.
Here is my code
mod.pm
package first;
sub disp {
print "INSIDE FIRST\n";
}
package second;
#ISA = qw(first);
sub disp {
print "INSIDE SECOND\n";
}
package third;
#ISA = qw(second);
sub new {
$class = shift;
$ref = {};
bless $ref, $class;
return $ref;
}
sub show {
$self = shift;
print "INSIDE THIRD\n";
}
1;
prog.pl
use mod;
$obj = third->new();
$obj->show();
$obj->disp();
I have a .pm file which contains three classes. I want to access the disp method in the first class using an object of third class. I'm not sure how that could work.
I tried to access using two ways:
using class name => first::disp()
using SUPER inside second package disp method => $self->SUPER::disp();
But am not sure how it will be accessed directly using the object of third class.
$obj->first::disp(), but what you are asking to do is something you absolutely shouldn't do. Fix your design.
If you need to do that, then you have defined your classes wrongly.
The third class inherits from the second class. second has it's own definition of disp, so it never tries to inherit that method from its superclass first. That means third gets the implementation defined in second
The simple answer would be to call first::disp something else. That way second won't have a definition of the method and inheritance will be invoked again
If you explain the underlying problem, and why you want to ignore an inherited method, then perhaps we can help you find a better way
Please also note that packages and module files should start with a capital letter, and each class is ordinarily in a file of its own, so you would usually use package First in First.pm etc.
This question is about the SUPER class.
When would an "overridden method" happens?
So say when I instantiate a class:
$object = Classname -> new (some => 'values');
Is that what you call an overridden method? the new method's overridden values?
If so then, why would I want to use that SUPER class?
I can just say:
$object = Classname -> new ();
I have the original method again. Can someone clarify this for me?
Inheritance describes a parent-child relationship. Everything the parents can do, the child class can too. E.g.
ParentA ParentB
======= =======
foo() foo()
------- bar()
| -------
| /
Child
=====
This UML diagram shows that Child inherits from ParentA and ParentB, e.g. via the code
package Child;
use parent "ParentA";
use parent "ParentB"
Now, Child has inherited the method foo from ParentA and bar from ParentB.
If Child defines a foo method itself, Child->foo would call this method, and not one of the methods of the parent classes. It is then said that the foo method is overridden.
Example
When subclassing, it is often useful to re-use the constructor of the parent. But sometimes, additional processing has to be done. In this case, a subclass wants to provide a different default argument:
Horse.pm
package Horse;
use strict; use warnings;
sub new {
my ($class, %args) = #_;
return bless {
legs => 4,
saddled => 0,
%args,
} => $class;
}
1;
SaddledHorse.pm
package SaddledHorse;
use strict; use warnings;
use parent 'Horse';
# This override the inherited “new”
sub new {
my ($class, %args) = #_;
# the “SUPER” pseudo-package points to the parent
return $class->SUPER::new(%args, saddled => 1);
}
1;
Note how the $class is propagated to bless the reference into the correct class. The SUPER package is only available inside a package that defines an inheritance relationship, and is arguably broken. If you need SUPER, you usually want to use Moose, where a method that is explicitly said to override can call the super method with the super function.
Edit: A note on fully qualifed method names
If you call a method on a package/object, the correct method is resolved at runtime. If you look at the top of this answer to the inheritance diagram, you can see that ParentB defines bar. If we invoke the bar method on a Child, that method is looked for
in Child,
in ParentA, and
in ParentB, where it is found.
This is called “method resolution”, and is a tricky issue in itself.
If we pass a fully qualifed subroutine name as the method, no resolving happens, and the sub is called directly. E.g. Child->foo would resolve the method to ParentA::foo, so that call would be roughly equal to ParentA::foo("Child"). If hower we do
Child->ParentB::foo();
we get the effect of ParentB::foo("Child"). The syntax with the -> is superfluous, but reminds us that we are kind of using a method on an object. Therefore, I preferred to write
$class->SUPER::new(%args, saddled => 1)
in the SaddledHorse example, even if this is only elaborate syntax for
# SUPER::new($class, %args, saddled => 1) # pseudocode, won't actually run
which resolves to
Horse::new($class, %args, saddled => 1)
Do you have more context? It's probably referring to a method overridden in a subclass.
e.g.
use feature 'say';
package A;
sub foo {
say "A";
}
package B;
use base 'A';
# this is overriding 'foo' in A.
sub foo {
my $class = shift;
$class->SUPER::foo(); # calls A->foo(), but this is optional
say "B";
}
B->foo(); # prints "A" then "B"
The calling of SUPER::foo is optional - the method can just override foo and replace it's behaviour or augment it, either by doing work before SUPER::foo or after.
More modern OO perl, (e.g. using Moose, Moo, etc) makes this more readable - with calls to features such as 'override', 'before', 'after', 'around' etc to alter inherited methods
I'm looking for a pattern for the following. (I'm working in Perl, but I don't think the language matters particularly).
With a parent class Foo, and children Bar, Baz, Bazza.
One of the methods for constructing a Foo is by parsing a string, and part of that string will implicitly specify which class is to be created. So for example if it starts 'http:' then it's a Bar, but if it doesn't but it contains '[Date]' then Baz likes it, and so on.
Now, if Foo knows about all its children, and what string is a Bar, what is a Baz etc, it can call the appropriate constructor. But a base class should not have any knowledge about its children.
What I want is for Foo's constructor to be able to try its children in turn, until one of them says "Yes, this is mine, I'll create the thing".
I realise that in the general case this problem is not well-defined, as there may be more than one child which will accept the string, and so the order in which they are called matters: ignore this and assume that the characteristics of the string are such that only one child class will like the string.
The best I have come up with is for the child classes to 'register' with the base class on initialisation, so that it gets a list of constructors, and then loop through them. But is there a better method that I'm missing?
Sample code:
package Foo;
my #children;
sub _registerChild
{
push #children, shift();
}
sub newFromString
{
my $string = shift;
foreach (#children) {
my $object = $_->newFromString(#_) and return $object;
}
return undef;
}
package Bar;
our #ISA = ('Foo');
Foo::_registerChild(__PACKAGE__);
sub newFromString
{
my $string = shift;
if ($string =~ /^http:/i) {
return bless(...);
}
return undef;
}
Perhaps you could implement this with Module::Pluggable? This would remove the need for registration.
The approach I've taken before was to use Module::Pluggable to load my child modules (this allowed me to add new child modules by simply writing and installing them). Each of the child classes would have a constructor that either returned a blessed object or undef. You loop over your plugins until you get an object, then return it.
Something like:
package MyClass;
use Module::Pluggable;
sub new
{
my ($class, #args) = #_;
for my $plugin ($class->plugins)
{
my $object = $plugin->new(#args);
return $object if $object;
}
}
There's Class:Factory as well but that may be a little over the top for your needs.
It seems you're trying to have a single class be both a base class and a factory. Don't. Use 2 separate classes. Something like this:
package Foo;
package Bar;
use base 'Foo';
package Baz;
use base 'Foo';
package Bazza;
use base 'Foo';
package Factory;
use Bar;
use Baz;
use Bazza;
sub get_foo {
my ($class, $string) = #_;
return Bar->try($string) || Baz->try($string) || Bazza->try($string);
}
And then use it like:
my $foo = Factory->get_foo($string);
This way your base class doesn't need to know about your child classes, only your factory does. And child classes don't need to know about each other either, only Factory needs to know the details of which child classes to try and in which order.
You may implement a arbitrary lookup algorithm in class Foo, that searches for existing child classes. Maybe based on config files provided with child classes, or with any other mechanism you might think of.
The class Foo will then detect the existing client classes at runtime and call them in turn.
Additionaly you may cache the lookup results and come close to the registry solution you already described yourself.
If you take your comment about the parent class not containing info about the chilidren and your method of delegating the task of establishing a child classes suitability to the class itself then it is probably correct to factor out the class selection from the parent class and create a singleton for this task.
at least that would be my preference ... from this your current parent class (which presumably has some common functionality across your child classes) can presumably then either become abstract or an interface.
the singleton could then manage the construction of all the child classes and their distribution (clone them if they are not functional?) ... moreover the child classes can be moved into a separate dll to promote separation.
sorry that is not a direct solution.
I have done this in the past by managing a list of classes in the singleton much like you are here. the idea behind the singleton is that if you do want to use any expensive reflection you only have to do it once.