passa un po' di test, non tutti; parecchio debug

git-svn-id: svn://luxion/repos/WebCoso/trunk@148 fcb26f47-9200-0410-b104-b98ab5b095f3

1 files changed, 35 insertions, 3 deletions

diff --git a/lib/WebCoso/Resource.pm b/lib/WebCoso/Resource.pm
index b881e18..bb807ad 100644
--- a/lib/WebCoso/Resource.pm
+++ b/lib/WebCoso/Resource.pm
@@ -3,6 +3,7 @@ use strict;
 use warnings;
 use Class::Std;
 #use WebCoso::X;
+use Data::Dumper;$Data::Dumper::Useqq=1;
 
 {
 my %values_of :ATTR(:default<{}>);
@@ -41,9 +42,24 @@ sub get_property {
     my $axes_spec= (ref($_[0]) eq 'HASH') ? (shift) : {};
     my ($prop_name)=@_;
 
-    my $key=_genkey($axes_spec);
+    print STDERR Data::Dumper->Dump([$self,$axes_spec,$prop_name],[qw(self axes_spec prop_name)]);
+
+    my $key_rx=_genkey_retr($axes_spec);
+
+    my $values_ref=$values_of{ident $self}->{$prop_name};
+
+    print STDERR Data::Dumper->Dump([$values_ref],['values_ref']);
 
-    return $values_of{ident $self}->{$prop_name}->{$key};
+    my @keys=sort {($a=~tr/\000//) <=> ($b=~tr/\000//)} keys %$values_ref;
+
+    for my $key (@keys) {
+        print STDERR Data::Dumper->Dump([$key],['testing key']);
+        if ($key =~ m{$key_rx}) {
+            return $values_ref->{$key};
+        }
+    }
+
+    return;
 }
 
 sub _populate_axes_from {
@@ -60,11 +76,27 @@ sub _populate_axes_from {
 sub _genkey {
     my ($axes_spec)=@_;
 
-    my $key=join "\000",map {$_."\001".$axes_spec->{$_}} sort keys %$axes_spec;
+    my $key="\000";
+    $key.=join "\000",map {$_."\001".$axes_spec->{$_}} sort keys %$axes_spec;
+    $key.="\000";
+
+    print STDERR Data::Dumper->Dump([$key],['chiave']);
 
     return $key;
 }
 
+sub _genkey_retr {
+    my ($axes_spec)=@_;
+
+    my $rx="(?:\000";
+    $rx.=join "\000)?(?:",map {quotemeta($_)."\001".quotemeta($axes_spec->{$_})}  sort keys %$axes_spec;
+    $rx.="\000)?";
+
+    print STDERR Data::Dumper->Dump([$rx],['regexp']);
+
+    return qr{$rx};
+}
+
 }
 
 1;