annotate lib/IMPL/Resources/StringMap.pm @ 408:5c80e33f1218 ref20150831

added 'coarsen' function
author cin
date Mon, 07 Sep 2015 01:35:25 +0300
parents c6e90e02dd17
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
407
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
1 package IMPL::Resources::StringMap;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
2 use strict;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
3
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
4 use IMPL::Const qw(:prop);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
5 use IMPL::declare {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
6 require => {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
7 Exception => 'IMPL::Exception',
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
8 IOException => '-IMPL::IOException',
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
9 ArgException => '-IMPL::InvalidArgumentException'
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
10 },
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
11 base => [
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
12 'IMPL::Object' => '@_'
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
13 ],
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
14 props => [
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
15 _data => PROP_RW,
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
16 _parent => PROP_RW
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
17 ]
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
18 };
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
19
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
20 sub CTOR {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
21 my ($this,$data,$parent) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
22
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
23 die ArgException->new( data => 'A hash reference is required' )
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
24 unless ref($data) eq 'HASH';
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
25
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
26 die ArgException->new( data => 'A hash must contain either scalars or subs')
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
27 if grep ref($_) && ref($_) ne 'CODE', values %$data;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
28
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
29 $this->_data($data);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
30 $this->_parent($parent);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
31 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
32
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
33 sub GetString {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
34 my ($this,$id,$args) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
35
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
36 if(my $format = $this->_data->{$id}) {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
37 return ref($format) eq 'CODE' ? &$format($this,$args || {}) : $this->FormatString($format,$args);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
38 } else {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
39 return $this->_parent? $this->_parent->GetString($id,$args) : "[ $id ]";
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
40 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
41
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
42 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
43
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
44 sub AddFormat {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
45 my ($this,$id,$format) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
46
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
47 die ArgException->new( id => 'A format id is required' )
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
48 unless $id;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
49
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
50 die ArgException->new( format => 'A format must be a scalar or a sub' )
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
51 if ref($format) and ref($format) ne 'CODE';
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
52
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
53 $this->_data->{$id} = $format;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
54 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
55
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
56 sub FormatString {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
57 my ($self,$text,$args) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
58
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
59 $args ||= {};
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
60 $text ||= '';
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
61
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
62 $text =~ s/%(\w+(?:\.\w+)*)%/$self->GetValue($args,$1,"\[$1\]")/ge;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
63
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
64 return $text;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
65
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
66 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
67
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
68 sub GetValue {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
69 my ($self,$obj,$path,$default) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
70
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
71 foreach my $chunk (split /\./,$path) {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
72 return $default unless $obj;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
73 if (ref $obj eq 'HASH') {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
74 $obj = $obj->{$chunk};
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
75 } else {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
76 $obj = $self->Resolve($obj,$chunk);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
77 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
78 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
79 return $obj||'<undef>';
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
80 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
81
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
82 sub Resolve {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
83 my ($self,$obj,$prop) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
84
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
85 return eval { $obj->$prop() };
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
86 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
87
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
88 1;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
89
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
90 __END__
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
91
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
92 =pod
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
93
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
94 =head1 NAME
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
95
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
96 C<IMPL::Web::Resources::StringMap>
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
97
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
98 =head1 SYNOPSIS
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
99
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
100 =begin code
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
101
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
102 use IMPL::require {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
103 StringMap => 'IMPL::Resources::StringMap'
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
104 };
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
105
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
106 my $data = {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
107 TitleLabel => 'Search results',
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
108 ViewLabel => 'View %name%', # same as sub { $_[0]->Format('View %name%',$_[1]) }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
109 ResultsCountLabel => sub {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
110 my ($self,$args) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
111
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
112 $args ||= {};
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
113
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
114 if (not $args->{count}) {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
115 return "No items found";
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
116 } elsif($args->{count} == 1) {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
117 return "Found one item";
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
118 } else {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
119 return $self->Format('Found %count% items', $args);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
120 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
121 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
122 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
123
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
124 my $def = StringMap->new({
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
125 ResultsCountLabel => 'Found %count% items'
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
126 });
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
127
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
128 my $map = StringMap->new($data, $def);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
129
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
130 print $map->GetString('TitleLabel');
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
131 print $map->GetString(ResultsCountLabel => { count => 0 }); # will print "No items found"
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
132
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
133
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
134 =end code
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
135
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
136 =head1 DESCRIPTION
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
137
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
138 =head1 MEMBERS
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
139
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
140 =cut