libs/misc/HashExt.pm

#################################
#
#  $Id$
#
#  $Log$
#
#################################


package OneLineDumpHash;

use strict;
use warnings;

use overload
  '""' => \&stringify,
  ;

sub new {
  #print "new: ", __PACKAGE__, "\n";
  my $class = shift;
  my $value = shift;
  #tie(%{$value}, "Tie::IxHash");
  #return bless \$value => $class;  
  return bless $value => $class;  
}

sub stringify {
  my ($x, $y) = @_;
  
  # dereference value
  # TODO: clear this!!!
  my $value;
  if ( ref($x) eq 'OneLineDumpHash' ) {
   $value = $x;
  } else {
   $value = $$x;
  }
  
  my @entries;
  foreach my $h_key (keys %{$value}) {
    my $h_val = $value->{$h_key};
    push @entries, "$h_key: $h_val";
  }
  return join "  /  ", @entries;
}


package SummableHash;

use strict;
use warnings;

use base qw(OneLineDumpHash);

use overload
  '+=' => \&sum_hash,
  ;

use Tie::IxHash;
use Data::Dumper;

sub new {
  #print "new: ", __PACKAGE__, "\n";
  my $class = shift;
  my $value = shift;
  tie(%{$value}, "Tie::IxHash");
  return bless \$value => $class;  
}


sub sum_hash {
  
  #print Dumper(@_);
  my ($x, $y) = @_;
  #print "x: ";
  #print Dumper($x);
  #print "y: ";
  #print Dumper($y);
  my $value = $$x;
  
  #$value->{sumCount}++;
  foreach my $key (keys %{$y}) {
    # initialize key if undefined yet to prevent "Use of uninitialized value in addition (+) at [...]"
    $value->{$key} ||= 0;
    # sum up statistic-counts
    $value->{$key} += $y->{$key};
  }
  
  return bless \$value => ref($x);
}

1;
1	#################################
2	#
3	# $Id$
4	#
5	# $Log$
6	#
7	#################################
8
9
10	package OneLineDumpHash;
11
12	use strict;
13	use warnings;
14
15	use overload
16	'""' => \&stringify,
17	;
18
19	sub new {
20	#print "new: ", __PACKAGE__, "\n";
21	my $class = shift;
22	my $value = shift;
23	#tie(%{$value}, "Tie::IxHash");
24	#return bless \$value => $class;
25	return bless $value => $class;
26	}
27
28	sub stringify {
29	my ($x, $y) = @_;
30
31	# dereference value
32	# TODO: clear this!!!
33	my $value;
34	if ( ref($x) eq 'OneLineDumpHash' ) {
35	$value = $x;
36	} else {
37	$value = $$x;
38	}
39
40	my @entries;
41	foreach my $h_key (keys %{$value}) {
42	my $h_val = $value->{$h_key};
43	push @entries, "$h_key: $h_val";
44	}
45	return join " / ", @entries;
46	}
47
48
49	package SummableHash;
50
51	use strict;
52	use warnings;
53
54	use base qw(OneLineDumpHash);
55
56	use overload
57	'+=' => \&sum_hash,
58	;
59
60	use Tie::IxHash;
61	use Data::Dumper;
62
63	sub new {
64	#print "new: ", __PACKAGE__, "\n";
65	my $class = shift;
66	my $value = shift;
67	tie(%{$value}, "Tie::IxHash");
68	return bless \$value => $class;
69	}
70
71
72	sub sum_hash {
73
74	#print Dumper(@_);
75	my ($x, $y) = @_;
76	#print "x: ";
77	#print Dumper($x);
78	#print "y: ";
79	#print Dumper($y);
80	my $value = $$x;
81
82	#$value->{sumCount}++;
83	foreach my $key (keys %{$y}) {
84	# initialize key if undefined yet to prevent "Use of uninitialized value in addition (+) at [...]"
85	$value->{$key} \|\|= 0;
86	# sum up statistic-counts
87	$value->{$key} += $y->{$key};
88	}
89
90	return bless \$value => ref($x);
91	}
92
93	1;
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26