comparison Lib/IMPL/Resources/Format.pm @ 104:196bf443b5e1

DOM::Schema RC0 inflators support, validation and some other things, Minor and major fixes almost for everything. A 'Source' property of the ValidationErrors generated from a NodeSet or a NodeList is subject to change in the future.
author wizard
date Tue, 11 May 2010 02:42:59 +0400
parents 16ada169ca75
children e6447ad85cb4
comparison
equal deleted inserted replaced
103:c289ed9662ca 104:196bf443b5e1
5 require Exporter; 5 require Exporter;
6 our @ISA = qw(Exporter); 6 our @ISA = qw(Exporter);
7 our @EXPORT_OK = qw(&FormatMessage); 7 our @EXPORT_OK = qw(&FormatMessage);
8 8
9 sub FormatMessage { 9 sub FormatMessage {
10 my ($string,$args) = @_; 10 my ($string,$args,$resolver) = @_;
11 11
12 $string =~ s/%(\w+(?:\.\w+)*)%/_getvalue($args,$1,"\[$1\]")/ge; 12 $resolver ||= \&_defaultResolver;
13
14 $string =~ s/%(\w+(?:\.\w+)*)%/_getvalue($args,$1,"\[$1\]",$resolver)/ge;
13 15
14 return $string; 16 return $string;
15 } 17 }
16 18
17 sub _getvalue { 19 sub _getvalue {
18 my ($obj,$path,$default) = @_; 20 my ($obj,$path,$default,$resolver) = @_;
19 21
20 foreach my $chunk (split /\./,$path) { 22 foreach my $chunk (split /\./,$path) {
21 if (eval { $obj->can( $chunk ) } ) { 23 return $default unless $obj;
22 $obj = $obj->$chunk(); 24 if (ref $obj eq 'HASH') {
23 } elsif (UNIVERSAL::isa($obj,'HASH')) {
24 $obj = $obj->{$chunk}; 25 $obj = $obj->{$chunk};
25 } else { 26 } else {
26 return $default; 27 $obj = $resolver->($obj,$chunk);
27 } 28 }
28 } 29 }
29 return $obj; 30 return $obj;
30 } 31 }
31 32
33 sub _defaultResolver {
34 my ($obj,$prop) = @_;
35
36 return ( eval { $obj->can($prop) } ? $obj->$prop() : undef );
37 }
38
32 1; 39 1;