Mercurial > pub > Impl
annotate Lib/IMPL/Resources/Format.pm @ 148:e6447ad85cb4
DOM objects now have a schema and schemaSource properties
RegExp now can launder data
Improved post to DOM transformation (multiple values a now supported)
Added new axes to navigation queries: ancestor and descendant
minor changes and bug fixes
| author | wizard | 
|---|---|
| date | Mon, 16 Aug 2010 08:26:44 +0400 | 
| parents | 196bf443b5e1 | 
| children | 4d0e1962161c | 
| 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: 
49diff
changeset | 10 my ($string,$args,$resolver) = @_; | 
| 49 | 11 | 
| 148 
e6447ad85cb4
DOM objects now have a schema and schemaSource properties
 wizard parents: 
104diff
changeset | 12 $args ||= {}; | 
| 104 
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
 wizard parents: 
49diff
changeset | 13 $resolver ||= \&_defaultResolver; | 
| 
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
 wizard parents: 
49diff
changeset | 14 | 
| 
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
 wizard parents: 
49diff
changeset | 15 $string =~ s/%(\w+(?:\.\w+)*)%/_getvalue($args,$1,"\[$1\]",$resolver)/ge; | 
| 49 | 16 | 
| 17 return $string; | |
| 18 } | |
| 19 | |
| 20 sub _getvalue { | |
| 104 
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
 wizard parents: 
49diff
changeset | 21 my ($obj,$path,$default,$resolver) = @_; | 
| 49 | 22 | 
| 23 foreach my $chunk (split /\./,$path) { | |
| 104 
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
 wizard parents: 
49diff
changeset | 24 return $default unless $obj; | 
| 
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
 wizard parents: 
49diff
changeset | 25 if (ref $obj eq 'HASH') { | 
| 49 | 26 $obj = $obj->{$chunk}; | 
| 27 } else { | |
| 104 
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
 wizard parents: 
49diff
changeset | 28 $obj = $resolver->($obj,$chunk); | 
| 49 | 29 } | 
| 30 } | |
| 31 return $obj; | |
| 32 } | |
| 33 | |
| 104 
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
 wizard parents: 
49diff
changeset | 34 sub _defaultResolver { | 
| 
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
 wizard parents: 
49diff
changeset | 35 my ($obj,$prop) = @_; | 
| 
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
 wizard parents: 
49diff
changeset | 36 | 
| 
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
 wizard parents: 
49diff
changeset | 37 return ( eval { $obj->can($prop) } ? $obj->$prop() : undef ); | 
| 
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
 wizard parents: 
49diff
changeset | 38 } | 
| 
196bf443b5e1
DOM::Schema RC0 inflators support, validation and some other things,
 wizard parents: 
49diff
changeset | 39 | 
| 49 | 40 1; | 
