#!/usr/bin/perl -w use strict; use warnings; my $ar=[ {sex=>'m',occupation=>'programmer',state=>'CA'}, {sex=>'m',occupation=>'blah1',state=>'CA'}, {sex=>'m',occupation=>'blah1',state=>'NY'}, {sex=>'m',occupation=>'blah2',state=>'NY'}, {sex=>'f',occupation=>'blah1',state=>'NY'}, {sex=>'f',occupation=>'blah2',state=>'NJ'}, ]; printer(counter($ar,['sex'])); printer(counter($ar,['sex','state'])); printer(counter($ar,['sex','occupation'])); printer(counter($ar,[])); exit; sub printer{ use Data::Dumper; my $ref=shift; local $Data::Dumper::Deepcopy=1; local $Data::Dumper::Purity=1; local $Data::Dumper::Sortkeys=1; local $Data::Dumper::Indent=2; print Dumper($ref)."\n"; } # printer sub counter { my $arin=shift; my $arparts=shift; my $res={}; my $size1=scalar(@$arparts)-1; return $res unless ($size1 >=0); my $size2=$size1-1; for my $hash (@$arin){ my @parts=(); for my $key (@$arparts){ my $val=$hash->{$key}; if (!defined ($val)) {$val='.'} push @parts,$val; } my $reshead=$res; for my $n (0..$size2) { my $val=$parts[$n]; unless ($reshead->{$val}) {$reshead->{$val}={};} $reshead=$reshead->{$val}; } $reshead->{$parts[$size1]}++; } # hash return $res; } # counter #### $VAR1 = { 'f' => 2, 'm' => 4 }; $VAR1 = { 'f' => { 'NJ' => 1, 'NY' => 1 }, 'm' => { 'CA' => 2, 'NY' => 2 } }; $VAR1 = { 'f' => { 'blah1' => 1, 'blah2' => 1 }, 'm' => { 'blah1' => 2, 'blah2' => 1, 'programmer' => 1 } }; $VAR1 = {}; #### printer(counter($ar,['state','sex','occupation'])); #### $VAR1 = { 'CA' => { 'm' => { 'blah1' => 1, 'programmer' => 1 } }, 'NJ' => { 'f' => { 'blah2' => 1 } }, 'NY' => { 'f' => { 'blah1' => 1 }, 'm' => { 'blah1' => 1, 'blah2' => 1 } } };