I don't get this code?

You take the keys in turn and break them into their constituant parts.

while(my($key,$val) = each(%ret)) {
  my @parts = split(/\./, $key);
  my $id = '';
  foreach my $add (@parts) {
[download]

Then you iterate over those parts and concatenate them back together, piece by piece, into $id.

    $id .= $add;
[download]

And then, if $id (so far) doesn't match $key, you skip to the next iteration

    if($id eq $key) {
      next;
    }
[download]

Which means you'll never reach this code, until you've completely re-built $id to match $key.

    if(!$ret{$id}{'count'}) {
      $ret{$id}{'count'} = 0;
      $ret{$id}{'head_count'} = 'head_count';
      $ret{$id}{'cat_count'} = 'cat_count';
      $ret{$id}{'subcat_count'} = 'subcat_count';
    }
    $ret{$id}{'count'} += $ret{$key}{'count'};
    $id .= '.';
  }

}
[download]

Which, unless I'm missing something (quite possible), there is no need for split or the for loop as this would do the same thing:

while(my($key,$val) = each(%ret)) {
    $id = $key;
    if(!$ret{$id}{'count'}) {
      $ret{$id}{'count'} = 0;
      $ret{$id}{'head_count'} = 'head_count';
      $ret{$id}{'cat_count'} = 'cat_count';
      $ret{$id}{'subcat_count'} = 'subcat_count';
    }
## Though this doesn't do much?
    $ret{$id}{'count'} += $ret{$key}{'count'};
}
[download]

What did I miss?

BTW. It won't help much towards your performance goal, but you can save a bit of memory by changing:

my @keys = sort keys %cats;
my $cnt = scalar @keys;
...
@keys = keys %ids;
$cnt = scalar @keys;
...
@keys = keys %ret;
$cnt = scalar @keys;
[download]

to

my $cnt = keys %cat;
...
$cnt = keys %ids;
...
$cnt = keys %ret;
[download]

which does the same thing without copying all the keys to an array or sorting one set of them for no reason. Actually, if your low on memory, avoiding that sort and the (re-)allocation of those arrays might help your performance.

Let me try to elaborate.. This code:

foreach my $id (0..$x)
{
  my $cat = $ids{$id};
  if(!$ret{$ids{$id}}{'count'})
  {
    $ret{$ids{$id}}{'count'} = 0;
    $ret{$ids{$id}}{'head_count'} = 'head_count';
    $ret{$ids{$id}}{'cat_count'} = 'cat_count';
    $ret{$ids{$id}}{'subcat_count'} = 'subcat_count';
  }
  $ret{$ids{$id}}{'count'}++;
}
[download]

.. builds a hash where the key is something like "a.b.c.d". .. The problem is the total for a.b.c needs to be a sum of all the categories beneath it a.b.c.* and thus the top level category is the sum of "a.*".

This "summation" is handled by the next snippet:

while(my($key,$val) = each(%ret))
{
  my @parts = split(/\./, $key);
  my $id = '';
  foreach my $add (@parts)
  {
    $id .= $add;
    if($id eq $key)
    {
      next;
    }
    if(!$ret{$id}{'count'})
    {
      $ret{$id}{'count'} = 0;
      $ret{$id}{'head_count'} = 'head_count';
      $ret{$id}{'cat_count'} = 'cat_count';
      $ret{$id}{'subcat_count'} = 'subcat_count';
    }
    $ret{$id}{'count'} += $ret{$key}{'count'};
    $id .= '.';
  }

}
[download]


In the example where $key = 'a.b.c.d' each loop of the foreach loop would look something like:


Loop #1: a
Loop #2: a.b
Loop #3: a.b.c
Loop #4: a.b.c.d. (skipped)
[download]


I hope this clarifies!

- dEvNuL