How can I define pre/post-increment behavior in Perl objects? - perl

Date::Simple objects display this behavior, where $date++ returns the next day's date.
Date::Simple objects are immutable. After assigning $date1 to $date2, no change to $date1 can affect $date2. This means, for example, that there is nothing like a set_year operation, and $date++ assigns a new object to $date.
How can one custom-define the pre/post-incremental behavior of an object, such that ++$object or $object-- performs a particular action?
I've skimmed over perlboot, perltoot, perltooc and perlbot, but I don't see any examples showing how this can be done.

You want overload.
package Number;
use overload
'0+' => \&as_number,
'++' => \&incr,
;
sub new {
my ($class, $num) = #_;
return bless \$num => $class;
}
sub as_number {
my ($self) = #_;
return $$self;
}
sub incr {
my ($self) = #_;
$_[0] = Number->new($self->as_number + 1); # note the modification of $_[0]
return;
}
package main;
my $num = Number->new(5);
print $num . "\n"; # 5
print $num++ . "\n"; # 5
print ++$num . "\n"; # 7

If you look up perlfaq7 you'll find that the answer is to use the overload pragma, though they probably could have given the FAQ question a better name (in my opinion).
package SomeThing;
use overload
'+' => \&myadd,
'-' => \&mysub;
Basically (assuming $a is an object of the SomeThing class and $b isn't), the above would overload $a + $b to be $a->myadd($b, 0) and $b + $a to $a->myadd($b, 1) (that is, the third argument is a boolean meaning "were the arguments to this operator flipped" and the first-argument-is-self syntax is preserved), and the same for - and mysub.
Read the documentation for the full explanation.

Related

map(encode_entities, #_) does not seem to work

map(encode_entities, #_) does not seem to work, where the function is from HTML::Entities. I can work around it (see below), but is there a less ugly way? And could someone explain what is going on -- is there a conceptual error in my thinking?
use HTML::Entities;
sub foo {
my #list = map(encode_entities, #_);
return #list;
}
sub bar {
my #list = #_;
my $n = scalar #list;
for my $k (0..$n-1) {
$list[$k] = encode_entities($list[$k]);
}
return #list;
}
my #test = ('1 < 2', 'Hello world!');
print join("\n", bar(#test)); # prints the two lines, encoded as expected
print join("\n", foo(#test)); # undefined, gives "Use of uninitialized value..." error
There is no reason to assume that anything other than a Perl operator will use $_ as a default parameter: it would have to be written carefully to behave that way
All you need to do is to call encode_entities with a specific parameter
Try this
sub baz {
map encode_entities($_), #_;
}
It's likely that you will feel that a separate subroutine definition is unnecessary

Use of reference to elements in #_ to avoid duplicating code

Is it safe to take reference of elements of #_ in a subroutine in order to avoid duplicating code? I also wonder if the following is good practice or can be simplified. I have a subroutine mod_str that takes an option saying if a string argument should be modified in-place or not:
use feature qw(say);
use strict;
use warnings;
my $str = 'abc';
my $mstr = mod_str( $str, in_place => 0 );
say $mstr;
mod_str( $str, in_place => 1 );
say $str;
sub mod_str {
my %opt;
%opt = #_[1..$#_];
if ( $opt{in_place} ) {
$_[0] =~ s/a/A/g;
# .. do more stuff with $_[0]
return;
}
else {
my $str = $_[0];
$str =~ s/a/A/g;
# .. do more stuff with $str
return $str;
}
}
In order to avoid repeating/duplicating code in the if and else blocks above, I tried to improve mod_str:
sub mod_str {
my %opt;
%opt = #_[1..$#_];
my $ref;
my $str;
if ( $opt{in_place} ) {
$ref = \$_[0];
}
else {
$str = $_[0]; # make copy
$ref = \$str;
}
$$ref =~ s/a/A/g;
# .. do more stuff with $$ref
$opt{in_place} ? return : return $$ref;
}
The "in place" flag changes the function's interface to the point where it should be a new function. It will simplify the interface, testing, documentation and the internals to have two functions. Rather than having to parse arguments and have a big if/else block, the user has already made that choice for you.
Another way to look at it is the in_place option will always be set to a constant. Because it fundamentally changes how the function behaves, there's no sensible case where you'd write in_place => $flag.
Once you do that, the reuse becomes more obvious. Write one function to do the operation in place. Write another which calls that on a copy.
sub mod_str_in_place {
# ...Do work on $_[0]...
return;
}
sub mod_str {
my $str = $_[0]; # string is copied
mod_str_in_place($str);
return $str;
}
In the absence of the disgraced given I like using for as a topicalizer. This effectively aliases $_ to either $_[0] or the local copy depending on the value of the in_place hash element. It's directly comparable to your $ref but with aliases, and a lot cleaner
I see no reason to return a useless undef / () in the case that the string is modified in place; the subroutine may as well return the new value of the string. (I suspect the old value might be more useful, after the fashion of $x++, but that makes for uglier code!)
I'm not sure whether this is readable code to anyone but me, so comments are welcome!
use strict;
use warnings;
my $ss = 'abcabc';
printf "%s %s\n", mod_str($ss), $ss;
$ss = 'abcabc';
printf "%s %s\n", mod_str($ss, in_place => 1), $ss;
sub mod_str {
my ($copy, %opt) = #_;
for ( $opt{in_place} ? $_[0] : $copy ) {
s/a/A/g;
# .. do more stuff with $_
return $_;
}
}
output
AbcAbc abcabc
AbcAbc AbcAbc

Overload object operation in Perl

I want to use overloaded operators in a method which modifies an object. I also want to achieve it without duplicating the code.
To illustrate the problem, I will show a simplified version of what I am trying to do. In my original code, the add method overloads + and complicated_calculation method tries to update the object.
The add method creates a new Number object to avoid an expression like $n + 1 modifying the object.
package Number;
use overload
'0+' => 'get_value',
'+' => 'add';
sub new {
my ($class, $value) = #_;
my $self->{value} = $value;
return bless($self, $class);
}
sub get_value {
my ($self) = #_;
return $self->{value};
}
sub set_value {
my ($self, $value) = #_;
$self->{value} = $value;
}
# Actual class has more attributes and the logic of addition includes branches.
sub add {
my ($self, $other) = #_;
print "add $other\n";
return Number->new($self->get_value + $other);
}
sub complicated_calculation {
my ($self) = #_;
# Do something complicated.
$self += 10;
}
package main;
my $n = Number->new(1);
print $n + 1 . "\n";
$n++;
print $n . "\n";
$n->complicated_calculation;
print $n . "\n";
Will output
add 1
2
add 1
2
add 10
2
I want the result of complicated_calculation method (12) to be printed, but 2 is printed instead. The result of the complicated_calculation method is set to an object created by the add method, instead of to the object which called it.
I can make the complicated_calculation method update the object using an add_in_place method to add a number in-place, but this requires duplicated code in add and add_in_place which I was taught to avoid.
In the actual application the Number class will have many more attributes, and the code for addition will be much longer.
package Number;
use overload
'0+' => 'get_value',
'+' => 'add',
'+=' => 'add_in_place',
'fallback' => 1;
sub new {
my ($class, $value) = #_;
my $self->{value} = $value;
return bless($self, $class);
}
sub get_value {
my ($self) = #_;
return $self->{value};
}
sub set_value {
my ($self, $value) = #_;
$self->{value} = $value;
}
# Actual class has more attributes and the logic of addition includes branches.
sub add {
my ($self, $other) = #_;
print "add $other\n";
return Number->new($self->get_value + $other);
}
sub add_in_place {
my ($self, $other) = #_;
print "add_in_place $other\n";
$self->set_value($self->get_value + $other);
}
sub complicated_calculation {
my ($self) = #_;
# Do something complicated.
$self += 10;
}
package main;
my $n = Number->new(1);
print $n + 1 . "\n";
$n++;
print $n . "\n";
$n->complicated_calculation;
print $n . "\n";
Will output
add 1
2
add_in_place 1
2
add_in_place 10
12
I feel that there should be a better way and would like to have some advice from you guys.
First of all, you must always use strict and use warnings at the top of every Perl program file you write. This applies especially when you are asking for help with your code, as it is the first line of defence against bugs and really should be your first resort before troubling others.
This is happening because the add method is called to implement the += operator, which returns a new Number object as a result. That results in the value of $self within complicated_calculation being changed to refer to the new Number object that, correctly, has a value of 12. But the original value -- $n in the main code -- still points to an object with the value of 2.
To get it to work, you could arrange that complicated_calculation returns the new object, and the calling code assigns it to $n. Just changing that statement to
$n = $n->complicated_calculation
will get it working.
However, it is a little strange to write stuff like that as a method. The code in the Number class should be focused on making the object behave correctly, so all the methods should be operators. If you were writing complicated_calculation as a subroutine in the main package then you would be fine with
$n += 10;
print $n;
as the copying of $n would then work correctly and transparently. It is only when you are writing a method that reassigning $self makes no sense, because it then no longer refers to the object the calling code is using.
If you really consider complicated_calculation to be an operator, then it should mutate the object in-place rather than relying on overload to provide the mechanism. If you changed it to
sub complicated_calculation {
my ($self) = #_;
$self->{value} += 10;
}
then everything would work as it should.
Update
I strongly believe that you should write everything in terms of add_in_place, which should be a private method for use only internally by the class.
Both add and complicated_calculation can be very simply rewritten, and there is no longer any need to write $n = $n->complicated_calculation as the method modifies the object in-place.
This example code for the module demonstrates.
package Number;
use strict;
use warnings;
use 5.010;
use overload
'0+' => 'get_value',
'+' => 'add';
sub new {
my ($class, $value) = #_;
bless { value => $value };
}
sub get_value {
my ($self) = #_;
$self->{value};
}
sub set_value {
my ($self, $value) = #_;
$self->{value} = $value;
}
sub add {
my ($self, $other) = #_;
print "add $other\n";
Number->new($self->get_value)->add_in_place($other);
}
sub add_in_place {
my ($self, $other) = #_;
print "add_in_place $other\n";
$self->{value} += $other;
$self;
}
sub complicated_calculation {
my ($self) = #_;
$self->add_in_place(10);
}

Reference found where even-sized list expected in Perl - Possible pass-by-reference error?

I have a Perl class/module that I created to display Bible verses. In it there is a hash that stores several verses, with the key being the book/chapter/verse and the value being the text. This hash is returned from the module.
I'm including the Bible class in a controller class, and that connection seems to work. The problem is I keep getting errors on executing. My IDE because I'm following a Lynda tutorial, is Eclipse with the EPIC plugin.
The error is:
Reference found where even-sized list expected at C:/Documents and Settings/nunya/eric.hepperle_codebase/lynda/lamp/perl5/Exercise Files/14 Modules/eh_bibleInspiration_controller.pl line 42.
Use of uninitialized value $value in concatenation (.) or string at C:/Documents and Settings/nunya/eric.hepperle_codebase/lynda/lamp/perl5/Exercise Files/14 Modules/eh_bibleInspiration_controller.pl line 45.
HASH(0x19ad454) =>
Here is the CONTROLLER class:
#!/usr/bin/perl
# eh_bibleInspiration_controller.pl by Eric Hepperle - 06/23/13
#
use strict;
use warnings;
use Data::Dumper;
use EHW_BibleInspiration;
main(#ARGV);
sub main
{
my $o = EHW_BibleInspiration->new; # instantiate new object.
my %bo_ref = $o->getBibleObj();
print "\$o is type: " . ref($o) . ".\n";
print "\%bo_ref is type: " . ref(\%bo_ref) . ".\n";
# exit;
$o->getVerseObj();
listHash(\%bo_ref);
message("Done.");
}
sub message
{
my $m = shift or return;
print("$m\n");
}
sub error
{
my $e = shift || 'unkown error';
print("$0: $e\n");
exit 0;
}
sub listHash
{
my %hash = #_;
foreach my $key (sort keys %hash) {
my $value = $hash{$key};
message("$key => $value\n");
}
}
Here is the class that returns the verses and has the method to pick a random verse:
# EHW_BibleInspiration.pm
# EHW_BibleInspiration.
#
package EHW_BibleInspiration;
use strict;
use warnings;
use IO::File;
use Data::Dumper;
our $VERSION = "0.1";
sub new
{
my $class = shift;
my $self = {};
bless($self, $class); # turns hash into object
return $self;
}
sub getVerseObj
{
my ($self) = #_;
print "My Bible Verse:\n";
my $verses = $self->getBibleObj();
# get random verse
#$knockknocks{(keys %knockknocks)[rand keys %knockknocks]};
# sub mysub {
# my $params = shift;
# my %paramhash = %$params;
# }
# my %verses = %{$verses};
# my $random_value = %verses{(keys %verses)[rand keys %verses]};
# print Dumper(%{$random_value});
}
sub getBibleObj
{
my ($self) = #_;
# create bible verse object (ESV)
my $bibleObj_ref = {
'john 3:16' => 'For God so loved the world,that he gave his only Son, that whoever believes in him should not perish but have eternal life.',
'matt 10:8' => 'Heal the sick, raise the dead, cleanse lepers, cast out demons. You received without paying; give without pay.',
'Luke 6:38' => 'Give, and it will be given to you. Good measure, pressed down, shaken together, running over, will be put into your lap. For with the measure you use it will be measured back to you.',
'John 16:24' => 'Until now you have asked nothing in my name. Ask, and you will receive, that your joy may be full.',
'Psalms 32:7' => 'You are a hiding place for me; you preserve me from trouble; you surround me with shouts of deliverance. Selah',
'Proverbs 3:5-6' => 'Trust in the LORD with all your heart, and do not lean on your own understanding. 6 In all your ways acknowledge him, and he will make straight your paths.',
'John 14:1' => 'Let not your hearts be troubled. Believe in God; believe also in me.'
};
my $out = "The BIBLE is awesome!\n";
return $bibleObj_ref;
}
1;
What am I doing wrong? I suspect it has something to do with hash vs hash reference, but I don't know how to fix it. My dereferencing attempts had failed miserably because I don't really know what I'm doing. I modeled my random getter off of something I saw on perlmonks. #$knockknocks{(keys %knockknocks)[rand keys %knockknocks]};
In the main, you have:
my %bo_ref = $o->getBibleObj();
but, in package EHW_BibleInspiration;, the method getBibleObj returns : return $bibleObj_ref;
You'd do, in the main : my $bo_ref = $o->getBibleObj();
and then call listHash($bo_ref);
Finaly, don't forget to change sub listHash to:
sub listHash
{
my ($hash) = #_;
foreach my $key (sort keys %{$hash}) {
my $value = $hash->{$key};
message("$key => $value\n");
}
}
In your main, you do
listHash(\%bo_ref);
This passes a hash reference to the sub. However, it tries to unpack its arguments like
my %hash = #_;
Oops, it wants a hash.
Either, we pass it a hash: listHash(%bo_ref). This saves us much typing.
Or, we handle the reference inside the sub, like
sub listHash {
my ($hashref) = #_;
foreach my $key (sort keys %$hashref) {
my $value = $hashref->{$key};
print "$key => $value\n";
}
}
Notice how the reference uses the dereference arrow -> to access hash entries, and how it is dereferenced to a hash for keys.
I suspect that your suspicion is correct. In your method sub listHash you're correctly passing in the hash but you're trying to use a hash instead of a hash reference for the internal variable. Try using my ($hash) = #_; instead of my %hash = #_;.
When using references you can use the -> operator to de-reference it to get to the underlying values. The rest of your method should look like this:
sub listHash
{
my ($hash) = #_;
foreach my $key (sort keys %{$hash}) {
my $value = $hash->{$key};
message("$key => $value\n");
}
}
On line 43 of your program I had to tell Perl that the reference should be a hash reference by calling keys %{$hash}. Then on line 44 I de-referenced the hash to get the correct value by calling $hash->{$key}. For more information on Perl and references you can read the through the tutorial.
listHash is expecting a hash and you're passing it a hash reference. Change:
listHash(\%bo_ref);
to:
listHash(%bo_ref);

Can I overload Perl's =? (And a problem while use Tie)

I choose to use tie and find this:
package Galaxy::IO::INI;
sub new {
my $invocant = shift;
my $class = ref($invocant) || $invocant;
my $self = {']' => []}; # ini section can never be ']'
tie %{$self},'INIHash';
return bless $self, $class;
}
package INIHash;
use Carp;
require Tie::Hash;
#INIHash::ISA = qw(Tie::StdHash);
sub STORE {
#$_[0]->{$_[1]} = $_[2];
push #{$_[0]->{']'}},$_[1] unless exists $_[0]->{$_[1]};
for (keys %{$_[2]}) {
next if $_ eq '=';
push #{$_[0]->{$_[1]}->{'='}},$_ unless exists $_[0]->{$_[1]}->{$_};
$_[0]->{$_[1]}->{$_}=$_[2]->{$_};
}
$_[0]->{$_[1]}->{'='};
}
if I remove the last "$[0]->{$[1]}->{'='};", it does not work correctly.
Why ?
I know a return value is required. But "$[0]->{$[1]};" cannot work correctly either, and $[0]->{$[1]}->{'='} is not the whole thing.
Old post:
I am write a package in Perl for parsing INI files.
Just something based on Config::Tiny.
I want to keep the order of sections & keys, so I use extra array to store the order.
But when I use " $Config->{newsection} = { this => 'that' }; # Add a section ", I need to overload '=' so that "newsection" and "this" can be pushed in the array.
Is this possible to make "$Config->{newsection} = { this => 'that' };" work without influence other parts ?
Part of the code is:
sub new {
my $invocant = shift;
my $class = ref($invocant) || $invocant;
my $self = {']' => []}; # ini section can never be ']'
return bless $self, $class;
}
sub read_string {
if ( /^\s*\[\s*(.+?)\s*\]\s*$/ ) {
$self->{$ns = $1} ||= {'=' => []}; # ini key can never be '='
push #{$$self{']'}},$ns;
next;
}
if ( /^\s*([^=]+?)\s*=\s*(.*?)\s*$/ ) {
push #{$$self{$ns}{'='}},$1 unless defined $$self{$ns}{$1};
$self->{$ns}->{$1} = $2;
next;
}
}
sub write_string {
my $self = shift;
my $contents = '';
foreach my $section (#{$$self{']'}}) {
}}
Special Symbols for Overload
lists the behaviour of Perl overloading for '='.
The value for "=" is a reference to a function with three arguments, i.e., it looks like the other values in use overload. However, it does not overload the Perl assignment operator. This would go against Camel hair.
So you will probably need to rethink your approach.
This is not exactly JUST operator overloading, but if you absolutely need this functionality, you can try a perl tie:
http://perldoc.perl.org/functions/tie.html
Do you know about Config::IniFiles? You might consider that before you go off and reinvent it. With some proper subclassing, you can add ordering to it.
Also, I think you have the wrong interface. You're exposing the internal structure of your object and modifying it through magical assignments. Using methods would make your life much easier.