From 6e1a9358e1ac891bd81bef6e123374cecb1906e5 Mon Sep 17 00:00:00 2001 From: dakkar Date: Sat, 4 Feb 2006 13:03:54 +0000 Subject: passa un po' di test, non tutti; parecchio debug git-svn-id: svn://luxion/repos/WebCoso/trunk@148 fcb26f47-9200-0410-b104-b98ab5b095f3 --- lib/WebCoso/Resource.pm | 38 +++++++++++++++++++++++++++++++++++--- 1 file 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; -- cgit v1.2.3