[Bps-public-commit] r15796 - Data-Hierarchy/trunk

[clkao at bestpractical.com]

Author: clkao
Date: Mon Sep  8 06:51:26 2008
New Revision: 15796

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

Log:
 r35235 at mtl (orig r170):  clkao | 2004-09-11 06:39:07 +0800
 unify key checking


Modified: Data-Hierarchy/trunk/Hierarchy.pm
==============================================================================
--- Data-Hierarchy/trunk/Hierarchy.pm	(original)
+++ Data-Hierarchy/trunk/Hierarchy.pm	Mon Sep  8 06:51:26 2008
@@ -43,16 +43,24 @@
     return $self;
 }
 
+sub key_safe {
+    use Carp;
+    confess 'key unsafe' unless $_[1];
+    confess 'key unsafe'
+	if length ($_[1]) > 1 && substr ($_[1], -1, 1) eq $_[0]->{sep};
+
+    $_[1] =~ s/\Q$_[0]->{sep}\E+$//;
+}
+
 sub store_single {
     my ($self, $key, $value) = @_;
-    $key =~ s/$self->{sep}$//;
+    $self->key_safe ($key);
     $self->{hash}{$key} = $value;
 }
 
 sub _store {
     my ($self, $key, $value) = @_;
-
-    $key =~ s/$self->{sep}$//;
+    $self->key_safe ($key);
 
     my $oldvalue = $self->{hash}{$key} if exists $self->{hash}{$key};
     my $hash = {%{$oldvalue||{}}, %$value};
@@ -108,7 +116,7 @@
 sub _store_recursively {
     my ($self, $key, $value, $hash) = @_;
 
-    $key =~ s/$self->{sep}$//;
+    $self->key_safe ($key);
     my @datapoints = $self->_descendents ($hash, $key);
 
     for (@datapoints) {
@@ -152,6 +160,7 @@
     $self->_store ($key, $value);
 }
 
+# Useful for removing sticky properties.
 sub store_recursively {
     my ($self, $key, $value) = @_;
 
@@ -162,7 +171,7 @@
 
 sub find {
     my ($self, $key, $value) = @_;
-    $key =~ s/$self->{sep}$//;
+    $self->key_safe ($key);
     my @items;
     my @datapoints = $self->descendents($key);
 
@@ -189,9 +198,7 @@
 
 sub get {
     my ($self, $key, $rdonly) = @_;
-    use Carp;
-    confess unless $key;
-    $key =~ s/$self->{sep}$//;
+    $self->key_safe ($key);
     my $value = {};
     # XXX: could build cached pointer for fast traversal
     my @datapoints = sort grep {$_.$self->{sep} eq substr($key.$self->{sep}, 0,