I have been working with OO Perl. I have base class, which is legacy code and I can't change it. I am writing a derived class with a new style (my convenient style too) but when I am deriving it I am getting an error as
Attempt to bless into a reference
My code is similar to the below code:
package Base ;
sub new {
my ($class, %args) = #_;
my $self = {};
$self->{top} = $args{top};
return bless $self, $class;
}
1;
The Derived class:
package derived;
use base qw{Base};
use fields qw{_bot};
sub new {
my __PACKAGE__ $this = shift;
my %arg = #_;
unless (ref $this) {
$this = fields::new($this);
}
$this->Base::new( %arg);
return $this;
}
1;
The caller is
use File::Basename;
BEGIN {
my $root_dir = dirname $0;
push(#INC, $root_dir);
}
use derived;
my $d = new derived(top=>"t1");
I am getting error as
Attempt to bless into a reference at Base.pm line 8.
Related
I have a series of modules that perform output functions for my scripts. Sometimes the module is called directly -- it is called View -- and sometimes a child class that extends it is used instead (View::ChildName). View declares our $THEMENAME = 'default'; when it is loaded, but the child declares its own specific $THEMENAME when it loads.
Problem: When new() is called on a child theme, it calls my $self = $class->next::method(%params); (using mro) to get some core things set by the parent class before extending it. One of the core bits is that the parent class sets $self->{'themeName'}. However, if it simply calls $THEMENAME, it gets the parent's setting: "default."
The only way I've reliably and successfully solved this is to turn off strict temporarily and do this:
my $packName = ref $self;
{
no strict;
$self->{'themeName'} = ${${packName} . "::THEMENAME"};
}
This works, but in profiling the code, if objects are created frequently, this actually adds more overhead than I expected. I tried the alternative of always using the parent's package name, e.g. the child sets $View::THEMENAME. This works, but only if the theme name is set within new and not on the load of the module; if it is on load, there is erratic behavior if several different child objects (of different children) are created over the course of the script.
These options both seem less than ideal. Is there a good way to do this? The only thing I found was this old question and I think incorporating Moo would probably add more overhead than I'm trying to avoid by getting rid of my current no strict block. Has anything been added to more modern versions of Perl that might solve my issue?
The alternative is to dodge the issue all together and simply set $self->{'themeName'} within each child object's new method, although I'm trying to avoid that change since there's a fair number of legacy child classes that expect $THEMENAME to exist.
Minimal reproducible example of View.pm:
use strict;
package View;
our $THEMENAME = 'default';
sub new {
my $class = shift;
my $params = shift;
my $self = { 'setting' => $params{'setting'} };
bless $self, $class;
$self->{'themeName'} = $THEMENAME;
return $self;
}
And of View/Child.pm:
use strict;
use mro;
package View::Child;
use parent 'View';
our $THEMENAME = 'child';
sub new {
my $class = shift;
my $params = shift;
my $self = $class->next::method($params);
bless $self, $class;
say STDOUT $self->{'themeName'};
# Prints 'default' not 'child'.
return $self;
}
Now a script to call it:
use View::Child;
my $object = View::Child->new();
If you added the first code block to View.pm, it gives the expected result instead, but seems to add about 9 ms to each call to new -- more than the time it takes for it to handle everything else I have in the much longer full length new method -- which adds up if the program runs many iterations:
use strict;
package View;
our $THEMENAME = 'default';
sub new {
my $class = shift;
my $params = shift;
my $self = { };
bless $self, $class;
my $packName = ref $self;
{
no strict;
$self->{'themeName'} = ${${packName} . "::THEMENAME"};
}
return $self;
}
The concept of class properties is one you should forget (in Perl). It's fine for the module to have constants and possibly variables, but they shouldn't be considered part of the class.
I see four approaches you could take:
Update the property in the child's constructor.
Provide the value as a parameter
Override the accessor
Provide the default as a method
Update the property in the child's constructor
# View.pm
sub new {
my ($class, $params) = #_;
my $self = bless({}, $class);
$self->{ setting } = $params->{ setting };
$self->{ themeName } = 'default';
return $self;
}
sub themeName { $_[0]->{themeName} } # Optional
# Child/View.pm
sub new {
my ($class, $params) = #_;
my $self = $class->next::method($params);
$self->{ themeName } = 'child';
return $self;
}
Provide the value as a parameter
# View.pm
sub new {
my ($class, $params) = #_;
my $self = bless({}, $class);
$self->{ setting } = $params->{ setting };
$self->{ themeName } = $params->{ themeName } // 'default';
return $self;
}
sub themeName { $_[0]->{themeName} } # Optional
# Child/View.pm
sub new {
my ($class, $params) = #_;
my $self = $class->next::method({ themeName => 'child', %$params });
return $self;
}
Override the accessor
# View.pm
sub new {
my ($class, $params) = #_;
my $self = bless({}, $class);
$self->{ setting } = $params->{ setting };
return $self;
}
sub themeName { 'default' }
# Child/View.pm
# No need to override `new`.
sub themeName { 'child' }
Provide the default as a method
# View.pm
sub new {
my ($class, $params) = #_;
my $self = bless({}, $class);
$self->{ setting } = $params->{ setting };
$self->{ themeName } = $class->defaultThemeName;
return $self;
}
sub defaultThemeName { 'default' }
sub themeName { $_[0]->{themeName} } # Optional
# Child/View.pm
# No need to override `new`.
sub defaultThemeName { 'child' }
One potential solution would be to add THEMENAME as an overridable method.
View.pm:
use strict;
package View;
our $THEMENAME = 'default';
sub THEMENAME {return 'default'}
sub new {
my $class = shift;
my $params = shift;
my $self = { 'setting' => $params->{'setting'} };
bless $self, $class;
$self->{'themeName'} = $self->THEMENAME;
return $self;
}
View/Child.pm:
use strict;
use mro;
package View::Child;
use parent 'View';
our $THEMENAME = 'child';
sub THEMENAME {return 'child'}
sub new {
my $class = shift;
my $params = shift;
my $self = $class->next::method($params);
bless $self, $class;
say STDOUT $self->{'themeName'};
# Prints 'default' not 'child'.
#
return $self;
}
# perl -Mlib=. -MView::Child -e 'View::Child->new()'
child
My final solution follows what #plentyofcoffee and #ikegami outlined, but I wanted to see if I could come up with a way to set it automatically without each child module implementing it (keeping in mind legacy code). Assuming the child does want to set it, it passes $param{'themeName'} to the parent's constructor, which sets it to $self->{'themeName'}. If themeName is undefined, I came up with this regex in the parent class that extracts the name of the child as a fallback themeName:
unless ($self->{'themeName'}) {
state $getThemeNameRegEx = qr#^SAFARI::(.*::)+(.*?)$#;
$class =~ /$getThemeNameRegEx/;
$self->{'themeName'} = $2 // "default";
}
This sets to default if the name doesn't contain at least two levels below SAFARI, e.g. SAFARI::View is default (the parent module is in use without a child) and SAFARI::View::mysite is mysite.
In Python you can do:
class Binance(Exchange):
name = "Binance"
code = "binance"
and in the parent class have
class Exchange:
#classmethod
def get_name(cls):
return cls.name
Now Perl!
This is lovely. I want the same for my Perl objects.
package DWDESReader;
use base qw(DWConfigFileReader);
our $type = "DES";
and in the base class:
package DWConfigFileReader;
our $type = "";
sub new {
my ($class, %args) = #_;
$args{type} = $type;
return bless {%args}, $class;
}
sub getType {
my ($self) = #_;
return $self->{type};
}
But this doesn't work, i.e. only returns the empty string assigned in the base class. I didn't expect it to work but am unsure how it should be done.
I don't see why one should need it, but it's possible, if you turn off strict refs:
#!/usr/bin/perl
use warnings;
use strict;
{ package My::Base;
sub new { bless {}, shift }
our $name = 'Base';
sub get_name {
my ($self) = #_;
my $class = ref $self || $self;
do { no strict 'refs';
${ $class . '::name' }
}
}
}
{ package My::Child;
use parent -norequire => 'My::Base';
our $name = 'Child';
}
my $ch = 'My::Child'->new;
print $ch->get_name, ' ', 'My::Child'->get_name;
But usually, you would just define a class method holding the name:
{ package My::Base;
sub new { bless {}, shift }
sub name { 'Base' }
sub get_name { shift->name }
}
{ package My::Child;
use parent -norequire => 'My::Base';
sub name { 'Child' }
}
Classes don't have attributes (variables) in Perl, only methods (subs).
I recommend creating an abstract virtual class method.
package DWConfigFileReader;
use Carp qw( croak );
sub new {
my ($class, %args) = #_;
my $self = bless(\%args, $class);
return $self;
}
sub type { croak("Subclass must override \"type\"."); }
1;
package DWDESReader;
use parent 'DWConfigFileReader';
sub type { "DES" }
1;
You don't even need $self->{type} = $class->type;; just use $self->type instead of $self->{type}.
As has been suggested, Perl inherits methods (subs), not variables, but constants are actually subs, so you can do something similar like this.
package DWDESReader;
use base qw(DWConfigFileReader);
use constant TYPE => "DES";
Then, if you call $self->TYPE somewhere in the base class, you'll get "DES" if the object is actually a DWDESReader object.
I have a problem and that is when I want to initialize two objects using the $ self variable. The first object will be initialized but the second will not. Here is some code:
###Class main
use bar;
use arg;
sub new{
my $class = shift;
my $args = shift;
my $self = {};
$self->{'foo'} = $class->SUPER->new($args);
$self->{'bar'} = bar->new();
bless($self, $class);
return $self;
}
sub getFoo{
my $self = shift;
return $self->{'foo'};
}
sub getBar{
my $self = shift;
return $self->{'bar'};
}
For the function getFoo such it returns a value but for getBar the value returned is undef, why does this happen? Thanks
EDIT1
Yes, arg is class's parent and foo is a class that i want to use certain methods.
####class bar
package bar;
sub new{
my $class = shift;
my $self = {
_bar1 => shift // 0,
_bar2 => shift //0,
};
bless($self,$class);
return $self;
}
sub getBar1{
my $self = shift;
return $self->{_bar1};
}
But if I do this now in my class main
$self->{__bar}->getBar1;
The message return is : can´t call method "getBar1" on an undefined value.
You place the object in
$self->{bar}
then you call
$self->{__bar}->getBar1
Change that to
$self->{bar}->getBar1
You appear to have a number of other problems. From your description of your code, Unnamed.pm should contain something like the following: (Don't use main; that's already being used.)
package Unnamed;
use strict;
use warnings qw( all );
use foo qw( );
use bar qw( );
use parent 'arg';
sub new {
my $class = shift;
my $args = shift;
my $self = $class->SUPER::new($args);
$self->{foo} = foo->new();
$self->{bar} = bar->new();
return $self;
}
sub get_foo {
my $self = shift;
return $self->{foo};
}
sub get_bar {
my $self = shift;
return $self->{bar};
}
1;
Then, you can do
my $o = Unnamed->new();
$o->get_bar->bar_method();
This is my first time using OOP with perl. I am in the processes of refactoring a 4k line procedural program at work. It seems pretty straight forward but I am having an issue with inheritance and SUPER.
Error message:
"Can't locate object method "New" via package "Module::SUPER" at Module.pm line 10"
I have tried, use base, parent and setting #ISA but they all get the same error. I'm sure I have to be overlooking something.
(This is not code from the program I am working on. Just an example that produces the same error)
All .pm and .pl files are in the same directory in this example. In the program I am working on the main program is in bin and the modules will be in ../modules(relative to bin).
I would assume this would be all I need to make that work:
use lib "../modules";
If I am wrong in thinking that please let me know.
Parent Module
package BaseModule;
use strict;
use warnings;
sub new {
my $class = shift;
my $self = {
ARRAY => shift,
DIVIDER => ","
};
bless ($self, $class);
return $self;
}
sub array {
my $self = shift;
if(#_) { $self->{ARRAY} = shift };
return $self->{ARRAY};
}
sub divider {
my $self = shift;
if(#_) { $self->{DIVIDER} = shift };
return $self->{DIVIDER};
}
sub testSub {
my $self = shift;
print join($self->{DIVIDER}, #{ $self->{ARRAY} } );
return 1;
}
1;
Child Module
package Module;
use strict;
use warnings;
#use base qw(BaseModule);
#require BaseModule;
#our #ISA = qw(BaseModule);
use parent qw(BaseModule);
sub new {
my $class = shift;
my $self = $class->SUPER::New(#_);
$self->{STRING} = shift;
bless ($self, $class);
return $self;
}
sub string {
my $self = shift;
if(#_) { $self->{STRING} = shift };
return $self->{STRING};
}
sub testSub {
my $self = shift;
print "$self->{STRING}:\n";
$self->SUPER::testSub();
return 1;
}
1;
Do I need to bless the child class if the parent class returns an already blessed $self?
Main Script
#!/usr/bin/perl
use strict;
use warnings;
use Module;
my $module = Module->new([1, 2, 3, 4, 5], "Example");
$module->divider(" | "); # Test Changing divider;
$module->testSub();
Any help is greatly appreciated.
"Can't locate object method "New" via package "Module::SUPER" at Module.pm line 10"
You try to call BaseModule::New whis hasn't been defined (did you mean BaseModule::new? Perl is case sensitive).
Do I need to bless the child class if the parent class returns an
already blessed $self?
No, $self at that point is already blesses (you could check that by means of Scalar::Util::blessed().
There is a following class:
package MyClass;
use strict;
use warnings;
sub new
{
my $class = shift();
my $self = {
_class_member => "default"
};
bless ($self, $class);
return $self;
}
How can I set/get the value of the _class_member?
I tried the following code:
sub set_name
{
my $self = shift();
$self->_class_member = shift();
}
But I get the following error:
Can't locate object method "_class_member" via package "MyClass" ...
What am I doing wrong here?
$self is a blessed hash. Unless the you or the original author provided the method _class_member, there's no such method.
You can however, "reach in" the hash to access it:
$self->{'_class_member'} = shift;
This is not a recommended practice for instance values because it's just as easy to type:
$self->{'_vlass_member'} = shift;
without a complaint. Hence the value of accessors.