Can we access object variables inside the destroy method of a perl class.
For eg : i have a perl class as below:
package Person;
sub new {
my $class = shift;
my $self = {
_firstName => shift,
_lastName => shift,
_ssn => shift,
};
# Print all the values just for clarification.
print "First Name is $self->{_firstName}\n";
print "Last Name is $self->{_lastName}\n";
print "SSN is $self->{_ssn}\n";
bless $self, $class;
return $self;
}
I create my object like below:
$object = new Person( "Mohammad", "Saleem", 23234345);
How can I make destroy function so that it will print me like
detroying Mohammad
The DESTROY method gets the same $self reference as its first parameter as all other methods in Perl OOP.
package Person
sub new { ... }
sub DESTROY {
my $self = shift;
print "destroying $self->{_firstName}";
}
package main;
{
my $foo = Person->new( 'foo', 'bar', 123 );
}
This will print
First Name is foo
Last Name is bar
SSN is 123
destroying foo
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 am working on an college problem ( in Perl ). We are working on creating modules and I need to write a simple module that "has get/set methods for four attributes: lastname, firstname, full_name and a list of children who are also person objects".
I think I have it down but it's the list of children who are also person objects that throws me. I guess the module needs to accept a list and then create a list of objects? Python is my core language so this one is throwing me. The get/set methods are working fine. Any ideas?
My module is here...
#!/usr/bin/perl
package Person;
sub new
{
my $class = shift;
my $self = {
_firstName => shift,
_lastName => shift,
};
bless $self, $class;
return $self;
}
sub setFirstName {
my ( $self, $firstName ) = #_;
$self->{_firstName} = $firstName if defined($firstName);
return $self->{_firstName};
}
sub getFirstName {
my( $self ) = #_;
return $self->{_firstName};
}
sub setLastName {
my ( $self, $lastName ) = #_;
$self->{_lastName} = $lastName if defined($lastName);
return $self->{_lastName};
}
sub getLastName {
my( $self ) = #_;
return $self->{_lastName};
}
sub getFullName {
my( $self ) = #_;
return $self->{_lastName}.",".$self->{_firstName};
}
1;
My code is here.....
#!/usr/bin/perl
use Person;
$object = new Person("Elvis","Presley");
# Get first name which is set using constructor.
$firstName = $object->getFirstName();
$lastName = $object->getLastName();
$fullname = $object->getFullName();
print "(Getting) First Name is : $firstName\n";
print "(Getting) Last Name is: $lastName\n";
print "(Getting) Full Name is: $fullname\n";
Just use a list of objects in the setter:
#! /usr/bin/perl
use warnings;
use strict;
use feature qw{ say };
{ package Person;
sub new {
my $class = shift;
my $self = {
_firstName => shift,
_lastName => shift,
_children => [],
};
return bless $self, $class
}
sub setFirstName {
my ($self, $firstName) = #_;
$self->{_firstName} = $firstName if defined $firstName;
return $self->{_firstName}
}
sub getFirstName {
my ($self) = #_;
return $self->{_firstName}
}
sub setLastName {
my ($self, $lastName) = #_;
$self->{_lastName} = $lastName if defined $lastName;
return $self->{_lastName}
}
sub getLastName {
my ($self) = #_;
return $self->{_lastName}
}
sub getFullName {
my ($self) = #_;
return $self->{_lastName} . ', ' . $self->{_firstName}
}
sub getChildren {
my ($self) = #_;
return #{ $self->{_children} }
}
sub setChildren {
my ($self, #children) = #_;
$self->{_children} = [ #children ];
}
}
my $object = 'Person'->new('Elvis', 'Presley');
# Get first name which is set using constructor.
my $firstName = $object->getFirstName;
my $lastName = $object->getLastName;
my $fullname = $object->getFullName;
$object->setChildren('Person'->new('Lisa', 'Presley'),
'Person'->new('Deborah', 'Presley'));
say "(Getting) First Name is: $firstName";
say "(Getting) Last Name is: $lastName";
say "(Getting) Full Name is: $fullname";
say "Children: ";
say $_->getFullName for $object->getChildren;
Note that there are modules to make building objects easier, e.g. Moo:
#! /usr/bin/perl
use warnings;
use strict;
use feature qw{ say };
{ package Person;
use Moo;
has first_name => (is => 'ro');
has last_name => (is => 'ro');
has full_name => (is => 'lazy');
has _children => (is => 'ro',
init_arg => undef,
default => sub { [] });
sub _build_full_name {
my ($self) = #_;
return $self->last_name . ', ' . $self->first_name
}
sub add_child {
my ($self, $child) = #_;
push #{ $self->_children }, $child
}
sub children {
my ($self) = #_;
return #{ $self->_children }
}
}
my $object = 'Person'->new(first_name => 'Elvis',
last_name => 'Presley');
# Get first name which is set using constructor.
my $firstName = $object->first_name;
my $lastName = $object->last_name;
my $fullname = $object->full_name;
$object->add_child($_) for 'Person'->new(first_name => 'Lisa',
last_name => 'Presley'),
'Person'->new(first_name => 'Deborah',
last_name => 'Presley');
say "(Getting) First Name is: $firstName";
say "(Getting) Last Name is: $lastName";
say "(Getting) Full Name is: $fullname";
say "Children: ";
say $_->full_name for $object->children;
The requirement means that there should be an attribute which can accommodate a collection of objects, so a reference to an array. This is defined in the constructor
sub new
{
my $class = shift;
my $self = {
_firstName => shift,
_lastName => shift,
_children => [ #_ ],
};
bless $self, $class;
return $self;
}
where [ ] creates an anonymous array and returns its reference, which is a scalar so it can be used for a hash value. The #_ in it contains the optional rest of the arguments (Person objects) after the class and names have been shift-ed.
Arguments need be checked but this gets hard with a plain list, when they are used positionally. Instead, consider using named parameters, ie. passing a hash(ref) to the constructor, with which it's easy to check which arguments have or have not been supplied.
Next, you need a method to add children to this attribute, for example
sub add_children {
my ($self, #children) = #_; # and check what's passed
push #{$self->{_children}}, #children;
return $self; # for chaining if desired
}
Finally, when you invoke this method you pass objects of the class Person to it
use warnings;
use strict;
use Person;
my $object = Person->new('Elvis', 'Presley');
my $child = Person->new('First', 'Last');
$object->add_children( $child );
or, if there is no use of a $child variable (object) in the rest of the code
$object->add_children( Person->new(...) );
You can add a list of children, add_children($c1, $c2, ...), for example to initially populate the data structure, or can add them individually as they appear.
A list of Person children can be used in the constructor as well
my $obj = Person->new('First', 'Last', $c1, $c2,...);
This gets clearer and far more flexible with mentioned named parameters, which are unpacked and sorted out in the constructor. But more to the point, once you learn the Perl's native OO system look at modules for this, best Moose and its light-weight counterpart Moo.
Comments
Always have use warnings; and use strict; at the beginning
Don't use the indirect object notation
my $obj = new ClassName(...); # DO NOT USE
See this post and this great example. The fact that it can be used to call a constructor is really an abuse of its other legitimate uses. Use a normal method call
my $obj = ClassName->new(...);
It's great that your college is teaching you Perl, but slightly disappointing that they're teaching you the "classic" version of Perl OO, when in the real world most OO work in Perl uses a framework like Moo or Moose.
For interest, I've included a Moo version of the Person object below:
package Person;
use Moo;
use Types::Standard qw[Str ArrayRef Object];
has first_name => (
is => 'rw',
isa => Str,
required => 1,
);
has last_name => (
is => 'rw',
isa => Str,
required => 1,
);
has children => (
is => 'rw',
isa => ArrayRef[Object],
);
sub full_name {
my $self = shift;
return $self->first_name . ' ' . $self->last_name;
}
1;
And here's a simple test program:
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
use Person;
my $elvis = Person->new(
first_name => "Elvis",
last_name => "Presley",
children => [Person->new(
first_name => 'Lisa Marie',
last_name => 'Presley',
)],
);
my $first_name = $elvis->first_name;
my $last_name = $elvis->last_name;
my $full_name = $elvis->full_name;
say "(Getting) First Name is : $first_name";
say "(Getting) Last Name is: $last_name";
say "(Getting) Full Name is: $full_name";
say "Elvis's first child is ", $elvis->children->[0]->full_name;
A few things to note:
Always include use strict and use warnings in your code
Always use Class->new in preference to new Class
Perl programmers prefer snake_case to camelCase
Moo likes you to use named parameters to an object constructor
Declarative attributes (using has) are far less repetitive than writing all your own getter and setter methods
People programmers tend to prefer a single method (foo() which can be used as both a getter and a setter over separate get_foo() and set_foo() methods.
So far I always relied on the order of variables in a class, but now I'm trying to initialize those variables in a shuffled order.
For example, this is what I normally do while creating an object.
my $person1 = Person->new ('Fernando', 'Alonso', 36);
And this is what I'm trying to achieve.
my $person2 = Person->new (Age => 36, FistName => 'Fernando', LastName => 'Alonso');
I tried => regarding to several documents (e.g. perldoc) I saw, but they didn't return a complete example to me. However I don't actually work on the following script, it's a fair MCVE with the 'cliché' package Person.
use strict;
use warnings;
package Person;
sub new {
my $class = shift;
my $self = {
FirstName => shift,
LastName => shift,
Age => shift,
};
print "First name : $self->{FirstName}\n";
print "Last name : $self->{LastName}\n";
print "Age : $self->{Age}\n\n";
bless $self, $class;
return $self;
}
# Works well
my $person1 = Person->new ('Fernando', 'Alonso', 36);
# (?) How to assign 36 directly to $self->{Age}
my $person2 = Person->new (Age => 36, '', '');
The output is as follows.
First name : Fernando
Last name : Alonso
Age : 36
First name : Age
Last name : 36
Age :
So, how should I create the object to make explicit assignments to the class variables? If necessary, how should I modify package Person?
P.S. I avoid changing the variables after the object is created.
The original Person class constructor expects the arguments to contain values in a specific order, but you want to specify key-value pairs. This is easy enough by representing the input as a hash reference.
package Person;
sub new {
my $class = shift;
# read #_ as list of key-value pairs;
# set $self as reference to hash of these pairs
my $self = { #_ };
#my $self = { my %args = #_ }; # if you like your abstractions unbroken
bless $self, $class;
return $self;
}
If you want to restrict the keys that can be set to FirstName, LastName, and Age, you could do something like this.
package Person;
sub new {
my $class = shift;
my %args = #_;
my $self = {
FirstName => $args{FirstName},
LastName => $args{LastName},
Age => $args{Age},
};
bless $self, $class;
return $self;
}
and as a further enhancement, you could provide default values where the caller has not specified all of the expected keys
package Person;
sub new {
my $class = shift;
my %args = #_;
my $self = {
FirstName => $args{FirstName} // "Fred",
LastName => $args{LastName} // "Flinstone",
Age => $args{Age} // 42,
};
bless $self, $class;
return $self;
}
I have two classes, one is the base class(Employee) and the other its subclass which inherits it (Extend) the codes of which are shown below :
package Employee;
require Exporter;
our #EXPORT = ("getattr");
our $private = "This is a class level variable";
sub getattr {
print "Inside the getattr function of Employee.pm module \n";
$self = shift;
$attr = shift;
return ($self->{$attr});
}
1;
================
package Extend;
use base qw(Employee);
sub new {
print "Inside new method of Employee.pm \n";
my $class = shift;
my %data = (
name => shift,
age => shift,
);
bless \%data , $class;
}
sub test {
print "Inside test method of Extend class \n";
}
1;
==================
Now I have another piece of code which is using the Extend class :
use Extend;
my $obj = Extend->new("Subhayan",30);
my $value = $obj->getattr("age");
print ("The value of variable age is : $value \n");
$obj->test();
print "Do i get this : $obj.$private \n";
My question is regarding the variable $private defined in the parent class. As per my concept of inheritance attributes and methods of the parent class should be available through the subclass object . For example the function getattr runs fine . But why am I not being able to access $private variable using the base class Extend object .
What am I missing here ? Can someone please help ?
Variables don't get inherited the same way subs do. To access it, you need to specify the entire package name (and yes, when you declare $private, you need our, not my):
print "$Employee::private\n";
It's much more robust to define accessor methods:
# Employee package
sub private {
return $private;
}
...then in your script:
my $var = private();
To inherit object attributes from Employee, you can do:
# Employee
sub new {
my $self = bless {
dept => 'HR',
hours => '9-5',
}, shift;
return $self;
}
# Extend
sub new {
my $class = shift;
my $self = $class->SUPER::new; # attrs inherited from Employee
$self->{extended} = 1;
return $self;
}
# script
my $extend = Extend->new;
Now $extend looks like:
{
dept => 'HR',
hours => '9-5',
extended => 1,
}
You most likely wouldn't set dept or hours in the base class as it will apply to all employees, but I digress.
I've written some Perl code which compose two classes inherent from a base one. I suppose it would print something like this
Mik: Meow! Meow!
Sat: Woof! Woof!
But it actually print this way:
Sat: Woof! Woof!
Sat: Woof! Woof!
,
package Animal;
sub new {
my $obj = shift;
my $name = shift;
our %pkg = ( 'name' => $name );
bless \%pkg, $obj;
return \%pkg;
}
package Cat;
#ISA = ("Animal");
sub new {
my $obj = shift;
my $name = shift;
my $self = $obj->SUPER::new($name);
return $self;
}
sub get_name {
my $obj = shift;
return $obj->{'name'};
}
sub talk {
my $obj = shift;
return "Meow! Meow!";
}
package Dog;
#ISA = ("Animal");
sub new {
my $obj = shift;
my $name = shift;
my $self = $obj->SUPER::new( $name );
return $self;
}
sub get_name {
my $obj = shift;
return $obj->{'name'};
}
sub talk {
my $obj = shift;
return "Woof! Woof!";
}
package Main;
my $cat = new Cat('Mike');
my $dog = new Dog('Sat');
print $cat->get_name() . ": " . $cat->talk() , "\n";
print $dog->get_name() . ": " . $dog->talk() , "\n";
But if I change the caller in this way, it prints what I suppose to be. So it is quite strange why the $cat object was overwritten after the $dog was instantiated?
package Main;
my $cat = new Cat('Mily');
print $cat->get_name() . ": " . $cat->talk() , "\n";
my $dog = new Dog('Sat');
print $dog->get_name() . ": " . $dog->talk() , "\n";
Why do you bless into a global variable? Change your constructor to:
sub new {
my $obj = shift;
my $name = shift;
my %pkg = ( 'name' => $name );
bless \%pkg, $obj;
return \%pkg;
}
Better yet, change it to something more idiomatic:
sub new {
my $class = shift;
my $name = shift;
my $self = { name => $name };
return bless $self, $class;
}
Moving on:
Why implement new and get_name in each kind of animal? Both methods can be inherited. While we're at it, we might as well get rid off the messing around with #ISA:
package Animal;
sub new {
my $class = shift;
my $name = shift;
my $self = { name => $name };
return bless $self, $class;
}
sub get_name {
my $self = shift;
return $self->{'name'};
}
package Cat;
use base qw/ Animal /;
sub talk {
my $self = shift;
return "Meow! Meow!";
}
package Dog;
use base qw/ Animal /;
sub talk {
my $self = shift;
return "Woof! Woof!";
}
package Main;
my $cat = Cat->new('Mike');
my $dog = Dog->new('Sat');
print $cat->get_name() . ": " . $cat->talk() , "\n";
print $dog->get_name() . ": " . $dog->talk() , "\n";
May I ask which tutorial or book you are following?
While the above is perfectly fine, you might as well do it the Modern Perl way:
package Animal;
use Moose;
has name => ( required => 1, is => 'rw', isa => 'Str' );
package Cat;
use Moose;
extends 'Animal';
has talk => ( default => "Meow! Meow!", is => 'ro' );
package Dog;
use Moose;
extends 'Animal';
has talk => ( default => "Woof! Woof!", is => 'ro' );
package Main;
my $cat = Cat->new( name => 'Mike');
my $dog = Dog->new( name => 'Sat');
print $cat->name . ": " . $cat->talk , "\n";
print $dog->name . ": " . $dog->talk , "\n";
You have declared the variable to store the instance data using
our %pkg
This is an alias for a single data structure (%Animal::pkg), so all your objects are using the same hash. Change our to my in order to create a new hash each time.
It might be worth noting that "inside-out" objects in Perl can and do use a shared data structure in the package to store instance data, but there is an additional level of abstraction required to make that work, and I wouldn't recommend starting OO Perl with them, they are an acquired taste.
In a nutshell: our declares package variables, so every time our %pkg = (...) is executed, you assign a new value to the same variable. As all \%pkg references point to the same var, all return values of new are the same object. A reference can only be blessed into one class, so the last one wins.
Just change the our to my, and it should work as expected.