Perl module that accepts list and creates objects - perl

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.

Related

How to initialize a specific class variable while creating an object?

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;
}

Perl: Recursive object instantiation with Moose

In the example code below, I am defining a class Person that can have child objects of the same class.
When I invoke the printTree method, I am expecting the following output
Sam Ram Geeta
What I see instead is
SamRamRamRamRamRamRamRamRamRamRamR.....
Any hints on what I am doing wrong and how to achieve my goal?
package Person;
use Moose;
has name => ( is => 'ro' );
my #kids;
sub addChild {
my ( $self, $name ) = #_;
my $k = Person->new( name => $name );
push #kids, $k;
return $k;
}
sub printTree {
my $self = shift;
print $self->name;
$_->printTree foreach ( #kids );
}
no Moose;
package main;
my $s = Person->new( name => "Sam" );
my $r = $s->addChild( "Ram" );
my $g = $s->addChild( "Geeta" );
$s->printTree;
The issue is that #Person::kids does not belong to any one instance, and you effectively end up with
#Person::kids = ($r, $g);
$s->printTree() loops through #Person::kids, calls
$r->printTree() loops through #Person::kids, calls
$r->printTree() loops through #Person::kids, calls
$r->printTree() loops through #Person::kids, calls
...
You need to make it an attribute, e.g.
has kids => (
isa => 'ArrayRef[Person]',
traits => ['Array'],
handles => {
all_kids => 'elements',
push_kids => 'push',
},
default => sub { [] },
);
sub addChild {
my ($self, $name) = #_;
my $k = Person->new(name => $name);
$self->push_kids($k);
return $k;
}
sub printTree {
my ($self) = #_;
print $self->name;
$_->printTree foreach $self->all_kids;
}
You can check perldoc Moose::Meta::Attribute::Native::Trait::Array for other useful handles from the Array trait.

Moose trigger caller

Is there any way of knowing the trigger caller attribute in Moose ?
For example, taking the example from Moose::Manual::Attributes:
has 'size' => (
is => 'rw',
trigger => \&_size_set,
);
sub _size_set {
my ( $self, $size, $old_size ) = #_;
my $msg = $self->name;
if ( #_ > 2 ) {
$msg .= " - old size was $old_size";
}
$msg .= " - size is now $size";
warn $msg;
}
Is it possible in _set_size to know that the attribute size called it, without needing to specify the name of the caller attribute explicitly?
EDIT: updated per comment.
It might be simpler to create a wrapper that adds one argument:
sub make_trigger {
my ($name, $sub) = #_;
return sub {
my $self = shift;
$self->$sub($name, #_);
};
}
has 'size' => (
is => 'rw',
trigger => make_trigger(size => \&_size_set),
);
sub _size_set {
my ( $self, $name, $size, $old_size ) = #_;
...
}
Here's what #RsrchBoy refers to as the "proper way"...
use v5.14;
use strict;
use warnings;
BEGIN {
package MooseX::WhatTheTrig::Trait::Attribute
{
use Moose::Role;
use Scope::Guard qw(guard);
after _process_trigger_option => sub
{
my $class = shift;
my ($name, $opts) = #_;
return unless exists $opts->{trigger};
my $orig = delete $opts->{trigger};
$opts->{trigger} = sub
{
my $self = shift;
my $guard = guard {
$self->meta->_set_triggered_attribute(undef);
};
$self->meta->_set_triggered_attribute($name);
$self->$orig(#_);
};
}
}
package MooseX::WhatTheTrig::Trait::Class
{
use Moose::Role;
has triggered_attribute => (
is => 'ro',
writer => '_set_triggered_attribute',
);
}
}
package Example
{
use Moose -traits => ['MooseX::WhatTheTrig::Trait::Class'];
has [qw(foo bar)] => (
traits => ['MooseX::WhatTheTrig::Trait::Attribute'],
is => 'rw',
trigger => sub {
my ($self, $new, $old) = #_;
$_ //= 'undef' for $old, $new;
my $attr = $self->meta->triggered_attribute;
say "Changed $attr for $self from $old to $new!";
}
);
}
my $obj = Example->new(foo => 1, bar => 2);
$obj->foo(3);
$obj->bar(4);
You'll notice that the "foo" and "bar" attributes share a trigger, but that the trigger is able to differentiate between the two attributes.
Moose::Exporter has some sugar for making this a little less ugly. I might have a play at turning this into a CPAN module some time.
The proper way to do this would be to employ an attribute trait of some sort; one that passes the name, or (preferably) the metaclass instance of the attribute the trigger belongs to. One could even create a trait that allows the class' metaclass to be asked if we're in an attribute trigger, and if so, which one. (This would be transparent and not break anyone's expectations as to how trigger works.)
The easiest would be to curry your triggers as shown in another example.

Why does perl object instance overwrite each other

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.

How do I use an array as an object attribute in Perl?

I need some help regarding the arrays in Perl
This is the constructor I have.
BuildPacket.pm
sub new {
my $class = shift;
my $Packet = {
_PacketName => shift,
_Platform => shift,
_Version => shift,
_IncludePath => [#_],
};
bless $Packet, $class;
return $Packet;
}
sub SetPacketName {
my ( $Packet, $PacketName ) = #_;
$Packet->{_PacketName} = $PacketName if defined($PacketName);
return $Packet->{_PacketName};
}
sub SetIncludePath {
my ( $Packet, #IncludePath ) = #_;
$Packet->{_IncludePath} = \#IncludePath;
}
sub GetPacketName {
my( $Packet ) = #_;
return $Packet->{_PacketName};
}
sub GetIncludePath {
my( $Packet ) = #_;
#{ $Packet->{_IncludePath} };
}
(The code has been modified according to the suggestions from 'gbacon', thank you)
I am pushing the relative paths into 'includeobjects' array in a dynamic way. The includepaths are being read from an xml file and are pushed into this array.
# PacketInput.pm
if($element eq 'Include')
{
while( my( $key, $value ) = each( %attrs ))
{
if($key eq 'Path')
push(#includeobjects, $value);
}
}
So, the includeobject will be this way:
#includeobjects = (
"./input/myMockPacketName",
"./input/myPacket/my3/*.txt",
"./input/myPacket/in.html",
);
I am using this line for set include path
$newPacket->SetIncludePath(#includeobjects);
Also in PacketInput.pm, I have
sub CreateStringPath
{
my $packet = shift;
print "printing packet in CreateStringPath".$packet."\n";
my $append = "";
my #arr = #{$packet->GetIncludePath()};
foreach my $inc (#arr)
{
$append = $append + $inc;
print "print append :".$append."\n";
}
}
I have many packets, so I am looping through each packet
# PacketCreation.pl
my #packets = PacketInput::GetPackets();
foreach my $packet (PacketInput::GetPackets())
{
print "printing packet in loop packet".$packet."\n";
PacketInput::CreateStringPath($packet);
$packet->CreateTar($platform, $input);
$packet->GetValidateOutputFile($platform);
}
The get and set methods work fine for PacketName. But since IncludePath is an array, I could not get it to work, I mean the relative paths are not being printed.
If you enable the strict pragma, the code doesn't even compile:
Global symbol "#_IncludePath" requires explicit package name at Packet.pm line 15.
Global symbol "#_IncludePath" requires explicit package name at Packet.pm line 29.
Global symbol "#_IncludePath" requires explicit package name at Packet.pm line 30.
Global symbol "#_IncludePath" requires explicit package name at Packet.pm line 40.
Don't use # unquoted in your keys because it will confuse the parser. I recommend removing them entirely to avoid confusing human readers of your code.
You seem to want to pull all the attribute values from the arguments to the constructor, so continue peeling off the scalar values with shift, and then everything left must be the include path.
I assume that the components of the include path will be simple scalars and not references; if the latter is the case, then you'll want to make deep copies for safety.
sub new {
my $class = shift;
my $Packet = {
_PacketName => shift,
_Platform => shift,
_Version => shift,
_IncludePath => [ #_ ],
};
bless $Packet, $class;
}
Note that there's no need to store the blessed object in a temporary variable and then immediately return it because of the semantics of Perl subs:
If no return is found and if the last statement is an expression, its value is returned.
The methods below will also make use of this feature.
Given the constructor above, GetIncludePath becomes
sub GetIncludePath {
my( $Packet ) = #_;
my #path = #{ $Packet->{_IncludePath} };
wantarray ? #path : \#path;
}
There are a couple of things going on here. First, note that we're careful to return a copy of the include path rather than a direct reference to the internal array. This way, the user can modify the value returned from GetIncludePath without having to worry about mucking up the packet's state.
The wantarray operator allows a sub to determine the context of its call and respond accordingly. In list context, GetIncludePath will return the list of values in the array. Otherwise, it returns a reference to a copy of the array. This way, client code can call it either as in
foreach my $path (#{ $packet->GetIncludePath }) { ... }
or
foreach my $path ($packet->GetIncludePath) { ... }
SetIncludePath is then
sub SetIncludePath {
my ( $Packet, #IncludePath ) = #_;
$Packet->{_IncludePath} = \#IncludePath;
}
Note that you could have used similar code in the constructor rather than removing one parameter at a time with shift.
You might use the class defined above as in
#! /usr/bin/perl
use strict;
use warnings;
use Packet;
sub print_packet {
my($p) = #_;
print $p->GetPacketName, "\n",
map(" - [$_]\n", $p->GetIncludePath),
"\n";
}
my $p = Packet->new("MyName", "platform", "v1.0", qw/ foo bar baz /);
print_packet $p;
my #includeobjects = (
"./input/myMockPacketName",
"./input/myPacket/my3/*.txt",
"./input/myPacket/in.html",
);
$p->SetIncludePath(#includeobjects);
print_packet $p;
print "In scalar context:\n";
foreach my $path (#{ $p->GetIncludePath }) {
print $path, "\n";
}
Output:
MyName
- [foo]
- [bar]
- [baz]
MyName
- [./input/myMockPacketName]
- [./input/myPacket/my3/*.txt]
- [./input/myPacket/in.html]
In scalar context:
./input/myMockPacketName
./input/myPacket/my3/*.txt
./input/myPacket/in.html
Another way to reduce typing is to use Moose.
package Packet;
use Moose::Policy 'Moose::Policy::JavaAccessors';
use Moose;
has 'PacketName' => (
is => 'rw',
isa => 'Str',
required => 1,
);
has 'Platform' => (
is => 'rw',
isa => 'Str',
required => 1,
);
has 'Version' => (
is => 'rw',
isa => 'Int',
required => 1,
);
has 'IncludePath' => (
is => 'ro',
isa => 'ArrayRef[Str]',
default => sub {[]},
traits => [ 'Array' ],
handles => {
getIncludePath => 'elements',
getIncludePathMember => 'get',
setIncludePathMember => 'set',
},
);
__PACKAGE__->meta->make_immutable;
no Moose;
1;
Check out Moose::Manual::Unsweetened for another example of how Moose saves time.
If you are adamant in your desire to learn classical Perl OOP, read the following perldoc articles: perlboot, perltoot, perlfreftut and perldsc.
A great book about classical Perl OO is Damian Conway's Object Oriented Perl. It will give you a sense of the possibilities in Perl's object.
Once you understand #gbacon's answer, you can save some typing by using Class::Accessor::Fast:
#!/usr/bin/perl
package My::Class;
use strict; use warnings;
use base 'Class::Accessor::Fast';
__PACKAGE__->follow_best_practice;
__PACKAGE__->mk_accessors( qw(
IncludePath
PacketName
Platform
Version
));
use overload '""' => 'to_string';
sub to_string {
my $self = shift;
sprintf(
"%s [ %s:%s ]: %s",
$self->get_PacketName,
$self->get_Platform,
$self->get_Version,
join(':', #{ $self->get_IncludePath })
);
}
my $obj = My::Class->new({
PacketName => 'dummy', Platform => 'Linux'
});
$obj->set_IncludePath([ qw( /home/include /opt/include )]);
$obj->set_Version( '1.05b' );
print "$obj\n";