annotate Lib/IMPL/Resources/Format.pm @ 31:d59526f6310e

Small fixes to Test framework (correct handlinf of the compilation errors in the test units) Imported and refactored SQL DB schema from the old project
author Sergey
date Mon, 09 Nov 2009 01:39:16 +0300
parents 818c74b038ae
children 16ada169ca75
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
18
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
1 package IMPL::Resources::Format;
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
2 use strict;
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
3 use warnings;
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
4
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
5 require Exporter;
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
6 our @ISA = qw(Exporter);
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
7 our @EXPORT_OK = qw(&FormatMessage);
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
8
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
9 sub FormatMessage {
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
10 my ($string,$args) = @_;
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
11
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
12 $string =~ s/%(\w+(?:\.\w+)*)%/_getvalue($args,$1,"\[$1\]")/ge;
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
13
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
14 return $string;
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
15 }
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
16
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
17 sub _getvalue {
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
18 my ($obj,$path,$default) = @_;
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
19
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
20 foreach my $chunk (split /\./,$path) {
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
21 if (eval { $obj->can( $chunk ) } ) {
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
22 $obj = $obj->$chunk();
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
23 } elsif (UNIVERSAL::isa($obj,'HASH')) {
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
24 $obj = $obj->{$chunk};
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
25 } else {
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
26 return $default;
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
27 }
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
28 }
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
29 return $obj;
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
30 }
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
31
818c74b038ae DOM Schema + tests
Sergey
parents:
diff changeset
32 1;