passa tutti i test. mancano i controlli per evitare la sovrapopoplazione degli hash

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

1 files changed, 25 insertions, 15 deletions

diff --git a/lib/WebCoso/Resource.pm b/lib/WebCoso/Resource.pm
index bb807ad..29146f2 100644
--- a/lib/WebCoso/Resource.pm
+++ b/lib/WebCoso/Resource.pm
@@ -3,7 +3,7 @@ use strict;
 use warnings;
 use Class::Std;
 #use WebCoso::X;
-use Data::Dumper;$Data::Dumper::Useqq=1;
+#use Smart::Comments;$Data::Dumper::Useqq=1;
 
 {
 my %values_of :ATTR(:default<{}>);
@@ -42,19 +42,24 @@ sub get_property {
     my $axes_spec= (ref($_[0]) eq 'HASH') ? (shift) : {};
     my ($prop_name)=@_;
 
-    print STDERR Data::Dumper->Dump([$self,$axes_spec,$prop_name],[qw(self axes_spec prop_name)]);
+    ### $self
+    ### $axes_spec
+    ### $prop_name
 
-    my $key_rx=_genkey_retr($axes_spec);
+    my $req_key=_genkey($axes_spec);
 
     my $values_ref=$values_of{ident $self}->{$prop_name};
 
-    print STDERR Data::Dumper->Dump([$values_ref],['values_ref']);
+    ### $values_ref
 
-    my @keys=sort {($a=~tr/\000//) <=> ($b=~tr/\000//)} keys %$values_ref;
+    my @keys=sort {($a=~tr/\001//) <=> ($b=~tr/\001//)} keys %$values_ref;
 
     for my $key (@keys) {
-        print STDERR Data::Dumper->Dump([$key],['testing key']);
-        if ($key =~ m{$key_rx}) {
+        ### testing key: $key
+
+        my $key_rx=_genrx_from_key($key);
+
+        if ($req_key =~ m{$key_rx}) {
             return $values_ref->{$key};
         }
     }
@@ -80,21 +85,26 @@ sub _genkey {
     $key.=join "\000",map {$_."\001".$axes_spec->{$_}} sort keys %$axes_spec;
     $key.="\000";
 
-    print STDERR Data::Dumper->Dump([$key],['chiave']);
+    ### chiave: $key
 
     return $key;
 }
 
-sub _genkey_retr {
-    my ($axes_spec)=@_;
+sub _genrx_from_key {
+    my ($key)=@_;
+
+    my (undef,@axes)=split /\000/,$key;
+
+    ### axes form key: \@axes
 
-    my $rx="(?:\000";
-    $rx.=join "\000)?(?:",map {quotemeta($_)."\001".quotemeta($axes_spec->{$_})}  sort keys %$axes_spec;
-    $rx.="\000)?";
+    my $rx="(?:";
+    $rx.=join "\000).*?(?:",map {quotemeta($_)} @axes;
+    $rx.=")";
+    $rx=qr{^\000.*?${rx}(?:\000|$)};
 
-    print STDERR Data::Dumper->Dump([$rx],['regexp']);
+    ### regexp: $rx
 
-    return qr{$rx};
+    return $rx;
 }
 
 }