libs/misc/HashExt.pm

#################################
#
#  $Id: HashExt.pm,v 1.1 2002/10/10 03:44:54 cvsjoko Exp $
#
#  $Log: HashExt.pm,v $
#  Revision 1.1  2002/10/10 03:44:54  cvsjoko
#  + new
#
#
#################################


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