in reply to Using += in array context

#!/opt/perl/bin/perl -w

use strict;

use Tie::Hash;
 
package Hash::Add;
 
@Hash::Add::ISA = qw /Tie::StdHash/;
 
 
use overload '+' => sub { 
    my ($self, $other) = @_;
 
    foreach my $key (keys %$self) {
        $self -> {$key} += $other -> {$key};                 
    }
};

package main;
 
my $totals = tie my %totals => 'Hash::Add';
my $delta  = tie my %delta  => 'Hash::Add';

my @fields = qw /foo bar/;
 
@totals {@fields} = (10, 20);
@delta  {@fields} =  (5,  6);

$totals += $delta;
 
print "Foo = $totals{foo}\n";
print "Bar = $totals{bar}\n";

__END__
Foo = 15
Bar = 26

[download]

-- Abigail

Replies are listed 'Best First'.
Re: Re: Using += in array context
by bikeNomad (Priest) on Jun 05, 2001 at 21:12 UTC
    Good idea! of course, this doesn't work if you only want to add up some of the fields in the hash. It sums up all the fields in the receiver. Perhaps this modification to abigail's code would be an improvement, since it allows you to specify the desired fields:

    #!/opt/perl/bin/perl -w
use strict;
use Data::Dumper;
use Tie::Hash;
 
package Hash::Add;
 
@Hash::Add::ISA = qw /Tie::StdHash/;

sub sumFields {
 my $self = shift;
 $self->{__summedFields} = [ @_ ];
}

sub TIEHASH {
 my $classname = shift;
 my $self = $classname->SUPER::TIEHASH;
 $self->sumFields(@_);
 $self;
}
 
use overload '+' => sub { 
    my ($self, $other) = @_;
 my @keys = @{$self->{__summedFields}};
 @keys = keys(%$self) if (!@keys);
 
    foreach my $key (@keys) {
  next if $key eq '__summedFields';
        $self -> {$key} += $other -> {$key};                 
    }
};

package main;
 
my @fields = qw /foo bar/;
my $totals = tie my %totals => 'Hash::Add', @fields;
my $delta = tie my %delta => 'Tie::StdHash';
@totals{ 'a', 'z' } = ( 123, 456 );
@delta{ 'a', 'z' } = ( 789, 234 );

@totals {@fields} = (10, 20);
@delta  {@fields} =  (5,  6);

$totals += $delta;
 
print "Foo = $totals{foo}\n";
print "Bar = $totals{bar}\n";

__END__
Foo = 15
Bar = 26

    [download]
    update: set fields a and z in right place
[reply]
[d/l]

In Section Seekers of Perl Wisdom