Tried to write a perl module with OOP, but it can add an object to an array, when I use Dump method, it will output wrong data like this. Where is my error ?
Thanks
bless( {
'_name' => 'CUSIP',
'_validation_array' => [],
'_seq' => '1'
}, 'Field' );
source code:
package Field;
sub new {
my $class = shift;
my $self = {
_name => shift,
_seq => shift,
_validation_array => [ #_ ],
};
bless($self, $class);
return $self;
};
sub pushValidation(){
my $validation = shift;
push(#{$self->{_validation_array}}, $validation);
};
sub dump(){
foreach my $validation (#{$self->{_validation_array} }) {
#print Dumper($validation);#will work,
print $validation->{name}; #error, Use of uninitialized value
}
}
1;
This is the way I call this method :
my $validationObj = new Validation($validation->{name}, $validation->{seq});
$field->pushValidation($validationObj);
I see several problems here, but the most serious one is here:
sub pushValidation() {
my $validation = shift;
push(#{$self->{_validation_array}}, $validation);
};
This function is expecting a $self argument, but isn't shifting it from the arguments. You need to add use strict; at the top of your Perl file. If it had been enabled, the issue would have been immediately obvious:
Global symbol "$self" requires explicit package name at <filename> line <line>.
Same thing goes for the dump() function. (By the way, dump is a bad method name, as there is an (obscure) Perl builtin function with the same name. But that's not a huge issue.)
Related
How can I hide a "tie" call from the user so calling an accessor will implicitly do it for them?
I want to do this, because I have a data structure that can be accessed by the user, but values stored in this structure can be modified without the user's knowledge.
If an attribute in the data structure changes, I want any variables referencing that attribute modified as well so the user will always be using fresh data. Since the user will always want fresh data, it's simpler and more intuitive if the user doesn't even need to know it's happening.
This is what I have so far... it doesn't seem to work though, the output is:
hello
hello
What I want is:
hello
goodbye
Code:
#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };
{
package File;
use Moose;
has '_text' => (is => 'rw', isa => 'Str', required => 1);
sub text {
my ($self) = #_;
tie my $text, 'FileText', $self;
return $text;
}
}
{
package FileText;
use Tie::Scalar;
sub TIESCALAR {
my ($class, $obj) = #_;
return bless \$obj, $class;
}
sub FETCH {
my ($self) = #_;
return $$self->_text();
}
sub STORE {
die "READ ONLY";
}
}
my $file = 'File'->new('_text' => 'hello');
my $text = $file->text();
say $text;
$file->_text('goodbye');
say $text;
I would not recommend doing this. You're introducing "action at a distance" which leads to some very difficult to catch bugs. The user thinks they're getting a string. A lexical string can only be altered by changing it directly and obviously. It has to be altered in place or obviously passed into a function or a reference attached to something.
my $text = $file->text;
say $text; # let's say it's 'foo'
...do some stuff...
$file->text('bar');
...do some more stuff...
# I should be able to safely assume it will still be 'foo'
say $text;
That block of code is easy to understand because all the things which could affect $text are immediately visible. This is what lexical context is all about, isolating what can change a variable.
By returning a thing which can change at any time, you've quietly broken this assumption. There's no indication to the user that assumption has been broken. When they go to print $text and get bar it is non-obvious what changed $text. Anything in the whole program could change $text. That small block of code is now infinitely more complicated.
Another way to look at it is this: scalar variables in Perl have a defined interface. Part of that interface says how they can be changed. You are breaking this interface and lying to the user. This is how overloaded/tied variables are typically abused.
Whatever problem you're trying to solve, you're solving it by adding more problems, by making the code more complex and difficult to understand. I would step back and ask what problem you're trying to solve with tying.
What I would do instead is to just return a scalar reference. This alerts the user that it can be changed out from under them at any time. No magic to cover up a very important piece of information.
#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };
{
package File;
use Moose;
has 'text_ref' => (
is => 'rw',
isa => 'Ref',
default => sub {
return \("");
}
);
sub BUILDARGS {
my $class = shift;
my %args = #_;
# "Cast" a scalar to a scalar ref.
if( defined $args{text} ) {
$args{text_ref} = \(delete $args{text});
}
return \%args;
}
sub text {
my $self = shift;
if( #_ ) {
# Change the existing text object.
${$self->text_ref} = shift;
return;
}
else {
return $self->text_ref;
}
}
}
my $file = 'File'->new('text' => 'hello');
my $text = $file->text();
say $$text;
$file->text('goodbye');
say $$text;
That said, here's how you do what you want.
I would recommend against using tie. It is very slow, considerably slower than a method call, buggy and quirky. One of its quirks is that the tied nature is attached to the variable itself, not the referenced data. That means you can't return a tied variable.
Instead, I would recommend using an overloaded object to store your changing text.
{
package ChangingText;
# Moose wants class types to be in a .pm file. We have to explciitly
# tell it this is a class type.
use Moose::Util::TypeConstraints qw(class_type);
class_type('ChangingText');
use overload
'""' => sub {
my $self = shift;
return $$self;
},
fallback => 1;
sub new {
my $class = shift;
my $text = shift;
return bless \$text, $class;
}
sub set_text {
my $self = shift;
my $new_text = shift;
$$self = $new_text;
return;
}
}
Overloaded objects have their own caveats, mostly due to code which expects strings writing things like if !ref $arg, but they are easier to deal with than the deep tie bugs.
To make this transparent, store the ChangingText object in the File object and then put a hand made text accessor around it to handle plain strings. The accessor makes sure to reuse the same ChangingText object.
To complete the illusion, BUILDARGS is used to change plain text initialization arguments into a ChangingText object.
{
package File;
use Moose;
has 'text_obj' => (
is => 'rw',
isa => 'ChangingText',
default => sub {
return ChangingText->new;
}
);
sub BUILDARGS {
my $class = shift;
my %args = #_;
# "Cast" plain text into a text object
if( defined $args{text} ) {
$args{text_obj} = ChangingText->new(delete $args{text});
}
return \%args;
}
sub text {
my $self = shift;
if( #_ ) {
# Change the existing text object.
$self->text_obj->set_text(shift);
return;
}
else {
return $self->text_obj;
}
}
}
Then it works transparently.
my $file = File->new('text' => 'hello');
my $text = $file->text();
say $text; # hello
$file->text('goodbye');
say $text; # goodbye
return $text just returns the value of the variable, not the variable itself. You can return a reference to it, though:
sub text {
my ($self) = #_;
tie my $text, 'FileText', $self;
return \$text;
}
You then have to use $$text to dereference it:
my $file = 'File'->new('_text' => 'hello');
my $text = $file->text();
say $$text;
$file->_text('goodbye');
say $$text;
I have an arbitrary data structure and I'd like to treat it as an object. I get this as a response from a REST app. Example below. There are some modules on CPAN which promise to do this. Data::Object looks best to me, but it's last updated 2011. Am I missing something? Is there perhaps an easy Moose way to do this? Thanks!
$o=$class->new($response);
$s=$o->success;
#i=$o->items;
{
'success' => bless( do{\(my $o = 1)}, 'JSON::XS::Boolean' ),
'requestNumber' => 5,
'itemsCount' => 1,
'action' => 'search.json',
'totalResults' => 161,
'items' => [
{
'link' => 'http://europeana.eu/api//v2/record/15503/E627F23EF13FA8E6584AF8706A95DB85908413BE.json?wskey=NpXXXX',
'provider' => [
'Kulturpool'
],
'europeanaCollectionName' => [
'15503_Ag_AT_Kulturpool_khm_fs'
],
# more fields omitted
}
],
'apikey' => 'Npxxxx'
};
Although I don't like using it, defining an AUTOLOAD subroutine is a way to create arbitrary classes on the fly. It's been a while since I used it, but it should look something like this:
package Local::Foo;
sub new {
my $class = shift;
my $self = {};
bless $self, $class;
return $self;
}
sub AUTOLOAD {
my $self = shift;
my $value = shift;
our $AUTOLOAD;
(my $method = $AUTOLOAD) = s/.*:://;
if ( defined $value ) {
$self->{$method} = $value;
}
return $self->{$method};
}
This class Local::Foo has an infinite amount of methods. For example, if I said
$foo->bar("fubar");
This would be the same as:
$foo->{bar} = "foobar";
If i called $foo->bar;, it will return the value of $foo->{bar};.
You probably want something to limit your method's style, and their values. For example, with this:
$foo->BAR;
$foo->Bar;
$foo->bar;
are all three valid and completely different methods. You probably want something to make sure your methods match a particular pattern (i.e., they're all lowercase, or the first letter is uppercase and the rest are lowercase. You probably want to make sure they start with a letter so, $foo->23diba; isn't a valid method.
One little problem: Once you define an AUTOLOAD subroutine, you also define DESTROY subroutine too. Perl calls the DESTROY subroutine before an object is destroyed. You need to handle the issue if $AUTOLOAD =~ /.*::DESTROY$/ too. You may need to add:
return if $AUTOLOAD =~ /.*::DESTROY$/;
somewhere in the AUTOLOAD subroutine, so you don't accidentally do something when DESTROY is called. Remember, it's automatically called whenever a class object falls out of scope if one exists, and with AUTOLOAD, you've defined one anyway.
This is an example:
use strict;
package Foo;
#define a simple Foo class with 3 properties
use base qw(Class::Accessor);
Foo->mk_accessors(qw(name role salary));
package main;
#define a perl hash with the same keys
my $hr = {'name'=>'john doe', 'role'=>'admin', 'salary'=>2500 };
#bless the object
my $obj = bless $hr, 'Foo';
print $obj->name, "\n"; #<-- prints: john doe
I am not saying this is necessarily a good idea, the best way to do the idea, or gotcha-free. I never tried it till 15 minutes ago. But it is fun and it is terse, so–
#!/usr/bin/env perl
BEGIN {
package Role::AutoVacca;
use Moo::Role;
use Scalar::Util "blessed";
sub BUILD {
my $self = shift;
for my $attr ( grep /\A[^_]/, keys %{$self} )
{
Method::Generate::Accessor
->generate_method( blessed($self),
$attr,
{ is => "rw" } );
}
}
package Fakey;
use Moo;
with "Role::AutoVacca";
}
my $fake = Fakey->new({
success => bless( do{\(my $o = 1)}, "JSON::XS::Boolean" ),
items => [ { link => "http://europeana.eu/o/haipi",
provider => [ "mememememe" ] } ],
apikey => "3k437" });
print "I CAN HAZ KEE? ", $fake->apikey, $/;
print "IZ GUD? ", $fake->success ? "YAH" : "ONOES", $/;
print "WUT DIZZYING? ", $fake->items, $/;
I'd like to check on every call to my object's methods some value (in this case: token's age). Is it possible to set it to all methods at once? Like in constructor? I have such simple constructor:
sub new {
my $class = shift;
my %args = #_;
my $self = {};
$self->{key} = $args{key};
bless($self, $class);
($self->{token}, $self->{token_start}) = $self->_get_authorized_token();
return $self;
}
And bunch of methods, which depends of tokens age, like this:
sub add_item {
my $self = shift;
my %args = #_;
...
}
I'd like to avoid including age-checking in every method, so i look for more general way to implement it. Has there some?
All I can think of is to hide all your 'real' methods - either in the classical way with a preceding underscore, or in a hash of subroutines - and use AUTOLOAD to direct the call properly.
The example below shos the idea
module MyClass.pm
package MyClass;
use strict;
use warnings;
sub new {
bless {}, __PACKAGE__;
}
sub _method1 {
print "In method1\n";
}
sub _method2 {
print "In method2\n";
}
sub AUTOLOAD {
our $AUTOLOAD;
my ($class, $method) = $AUTOLOAD =~ /(.+)::(.+)/;
return if $method eq 'DESTROY';
my $newmethod = "${class}::_$method";
unless (exists &$newmethod) {
die qq(Can't locate object method "$method" via package "$class");
}
print "Preprocessing...\n";
goto &$newmethod
}
1;
program
use strict;
use warnings;
use MyClass;
my $thing = MyClass->new;
$thing->method1;
$thing->method2;
$thing->method3;
output
Preprocessing...
In method1
Preprocessing...
In method2
Can't locate object method "method3" via package "MyClass" at MyClass.pm line 23.
See Class::Method::Modifiers or Class::Method::Modifiers::Fast module.
I honestly think that if you're doing OO in Perl and you want to deal with things like attributes, method modifiers and deferred resource loading without the boilerplate, it's worth investing in learning Moose. To illustrate, this is one way to write what you want using Moose:
use Moose;
has key => (isa => 'Str', is => 'ro');
has token => (isa => 'HashRef', is => 'ro', lazy_build => 1);
before [qw(add_item method2 method3)] => sub {
my $self = shift;
if (do something with $self->token) {
# return, die, etc.
}
};
sub _build_token {
my $self = shift;
my $key = $self->key;
return { token => 'foo', token_start => time };
}
These might be helpful:
Moose::Manual::MethodModifiers
Moose::Cookbook::Basics::BinaryTree_BuilderAndLazyBuild
I have a set of fields with each field having different set of validation rules.
I have placed the subroutine reference for validating a hash-ref.
Currently its in my constructor, but I want to take it out of my constructor in a private sub.
I have done it as below
sub new {
my $class = shift;
my $self = {#_};
$class = (ref($class)) ? ref $class : $class;
bless($self, $class);
$self->{Validations} = {
Field1 => {name => sub{$self->checkField1(#_);},args => [qw(a b c)]}
Field2 => {name => sub{$self->checkField2(#_);},args => {key1, val1}}
..
..
..
..
};
return $self;
}
Now I want to take out all this validation rules out of my constructor and want to do some thing like below, so that I have some better control over my validation rules based on types fields.(Say some rules are common in one set of fields and I can overwrite rules for other rules just by overwriting the values of fields.)
bless($self, $class);
$self->{Validations} = $self->_getValidation($self->{type});
return $self;
}
sub _getValidation{
my ($self,$type) = #_;
my $validation = {
Field1 => {name => sub {$self->checkField1(#_);}, args => {key1 => val1}},};
return $validation;
}
But I am getting Can't use string ("") as a subroutine ref while "strict refs" in use at... Can anybody tell me why is this behavior with sub ref. If I check my name key, its coming to be null or sub {DUMMY};
It looks to me like you are getting close to reinventing Moose poorly. Consider using Moose instead of building something similar, but less useful.
The error message means that you are passing in a string in a place where your code expects a code reference. Get a stack trace to figure out where the error is coming from.
You can do this by using Carp::Always, overriding the $SIG{__DIE__} handler to generate a stack trace, or inserting a Carp::confess into your code.
Here's a sigdie solution, stick this in your code where it will run before your module initialization:
$SIG{__DIE__} = sub { Carp::confess(#_) };
You may need to put it in a BEGIN block.
I'd really like to discourage you from taking this approach to building objects. You happily bless any random crap passed in to the constructor as part of your object! You blithely reach into your object internals. Field validation rules *do not belong in the constructor--they belong in the attribute mutators.
If you must use a DIY object, clean up your practices:
# Here's a bunch of validators.
# I set them up so that each attribute supports:
# Multiple validators per attribute
# Distinct error message per attribute
my %VALIDATORS = (
some_attribute => [
[ sub { 'foo1' }, 'Foo 1 is bad thing' ],
[ sub { 'foo2' }, 'Foo 2 is bad thing' ],
[ sub { 'foo3' }, 'Foo 3 is bad thing' ],
],
other_attribute => [ [ sub { 'bar' }, 'Bar is bad thing' ] ],
);
sub new {
my $class = shift; # Get the invocant
my %args = #_; # Get named arguments
# Do NOT make this a clone method as well
my $self = {};
bless $class, $self;
# Initialize the object;
for my $arg ( keys %args ) {
# Make sure we have a sane error message on a bad argument.
croak "Bogus argument $arg not allowed in $class\n"
unless $class->can( $arg );
$self->$arg( $args{$arg} );
}
return $self;
}
# Here's an example getter/setter method combined in one.
# You may prefer to separate get and set behavior.
sub some_attribute {
my $self = shift;
if( #_ ){
my $val = shift;
# Do any validation for the field
$_->[0]->($val) or croak $_->[1]
for #{ $VALIDATORS{some_attribute} || [] };
$self->{some_attribute} = $val;
}
return $self->{some_attribute};
}
All this code is very nice, but you have to repeat your attribute code for every attribute. This means a lot of error-prone boilerplate code. You can get around this issue by learning to use closures or string eval to dynamically create your methods, or you can use one of Perl's many class generation libraries such as Class::Accessor, Class::Struct, Accessor::Tiny and so forth.
Or you can learn [Moose][3]. Moose is the new(ish) object library that has been taking over Perl OOP practice. It provides a powerful set of features and dramatically reduces boilerplate over classical Perl OOP:
use Moose;
type 'Foo'
=> as 'Int'
=> where {
$_ > 23 and $_ < 42
}
=> message 'Monkeys flew out my butt';
has 'some_attribute' => (
is => 'rw',
isa => 'Foo',
);
I haven't read everything you had, but this struck me:
sub new {
my $class = shift;
my $self = {#_};
$class = (ref($class)) ? ref $class : $class;
bless($self, $class);
Normally, when you create a new object, the user doesn't pass $self as one of the objects. That's what you're creating.
You usually see something like this:
sub new {
my $class = shift; #Contains the class
my %params = #_; #What other parameters used
my $self = {}; #You're creating the $self object as a reference to something
foreach my $param (keys (%params)) {
$self->{$param} = $params{$param};
}
bless ($self, $class) #Class is provided. You don't have to check for it.
return $self #This is the object you created.
}
Now, $self doesn't have to be a reference to a hash as in the above example. It could be a reference to an array. Or maybe to a function. But, it's usually a reference. The main point, is that the user doesn't pass in $self because that's getting created by your new subroutine.
Nor, do you have to check the value of $class since that's given when the new subroutine is called.
If you want to do your verification in a private class (an excellent idea, by the way), you can do so after the bless:
sub new {
my $class = shift; #Contains the class
my %params = #_; #What other parameters used
my $self = {}; #You're creating the $self object as a reference to something
foreach my $param (keys (%params)) {
$self->{$param} = $params{$param};
}
bless ($self, $class) #Class is provided. You don't have to check for it.
#Now you can run your verifications since you've blessed the object created
if (not $self->_validate_parameters()) {
croak qq(Invalid parameters passed in class $class);
}
return $self #This is the object you created.
}
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";