Mercurial > pub > Impl
annotate Lib/IMPL/Resources/Format.pm @ 389:5aff94ba842f
DOM Schema refactoring complete
| author | cin |
|---|---|
| date | Wed, 12 Feb 2014 13:36:24 +0400 |
| parents | 2f16f13b000c |
| children |
| rev | line source |
|---|---|
| 49 | 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 { | |
|
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
49
diff
changeset
|
10 my ($string,$args,$resolver) = @_; |
| 49 | 11 |
|
148
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
wizard
parents:
104
diff
changeset
|
12 $args ||= {}; |
|
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
49
diff
changeset
|
13 $resolver ||= \&_defaultResolver; |
| 368 | 14 $string ||= ''; |
|
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
49
diff
changeset
|
15 |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
49
diff
changeset
|
16 $string =~ s/%(\w+(?:\.\w+)*)%/_getvalue($args,$1,"\[$1\]",$resolver)/ge; |
| 49 | 17 |
| 18 return $string; | |
| 19 } | |
| 20 | |
| 21 sub _getvalue { | |
|
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
49
diff
changeset
|
22 my ($obj,$path,$default,$resolver) = @_; |
| 49 | 23 |
| 24 foreach my $chunk (split /\./,$path) { | |
| 194 | 25 return $default unless $obj; |
|
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
49
diff
changeset
|
26 if (ref $obj eq 'HASH') { |
| 49 | 27 $obj = $obj->{$chunk}; |
| 28 } else { | |
|
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
49
diff
changeset
|
29 $obj = $resolver->($obj,$chunk); |
| 49 | 30 } |
| 31 } | |
| 368 | 32 return $obj||'<undef>'; |
| 49 | 33 } |
| 34 | |
|
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
49
diff
changeset
|
35 sub _defaultResolver { |
| 194 | 36 my ($obj,$prop) = @_; |
| 37 | |
| 383 | 38 return eval { $obj->$prop() }; |
|
104
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
49
diff
changeset
|
39 } |
|
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
wizard
parents:
49
diff
changeset
|
40 |
| 49 | 41 1; |
