aboutsummaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/WebCoso/Resource.pm40
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;
}
}