diff options
| -rw-r--r-- | lib/WebCoso/Resource.pm | 40 |
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; } } |