Automatic conversion of empty string to undef in Perl Moo objects - perl

For some fields of a Perl Moo object I want to replace empty string when it is assigned to the field with undef.
That is I want: $obj->x("") to make the field x undefined.
Please help to develop a Moo extension which does this.
A possible way to do this:
sub make_field_undef {
my ($class, $field_name) = #_;
eval "package $class";
around $field_name => sub {
my $orig = shift;
my $self = shift;
my #args = #_;
if(#args >= 1) {
$args[0] = undef if defined $args[0] && $args[0] eq '';
}
$orig->($self, #args);
};
}
But are there "more structured" or "more declarative" ways to do this? Any other ways to do this?
A complete example with my implementation of it follows. But running it produces errors which I do not understand:
package UndefOnEmpty;
use Moo;
sub auto_undef_fields { () }
sub make_fields_undef {
my ($class) = #_;
eval "package $class";
around [$class->auto_undef_fields] => sub {
my $orig = shift;
my $self = shift;
my #args = #_;
if(#args >= 1) {
$args[0] = undef if defined $args[0] && $args[0] eq '';
}
$orig->($self, #args);
};
around 'BUILD' => {
my ($self, $args) = #_;
foreach my $field_name ($class->auto_undef_fields) {
$args->{$field_name} = undef if defined $args->{$field_name} && $args->{$field_name} eq "";
}
};
}
1;
Usage example:
#!/usr/bin/perl
package X;
use Moo;
use lib '.';
extends 'UndefOnEmpty';
use Types::Standard qw(Str Int Maybe);
use Data::Dumper;
has 'x' => (is=>'rw', isa=>Maybe[Str]);
has 'y' => (is=>'rw', isa=>Maybe[Str]);
sub auto_undef_fields { qw(x y) }
__PACKAGE__->make_fields_undef;
my $obj = X->new(x=>"");
$obj->y("");
print Dumper $obj->x, $obj->y;
Here are the errors:
$ ./test.pl
"my" variable $class masks earlier declaration in same scope at UndefOnEmpty.pm line 20.
"my" variable $args masks earlier declaration in same statement at UndefOnEmpty.pm line 21.
"my" variable $field_name masks earlier declaration in same statement at UndefOnEmpty.pm line 21.
"my" variable $args masks earlier declaration in same statement at UndefOnEmpty.pm line 21.
"my" variable $field_name masks earlier declaration in same statement at UndefOnEmpty.pm line 21.
syntax error at UndefOnEmpty.pm line 20, near "foreach "
Compilation failed in require at /usr/share/perl5/Module/Runtime.pm line 317.
Please help to understand what are the causes of the errors.

Why not use a coercion with the coerce attribute in has? That seems to be the most simple and straightforward way.
package Foo;
use Moo;
has bar => (
is => 'rw',
coerce => sub { $_[0] eq q{} ? undef : $_[0] },
);
Here's what objects look like then.
package main;
use Data::Printer;
p my $foo1 = Foo->new( bar => q{} );
p my $foo2 = Foo->new( bar => 123 );
p my $foo3 = Foo->new;
__END__
Foo {
Parents Moo::Object
public methods (2) : bar, new
private methods (0)
internals: {
bar undef
}
}
Foo {
Parents Moo::Object
public methods (2) : bar, new
private methods (0)
internals: {
bar 123
}
}
Foo {
Parents Moo::Object
public methods (2) : bar, new
private methods (0)
internals: {}
}
In Moose you can also define your own type that derives from your Str and has a built-in coercion. Then you can make all your attributes of that type and turn coercion on.
To make Moo behave like that, look at the documentation of has and the attribute isa, which is right above coerce (linked above).

Related

How to Bless Objects in a List Passed to a Subroutine?

In my Perl (v5.30.0) script, I have the world's simplest object:
#!/usr/bin/perl
use warnings;
use strict;
use Data::Dumper;
package Thingee;
# Constructor with name new
sub new
{
my $type = shift;
my %params = #_;
my $self = {};
$self->{'somedata'} = $params{'somedata'};
bless $self, $type;
}
sub printMe
{
my ($self) = #_;
printf "Data: \"%s\"\n", $self->{'somedata'}; # LINE 19
}
What could be simpler? Now, in the "main" body of my script, I create a list of Thingee objects. What I'm discovering is that the newly-created Thingees seem to be blessed upon creation... but if I pass the list to a subroutine, the same objects are seen as unblessed. Here's the code:
package main;
sub foo
{
print "foo() ==========================================\n";
my #ObjectArr = #_;
print Dumper(#ObjectArr);
foreach my $obj (#ObjectArr)
{
$obj->printMe(); # LINE 33
}
}
# I make a list of objects:
my #ObjectArr = ();
push #ObjectArr, Thingee->new( 'somedata' => "My dog has fleas" );
push #ObjectArr, Thingee->new( 'somedata' => "My cat is fine" );
foreach my $obj (#ObjectArr)
{
$obj->printMe();
}
foo(\#ObjectArr);
Output is:
Data: "My dog has fleas"
Data: "My cat is fine"
foo() ==========================================
$VAR1 = [
bless( {
'somedata' => 'My dog has fleas'
}, 'Thingee' ),
bless( {
'somedata' => 'My cat is fine'
}, 'Thingee' )
];
Can't call method "printMe" on unblessed reference at ./PassHash6.perl line 33.
Frustrating. In the "main" part of the code, I can iterate through the foreach loop, and the newly-created Thingee objects are accessible. But within the scope of subroutine foo(), the exact same foreach loop throws the Can't call method "printMe" on unblessed reference error. Harmuph!
My favorite explanation for why blessing is necessary comes from this SO post:
An unblessed reference is one where one variable is not a legal
reference to an object[.]
Okay, that makes sense. But then how can all of the following be true:
My Thingees are blessed within the scope of the "main" code
My Thingees are not blessed within the scope of foo()
Within foo(), my Thingees are nonetheless visible in the eyes of Data:Dumper()
Just for giggles, I modified the foreach() block within foo() to this:
foreach my $obj (#ObjectArr)
{
bless $obj, "Thingee"; # New command here
$obj->printMe(); # LINE 34
}
But now the script throws this error:
<EVERYTHING FROM BEFORE...>
Not a HASH reference at ./PassHash6.perl line 19.
Ugh. Line 19 is from the package Thingee section:
sub printMe
{
my ($self) = #_;
printf "Data: \"%s\"\n", $self->{'somedata'}; # LINE 19
}
Does anyone see what I'm doing wrong?
You are passing a reference to an array to foo
foo(\#ObjectArr);
Inside of foo, you do
my #ObjectArr = #_;
#ObjectArr contains a exactly one element, the referenced passed to foo. This is not what you intended.
Option 1: foo accepts a reference to an array.
sub foo {
my $objs = shift;
$_->printMe() for #$objs;
}
foo( \#objs );
Option 2: foo accepts objects.
sub foo {
$_->printMe() for #_;
}
foo( #objs );

How can I implement "thunks" (delayed computation) in a general way using Moo and Type::Tiny?

I want to be able to have a Moo* class with these characteristics:
an object's attribute can store a reference to the object itself
that attribute will be type-constrained using a Type::Tiny type so the reference must be of the right type
the class must function when it is immutable, and the attribute is "required", i.e. an undefined value is unacceptable and it cannot be updated later
E.g.
package GraphQLType;
use Moo;
use Types::Standard -all;
has [qw(children)] => (
is => 'rwp',
isa => ArrayRef[InstanceOf['GraphQLType']],
required => 1,
);
package main;
my $type;
$type = GraphQLType->new(children => [$type]);
The above presents a chicken-and-egg problem: $type will be undefined and therefore fail the type constraint.
A pattern used in graphql-js is "thunking". In Perl terms:
package GraphQLType;
use Moo;
use Types::Standard -all;
has [qw(children)] => (
is => 'rwp',
isa => CodeRef | ArrayRef[InstanceOf['GraphQLType']],
required => 1,
);
package main;
my $type;
$type = GraphQLType->new(children => sub { [$type] });
While that works for the specific type there, how can I have a parameterised type that implements something like this? Also, it will help even more if this can hook into the "lazy" functionality to minimise the code involved in storing the computed value.
package Thunking;
use Moo;
use Types::Thunking -all;
use Types::Standard -all;
has [qw(children)] => (
is => 'lazy',
isa => Thunk[ArrayRef[InstanceOf['GraphQLType']]],
required => 1,
);
Two issues need to be dealt with here: a parameterised Type::Tiny type constraint for a delayed-computation immutable attribute (DCIA), and an actually-functioning DCIA.
Parameterised type
Since this is Perl, there is more than one way to do this. The heart of making a parameterised type in Type::Tiny is to provide a constraint_generator parameter. The most idiomatic way to do this, using only Type::Tiny components, is:
package Types::Thunking;
use Types::TypeTiny -all;
use Type::Library -base;
use Type::Utils -all;
declare "Thunk", constraint_generator => sub { union [ CodeLike, #_ ] };
That's it! If no parameters are given, it works just like a CodeLike. The libraries can take care of any "inline" code generating.
The reason it can be so short is that the constraint_generator must return either a code-ref, which would probably be a closure that captures the parameters passed to it (see below), or simply a Type::Tiny - in which case the other parameterisability parameters are not needed. Since union (which looks like it's normally intended for producing arguments to a declare) returns a suitably-constructed Type::Tiny::Union, it just drops in perfectly.
A more spelled-out version, not using a union type (and for brevity, using CodeRef not CodeLike:
package Types::Thunking;
use Types::Standard -all;
use Type::Library -base;
use Type::Utils -all;
declare "Thunk",
constraint_generator => sub {
my ($param) = #_;
die "parameter must be a type" if grep !UNIVERSAL::isa($_, 'Type::Tiny'), #_;
return sub { is_CodeRef($_) or $param->check($_) };
},
inline_generator => sub {
my ($param) = #_;
die "parameter must be a type" if grep !UNIVERSAL::isa($_, 'Type::Tiny'), #_;
return sub {
my ($constraint, $varname) = #_;
return sprintf(
'Types::Standard::is_CodeRef(%s) or %s',
$varname,
$param->inline_check($varname),
);
};
};
This is the "harness" I used for testing these:
#!/usr/bin/perl
use Thunking;
sub do_test {
use Data::Dumper; local $Data::Dumper::Terse = 1; local $Data::Dumper::Indent = 0;
my ($args, $should_work) = #_;
my $l = eval { Thunking->new(#$args) };
if (!$l) {
say "correctly did not work" and return if !$should_work;
say "INcorrectly did not work" and return if $should_work;
}
my $val = eval { $l->attr };
if (!$val) {
say "correctly did not work" and return if !$should_work;
say "INcorrectly did not work" and return if $should_work;
}
say(($should_work ? "" : "INcorrectly worked: "), Dumper $val);
}
do_test [attr => { k => "wrong type" }], 0;
do_test [attr => ["real value at init"]], 1;
do_test [attr => sub { [ "delayed" ] }], 1;
do_test [attr => sub { { k => "delayed wrong type" } }], 0;
Delayed-computation immutable attribute
In order to make this immutable, we want setting the attribute to fail unless it's us doing it. When reading the attribute, we want to see whether there is computation to be done; if yes, do it; then return the value.
Naive approach
package Thunking;
use Moo;
use Types::Standard -all;
use Types::Thunking -all;
has attr => (
is => 'rwp',
isa => Thunk[ArrayRef],
required => 1,
);
before 'attr' => sub {
my $self = shift;
return if #_; # attempt at setting, hand to auto
my $value = $self->{attr};
return if ref($value) ne 'CODE'; # attempt at reading and already resolved
$self->_set_attr($value->());
}
The before should be fairly self-explanatory but you will see it manually looks in the object's hash-ref, which is usually a clue that your programming is not finished yet. Also, it's rwp and requires the before in the class, which is far from pretty.
Using MooX modules
An approach that tries to generalise this with a separate module, MooX::Thunking. First, another module to encapsulate overriding of Moo functions:
package MooX::Utils;
use strict;
use warnings;
use Moo ();
use Moo::Role ();
use Carp qw(croak);
use base qw(Exporter);
our #EXPORT = qw(override_function);
sub override_function {
my ($target, $name, $func) = #_;
my $orig = $target->can($name) or croak "Override '$target\::$name': not found";
my $install_tracked = Moo::Role->is_role($target) ? \&Moo::Role::_install_tracked : \&Moo::_install_tracked;
$install_tracked->($target, $name, sub { $func->($orig, #_) });
}
Now the thunking MooX module itself, which uses the above to override has:
package MooX::Thunking;
use MooX::Utils;
use Types::TypeTiny -all;
use Class::Method::Modifiers qw(install_modifier);
sub import {
my $target = scalar caller;
override_function($target, 'has', sub {
my ($orig, $name, %opts) = #_;
$orig->($name, %opts), return if $opts{is} ne 'thunked';
$opts{is} = 'ro';
$orig->($name, %opts); # so we have method to modify
install_modifier $target, 'before', $name => sub {
my $self = shift;
return if #_; # attempt at setting, hand to auto
my $value = $self->{$name};
return if !eval { CodeLike->($value); 1 }; # attempt at reading and already resolved
$self->{$name} = $value->();
$opts{isa}->($self->{$name}) if $opts{isa}; # validate
}
});
}
This applies "thunking" to an attribute. It will only function if the attribute is ro, and will quietly resolve any CodeLike values on reading. It can be used like this:
package Thunking;
use Moo;
use MooX::Thunking;
use Types::Standard -all;
use Types::Thunking -all;
has attr => (
is => 'thunked',
isa => Thunk[ArrayRef],
);
Using BUILDARGS and lazy
An alternative approach, suggested by the mighty #haarg:
package MooX::Thunking;
use MooX::Utils;
use Types::TypeTiny -all;
use Class::Method::Modifiers qw(install_modifier);
sub import {
my $target = scalar caller;
override_function($target, 'has', sub {
my ($orig, $name, %opts) = #_;
$orig->($name, %opts), return if $opts{is} ne 'thunked';
$opts{is} = 'lazy';
my $gen_attr = "_gen_$name";
$orig->($gen_attr => (is => 'ro'));
$opts{builder} = sub { $_[0]->$gen_attr->(); };
install_modifier $target, 'around', 'BUILDARGS' => sub {
my ($orig, $self) = (shift, shift);
my $args = $self->$orig(#_);
$args->{$gen_attr} = delete $args->{$name} if eval { CodeLike->($args->{$name}); 1 };
return $args;
};
$orig->($name, %opts);
});
}
It uses the built-in lazy mechanism, creating a builder that will call the supplied CodeLike if that is what is given. One important downside is that this technique does not work for Moo::Roles.

How can I do function partial application in Perl?

Is there any way to achieve partial application in Perl?
Suppose, I want to do something like:
sub each_file($arr, $op) {
$op->($_) for #{$arr};
...
}
sub each_line($op, $file) {
...
}
each_file($arr, each_line($op));
I want to partially apply each_line() to only $op, so it'll become a new function can be passed to $each_file, how do I express this in idiomatic Perl?
You can do this in Perl with two approaches combined:
A function which returns a function reference
Closures
Example:
sub each_file {
my ($arr, $line_fn) = #_;
$line_fn->($_) for #{$arr};
...
}
sub each_line {
my ($op, $file) = #_;
...
}
sub make_line_processor {
my ( $op ) = #_;
# This is closed over $op, which effectively becomes
# a constant for the returned function
my $fn = sub {
return each_line( $op, #_ );
};
return $fn;
}
# To call it:
each_file( $arr, make_line_processor($op) );
This can be an even more useful technique in cases where you don't want $op directly, but some expensive-to-fetch derivation of it. In which case you would calculate the derived value just once (in the make_line_processor function) and close over that instead.
# given some $op as implied by your code snippet
each_file($arr, sub { each_line($op, shift) });
# shift op will be applied when anonymous sub { … } is called
(Your code snippet doesn't make it entirely clear what you intend $op to be when you make the call to each_line. It's usually better to present small working programs.)
You can roll this functionality up into a class. Then you can overload the subroutine dereference operator to make it look like your class is really a code reference.
package Partial;
use overload '&{}' => \&call;
sub new {
my $class = shift;
my $code = shift;
bless {code => $code, args => \#_}, $class;
}
sub call {
my ($self) = #_;
return sub{ $self->{code}->(#{$self->{args}}, #_) }
}
You can then use it like this:
sub printArgs {
print join ", ", #_;
print "\n";
}
my $partial = Partial->new(\&printArgs, 'foo', 'bar');
$partial->('baz', 'bat');
# prints foo, bar, baz, bat

Unless constructor argument passed is a hash type, croak on invalid arguments?

I am vaguely confused a bit on different methods of passing certain arguments to the constructor type. I want to only pass a hash reference \%hash, or a list foo => 1, bar => 1 but not both and croak if anything else is passed i.e ( single elements, array reference ).
For example, I pass my reference or list.. (This works for the way I do this)
my $obj = foo->new;
my $data = $obj->dump( \%hash );
my $data = $obj->dump( foo => 1, bar => 1 );
or
my $obj = foo->dump( \%hash );
my $obj = foo->dump( foo => 1, bar => 1 );
Package module:
package foo;
use strict;
use Carp;
use Scalar::Util qw/reftype/;
sub new { return bless {}, shift }
sub dump {
my $class = shift;
my $self = shift;
unless ( reftype( $self ) eq reftype {} ) {
croak("Constructor method not a hash type!");
}
}
1;
I've also thought about using the conditional operator ? : here, but I can't get it to error properly.
my $self = reftype($_[0]) eq reftype {} ? shift : {#_};
Is there a better preferred way to do this?
We can look at the various ways your dump method can be called.
If we pass a "hash list", the number of elements is even (#_ % 2 == 0). Also, if at least one key-value pair is present, the first argument (a key) is a string, so not defined reftype $_[0] holds.
If we pass a hash reference, then the argument list should only hold this reference, and no other values: #_ == 1. The first argument will be a hash: reftype($_[0]) eq 'HASH'.
So to put the arguments in a hash reference, one could do something like:
sub dump {
my $invocant = shift;
my $hashref;
if (#_ == 1 and reftype $_[0] eq 'HASH') {
$hashref = $_[0];
} elsif (#_ % 2 == 0 and (#_ == 0 or not defined reftype $_[0])) {
$hashref = +{ #_ };
} else {
croak "Unknown argument format: either pass a hashref, or an even-valued list";
}
...; # do something with $hashref
}
To find out if the $invocant is the class name or an object, just ask it if it is blessed:
if (defined Scalar::Util::blessed $invocant) {
say "Yep, it is an object";
} else {
say "Nope, it is a package name";
}
There's no such thing as a "hash list". foo => 1, bar => 1, is just a four element list. Sounds like you want to accept hash refs and even numbers of args.
sub dump {
my $self = shift;
my %args;
if (#_ == 1) {
croak("...") if (ref($_[0]) // '') ne 'HASH';
%args = %{ $_[0] };
} else {
croak("...") if #_ % 2 != 0;
%args = #_;
}
...
}

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