I have the following code :-
package A;
sub new{
//constructor for A
}
sub hello{
print "Hello A";
}
1;
package B;
use base qw(A);
sub hello{
print "Hello B";
}
1;
My question is how can I instantiate B i.e. my $b = B->new(), without giving a constructor to B, what changes do I need to do in A to achieve this. Is this possible ?
Thanks.
Yes. Use this as A's new method:
sub new {
my ($cls, #args) = #_;
# ...
my $obj = ...; # populate this
bless $obj, $cls;
}
The key is that when using B->new, the first argument is B (which I bound to $cls in my example). So if you call bless using $cls, the object will be blessed with the correct package.
In line with Chris' answer, your code should now look like:
package A;
sub new{
my ( $class ) = #_;
my $self = {};
bless $self, $class;
}
sub hello{
print "Hello A";
}
package B;
use base qw(A);
sub hello{
print "Hello B";
}
package main;
my $b = B->new;
$b->hello;
B simply inherits A's constructor.
Related
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();
I am experimenting with something I like to do in Perl but I am getting a strange output and I can't figure out why.
Basically I have 2 classes. A is the base and B inherits from A.
I issue prints to the screen to track the program and result. On the last stage I am trying to cast A Type to B Type and to use a function declared in B.
For some reason this whole program runs twice - the output is duplicated - though i run the program once.
Is this a real issue? and why does it happen?
I am pasting here my code and output.
The file name is A.pm;
Running command: 'perl A.pm'
package A;
sub new
{
my ($class) = shift;
my $self = {};
bless $self, $class;
}
sub P
{
my $self = shift;
print "P:A\n";
}
sub PA
{
my $self=shift;
print "PA:A\n";
}
1;
###############################
package B;
use base 'A';
sub new
{
my ($class) = shift;
my $self = {};
bless $self, $class;
}
sub P
{
my $self=shift;
print "P:B\n";
}
sub PB
{
my $self=shift;
print "PB:B\n";
}
1;
###############################
package main;
$o = B->new;
$o->P();
$o->PA();
$o->PB();
$o = A->new;
$o->P();
$o->PA();
print "Casting\n";
bless $o , 'B';
$o->PB();
print "End\n";
Output:
[#~]perl A.pm
P:B
PA:A
PB:B
P:A
PA:A
Casting
PB:B
End
P:B
PA:A
PB:B
P:A
PA:A
Casting
PB:B
End
Instead of the deprecated base, do use parent -norequire => 'A';
One of the defects of base that caused it to be superseded by parent is that there's no good way to tell it not to try loading the base class module.
I have a situation where in child class, I need a reference of subroutines defined in parent class which I need to pass to some other class which would execute them.
So I was wrote following sample modules for testing the same.
Parent1.pm
package Parent1;
sub new {
my ($class, $arg_hash) = #_;
my $self = bless $arg_hash, $class;
return $self;
}
sub printHello{
print "Hello\n";
}
sub printNasty{
print "Nasty\n";
}
1;
Child1.pm
package Child1;
use base Parent1;
sub new {
my ($class, $arg_hash) = #_;
my $self = bless $arg_hash, $class;
return $self;
}
sub testFunctionReferences{
my ($self) = #_;
# Case 1: Below 2 lines of code doesn't work and produces error message "Not a CODE reference at Child1.pm line 18."
#my $parent_hello_reference = \&$self->SUPER::printHello;
#&$parent_hello_reference();
# Case 2: Out of below 2 lines of code, 1st line executes the function and produces output of "Hello\n" but 2nd line doesn't work and produces error message "Not a CODE reference at Child1.pm line 23."
#my $parent_hello_reference2 = \$self->SUPER::printHello;
#&$parent_hello_reference2();
# Case 3: does not work either. Says "Undefined subroutine &Child1::printNasty called at Child1.pm line 27"
#my $parent_nasty_reference = \&printNasty;
#&$parent_nasty_reference();
# Case 4: works. prints "World\n" as expected
#my $my_own_function_reference = \&printWorld;
#&$my_own_function_reference();
# Case 5: works. prints "Hello\n" and "Nasty\n" as expected
#$self->printHello();
#$self->SUPER::printNasty();
# Case 6: does not work produces error "Undefined subroutine &Child1::printHello called at Child1.pm line 38"
#printHello();
return;
}
sub printWorld{
print "World\n";
}
test.pl
#!/usr/bin/perl
use Child1;
my $child = Child1->new({});
$child->testFunctionReferences();
So my questions are:
As in case 1, what is the correct syntax to get a reference to parent subroutine?
When I use inheritance, how can I call the parent function directly as in case 6? Is it even possible in perl?
When case 5 works then why not case 6?
Any insights are appreciated. Thanks
If printHello is a subroutine, use
my $sub = \&Parent::printHello;
If printHello is a method, use
# This line must appear inside of the Child package.
my $sub = sub { $self->SUPER::method(#_) };
If you want a code reference, you need a subroutine to reference, and this creates one.
In both cases, you can call the sub using
&$sub();
or
$sub->();
(I find the latter cleaner, but they are otherwise equivalent.)
I figured out another method to get a reference to a parent class subroutine using 'UNIVERSAL' module 'can' method.
#Parent.pm
package Parent;
sub new {
my ($class, $arg_hash) = #_;
my $self = bless $arg_hash, $class;
return $self;
}
sub printHello{
print "Parent Hello Called\n";
}
1;
#Child.pm
package Child;
use base Parent;
sub new {
my ($class, $arg_hash) = #_;
my $self = bless $arg_hash, $class;
return $self;
}
sub getParentSubReference{
my ($self) = #_;
return $self->can('printHello');
}
1;
#test.pl
#!/usr/bin/perl
use Child;
my $obj = Child->new({});
my $ref = $obj->getParentSubReference();
&$ref();
#Output
Parent Hello Called
I am reading code snippets like below:
sub new {
my $pkg = shift;
my $args = shift;
my #keys = keys %$args;
my $self = bless \%{$args}, $pkg;
$self->{'__properties'} = \#keys;
my $class = ref($self);
foreach my $meth (#keys) {
if (! $self->can($meth)) {
no strict "refs";
*{ $class . "::" . $meth } = sub {
my $instance = shift;
return $instance->{$meth};
};
}
}
return $self;
}
In the foreach loop, it seems that it creates some methods according to the parameters. There are two lines which I don't understand.Could someone help me? What's the * and {} used for?
no strict "refs";
*{ $class . "::" . $meth }
Best Regards,
This creates a symbol table alias.
The right side contains a reference to a function, so Perl will alias it to the subroutine $meth in the package $class.
See Symbol Tables in perlmod.
As eugene y have already explained, those lines manipulate the symbol table. In practical terms, they do so in order to create read-only accessor methods in the class based on whatever arbitrary list of attributes get passed into the constructor:
#!/usr/bin/env perl
use strict;
use warnings;
use 5.10.0;
package SomeClass;
sub new {
my $pkg = shift;
my $args = shift;
my #keys = keys %$args;
my $self = bless \%{$args}, $pkg;
$self->{'__properties'} = \#keys;
my $class = ref($self);
foreach my $meth (#keys) {
if (!$self->can($meth)) {
no strict "refs";
*{$class . "::" . $meth} = sub {
my $instance = shift;
return $instance->{$meth};
};
}
}
return $self;
}
package main;
my $foo = SomeClass->new({foo => 5}); # Creates SomeClass::foo
say $foo->foo; # 5
my $bar = SomeClass->new({foo => 3, bar => 7}); # Creates SomeClass::bar
say $bar->foo; # 3
say $bar->bar; # 7
say $foo->bar; # undef - ::bar was added to all instances of SomeClass
say $foo->baz; # Boom! No such method.
Personally, I think this is questionable OO practice (a class should generally have a known set of attributes instead of potentially adding new ones each time an instance is constructed), but that's what it does...