annotate Lib/IMPL/Resources/StringLocaleMap.pm @ 393:69a1f1508696

minor security refactoring
author cin
date Fri, 14 Feb 2014 16:41:12 +0400
parents 2f16f13b000c
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
377
cin
parents:
diff changeset
1 package IMPL::Resources::StringLocaleMap;
cin
parents:
diff changeset
2 use strict;
cin
parents:
diff changeset
3
378
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
4 use List::Util qw(first);
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
5 use IMPL::lang qw(:base);
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
6 use IMPL::Const qw(:prop);
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
7 use IMPL::declare {
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
8 require => {
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
9 Resources => 'IMPL::Resources',
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
10 StringMap => 'IMPL::Resources::StringMap',
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
11 Exception => 'IMPL::Exception',
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
12 FS => 'File::Spec'
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
13 },
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
14 base => {
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
15 'IMPL::Object' => '@_'
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
16 },
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
17 props => [
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
18 _maps => PROP_RW,
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
19 name => PROP_RW,
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
20 paths => PROP_RW | PROP_LIST
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
21 ]
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
22 };
377
cin
parents:
diff changeset
23
378
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
24 sub CTOR {
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
25 my ($this,$data,$parent) = @_;
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
26
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
27 if (is($data, StringMap)) {
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
28 $this->_maps({ default => $data });
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
29 } elsif ( ref($data) eq 'HASH' ) {
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
30 $this->_maps({ default => StringMap->new($data,$parent)});
382
99ac2e19c0cc Implemented a strings map for a DOM schema
sergey
parents: 380
diff changeset
31 } else {
99ac2e19c0cc Implemented a strings map for a DOM schema
sergey
parents: 380
diff changeset
32 # в данном случае таблица строк по-умолчанию будет загружена
99ac2e19c0cc Implemented a strings map for a DOM schema
sergey
parents: 380
diff changeset
33 # из файла при необходимости
99ac2e19c0cc Implemented a strings map for a DOM schema
sergey
parents: 380
diff changeset
34 $this->_maps({});
378
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
35 }
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
36 }
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
37
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
38 sub GetString {
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
39 my ($this,$id,$args) = @_;
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
40
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
41 my $locale = Resources->currentLocale || 'default';
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
42 my $map;
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
43
382
99ac2e19c0cc Implemented a strings map for a DOM schema
sergey
parents: 380
diff changeset
44 #warn "id: $id,\t\tlocale: $locale";
380
1eca08048ba9 TTContext migrated to the unified localization mechanism IMPL::Resources::StringLocaleMap
cin
parents: 379
diff changeset
45
378
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
46 if(not $map = $this->_maps->{$locale}) {
382
99ac2e19c0cc Implemented a strings map for a DOM schema
sergey
parents: 380
diff changeset
47 my $default = $this->GetDefaultMap();
99ac2e19c0cc Implemented a strings map for a DOM schema
sergey
parents: 380
diff changeset
48 $map = $this->LoadMap($locale,$default);
378
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
49 if (is($map,StringMap)) {
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
50 #nop
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
51 } elsif (ref($map) eq 'HASH') {
382
99ac2e19c0cc Implemented a strings map for a DOM schema
sergey
parents: 380
diff changeset
52 $map = StringMap->new($map,$default);
378
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
53 } elsif( not $map ) {
382
99ac2e19c0cc Implemented a strings map for a DOM schema
sergey
parents: 380
diff changeset
54 $map = $default;
378
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
55 } else {
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
56 die Exception->new("ResolveLocale returned unexpected data", $map);
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
57 }
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
58
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
59 $this->_maps->{$locale} = $map;
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
60 }
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
61
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
62 return $map->GetString($id,$args);
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
63 }
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
64
382
99ac2e19c0cc Implemented a strings map for a DOM schema
sergey
parents: 380
diff changeset
65 sub GetDefaultMap {
99ac2e19c0cc Implemented a strings map for a DOM schema
sergey
parents: 380
diff changeset
66 my ($this) = @_;
99ac2e19c0cc Implemented a strings map for a DOM schema
sergey
parents: 380
diff changeset
67
99ac2e19c0cc Implemented a strings map for a DOM schema
sergey
parents: 380
diff changeset
68 my $map = $this->_maps->{default};
99ac2e19c0cc Implemented a strings map for a DOM schema
sergey
parents: 380
diff changeset
69 return $map
99ac2e19c0cc Implemented a strings map for a DOM schema
sergey
parents: 380
diff changeset
70 if $map;
99ac2e19c0cc Implemented a strings map for a DOM schema
sergey
parents: 380
diff changeset
71
99ac2e19c0cc Implemented a strings map for a DOM schema
sergey
parents: 380
diff changeset
72 $map = $this->LoadMap('default') || StringMap->new({});
99ac2e19c0cc Implemented a strings map for a DOM schema
sergey
parents: 380
diff changeset
73 $this->_maps->{default} = $map;
99ac2e19c0cc Implemented a strings map for a DOM schema
sergey
parents: 380
diff changeset
74
99ac2e19c0cc Implemented a strings map for a DOM schema
sergey
parents: 380
diff changeset
75 return $map;
99ac2e19c0cc Implemented a strings map for a DOM schema
sergey
parents: 380
diff changeset
76 }
99ac2e19c0cc Implemented a strings map for a DOM schema
sergey
parents: 380
diff changeset
77
378
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
78 sub LoadMap {
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
79 my ($this,$locale,$default) = @_;
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
80
379
cin
parents: 378
diff changeset
81 my @spec = split /_/, $locale;
cin
parents: 378
diff changeset
82
cin
parents: 378
diff changeset
83 my @locales;
cin
parents: 378
diff changeset
84
cin
parents: 378
diff changeset
85 do {
cin
parents: 378
diff changeset
86 push @locales, join('_', @spec);
cin
parents: 378
diff changeset
87 } while(pop @spec);
cin
parents: 378
diff changeset
88
378
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
89 my $file = first { -f } map {
379
cin
parents: 378
diff changeset
90 my $path = $_;
cin
parents: 378
diff changeset
91
cin
parents: 378
diff changeset
92 map {
cin
parents: 378
diff changeset
93 my $name = FS->catfile($path,$_,$this->name);
cin
parents: 378
diff changeset
94 ("$name.s", "$name.p");
cin
parents: 378
diff changeset
95 } @locales;
378
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
96 } $this->paths;
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
97
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
98 if($file) {
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
99 if ($file =~ /\.s$/) {
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
100 return $this->LoadStringMap($file);
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
101 } else {
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
102 return $this->LoadPerlMap($file,$default);
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
103 }
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
104 }
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
105
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
106 return;
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
107 }
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
108
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
109 sub LoadPerlMap {
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
110 my ($self,$file,$parent) = @_;
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
111
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
112 my $data = do $file;
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
113 my $e = $@;
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
114 die Exception->new("Failed to load file '$file'", $e) if $e;
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
115 die IOException->new("Failed to load file '$file'", $!) if not defined $data and $!;
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
116 die Exception->new("Failed to load file '$file'", "A hash data is expected") unless ref($data) eq 'HASH';
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
117
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
118 return StringMap->new($data,$parent);
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
119 }
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
120
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
121 sub LoadStringMap {
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
122 my ($this,$fname) = @_;
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
123
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
124 open my $hRes, "<:encoding(utf-8)", $fname or die "Failed to open file $fname: $!";
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
125 local $_;
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
126 my %map;
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
127 my $line = 1;
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
128 while (<$hRes>) {
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
129 chomp;
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
130 $line ++ and next if /^\s*$/;
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
131
383
2f16f13b000c DOM localization
cin
parents: 382
diff changeset
132 if (/^([\w\.]+)\s*=\s*(.*)$/) {
378
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
133 $map{$1} = $2;
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
134 } else {
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
135 die "Invalid resource format in $fname at $line";
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
136 }
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
137 $line ++;
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
138 }
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
139
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
140 return \%map;
2eed076cb944 rewritten IMPL::Resources::Strings + tests
cin
parents: 377
diff changeset
141 }
377
cin
parents:
diff changeset
142
cin
parents:
diff changeset
143 1;