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	cvsjoko	1.1	#################################
2			#
3	joko	1.2	# $Id: HashExt.pm,v 1.1 2002/10/10 03:44:54 cvsjoko Exp $
4	cvsjoko	1.1	#
5	joko	1.2	# $Log: HashExt.pm,v $
6			# Revision 1.1 2002/10/10 03:44:54 cvsjoko
7			# + new
8			#
9	cvsjoko	1.1	#
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