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