annotate lib/IMPL/Resources/Format.pm @ 427:09e0086a82a7 ref20150831 tip

Merge
author cin
date Tue, 15 May 2018 00:51:33 +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::Format;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
2 use strict;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
3 use warnings;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
4
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
5 require Exporter;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
6 our @ISA = qw(Exporter);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
7 our @EXPORT_OK = qw(&FormatMessage);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
8
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
9 sub FormatMessage {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
10 my ($string,$args,$resolver) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
11
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
12 $args ||= {};
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
13 $resolver ||= \&_defaultResolver;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
14 $string ||= '';
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
15
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
16 $string =~ s/%(\w+(?:\.\w+)*)%/_getvalue($args,$1,"\[$1\]",$resolver)/ge;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
17
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
18 return $string;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
19 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
20
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
21 sub _getvalue {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
22 my ($obj,$path,$default,$resolver) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
23
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
24 foreach my $chunk (split /\./,$path) {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
25 return $default unless $obj;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
26 if (ref $obj eq 'HASH') {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
27 $obj = $obj->{$chunk};
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
28 } else {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
29 $obj = $resolver->($obj,$chunk);
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
30 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
31 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
32 return $obj||'<undef>';
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
33 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
34
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
35 sub _defaultResolver {
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
36 my ($obj,$prop) = @_;
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
37
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
38 return eval { $obj->$prop() };
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
39 }
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
40
c6e90e02dd17 renamed Lib->lib
cin
parents:
diff changeset
41 1;