[Bps-public-commit] r15813 - in Data-Hierarchy/trunk: .

[clkao at bestpractical.com]

Author: clkao
Date: Mon Sep  8 07:05:08 2008
New Revision: 15813

Modified:
   Data-Hierarchy/trunk/   (props changed)
   Data-Hierarchy/trunk/Hierarchy.pm
   Data-Hierarchy/trunk/t/7performance.t

Log:
 r35449 at mtl (orig r384):  glasser | 2006-11-03 11:11:24 +0800
 Make _ancestors scale better.  (Performance test down to ~2.  Must get better!)
 


Modified: Data-Hierarchy/trunk/Hierarchy.pm
==============================================================================
--- Data-Hierarchy/trunk/Hierarchy.pm	(original)
+++ Data-Hierarchy/trunk/Hierarchy.pm	Mon Sep  8 07:05:08 2008
@@ -338,9 +338,24 @@
 sub _ancestors {
     my ($self, $hash, $path) = @_;
 
+    my @ancestors;
+    push @ancestors, '' if exists $hash->{''};
+
+    # Special case the root.
+    return @ancestors if $path eq '';
+
+    my @parts = split m{\Q$self->{sep}}, $path;
+    # Remove empty string at the front.
+    shift @parts;
+
+    my $current = '';
+    for my $part (@parts) {
+        $current .= $self->{sep} . $part;
+        push @ancestors, $current if exists $hash->{$current};
+    }
+
     # XXX: could build cached pointer for fast traversal
-    return sort grep {index($path.$self->{sep}, $_.$self->{sep}) == 0}
-	keys %$hash;
+    return @ancestors;
 }
 
 # Internal method.

Modified: Data-Hierarchy/trunk/t/7performance.t
==============================================================================
--- Data-Hierarchy/trunk/t/7performance.t	(original)
+++ Data-Hierarchy/trunk/t/7performance.t	Mon Sep  8 07:05:08 2008
@@ -27,8 +27,6 @@
 
 my $growth = order_of_growth(N, sub {
                                  my $n = shift;
-                                 diag "doing $n";
-                                 
                                  my $d = Data::Hierarchy->new;
                                  my $kv = { foo => 'bar' };
                                  while ($n > 0) {