Mercurial > pub > Impl
comparison Lib/IMPL/Resources/Strings.pm @ 378:2eed076cb944
rewritten IMPL::Resources::Strings + tests
author | cin |
---|---|
date | Wed, 15 Jan 2014 17:20:54 +0400 |
parents | f4e14f32cf54 |
children |
comparison
equal
deleted
inserted
replaced
377:a0d342ac9a36 | 378:2eed076cb944 |
---|---|
1 package IMPL::Resources::Strings; | 1 package IMPL::Resources::Strings; |
2 use strict; | 2 use strict; |
3 | 3 |
4 use File::Spec; | 4 use File::Spec; |
5 use List::Util qw(first); | 5 use List::Util qw(first); |
6 use IMPL::Resources::Format qw(FormatMessage); | |
7 use IMPL::require { | 6 use IMPL::require { |
8 Resources => 'IMPL::Resources' | 7 StringMap => 'IMPL::Resources::StringLocaleMap' |
9 }; | 8 }; |
10 | 9 |
11 our $Encoding ||= 'utf-8'; | |
12 our @Locations; | 10 our @Locations; |
13 my %maps; | 11 my %maps; |
14 | 12 |
15 sub import { | 13 sub import { |
16 my ($self,$refStrings,%options) = @_; | 14 my ($self,$refStrings,%options) = @_; |
19 | 17 |
20 my $class = caller; | 18 my $class = caller; |
21 my $methods = $options{methods}; | 19 my $methods = $options{methods}; |
22 | 20 |
23 if (ref $refStrings eq 'HASH') { | 21 if (ref $refStrings eq 'HASH') { |
24 my $map = ( $maps{$class} ||= {} ); | 22 my $map = $self->_GetMapForClass($class,$refStrings); |
25 while(my ($name,$format) = each %$refStrings) { | 23 |
26 $map->{default}{$name} = $format; | 24 while(my ($str,$format) = each %$refStrings) { |
27 | 25 *{"${class}::$str"} = sub { |
28 *{"${class}::$name"} = sub { | |
29 shift if $methods; | 26 shift if $methods; |
30 my $args = @_ == 1 ? shift : { @_ }; | 27 my $args = @_ == 1 ? shift : { @_ }; |
31 | 28 |
32 return _FormatMapMessage($class,$name,$map,Resources->currentLocale,$args); | 29 return $map->GetString($str,$args); |
33 } | 30 } |
34 } | 31 } |
35 } | 32 } |
36 } | 33 } |
37 | 34 |
38 sub _FormatMapMessage { | 35 sub _GetResourceLocations { |
39 my ($class,$msg,$map,$locale,$args) = @_; | 36 my ($self,$class) = @_; |
40 | 37 |
41 if (not exists $map->{$locale} ) { | 38 my @classNamespace = split /::/,$class; |
42 $map->{$locale} = LoadStrings($class,$locale); | |
43 } | |
44 | |
45 return FormatMessage( ($map->{$locale} || $map->{default})->{$msg}, $args ); | |
46 } | |
47 | |
48 sub LoadStrings { | |
49 my ($class,$locale) = @_; | |
50 | |
51 # Foo::Bar -> ('Foo','Bar') | |
52 my @classNamespace = split /::/,$class; | |
53 | 39 |
54 my $classShortName = pop @classNamespace; | 40 my $classShortName = pop @classNamespace; |
41 | |
42 my @paths = map File::Spec->catdir($_,@classNamespace), @Locations; | |
55 | 43 |
56 # Foo::Bar -> 'Foo/Bar.pm' | 44 # Foo::Bar -> 'Foo/Bar.pm' |
57 my $classModuleName = File::Spec->catfile(@classNamespace,"${classShortName}.pm"); | 45 my $classModuleName = File::Spec->catfile(@classNamespace,"${classShortName}.pm"); |
58 | 46 |
59 # 'Foo/Bar.pm' -> '/full/path/to/Foo/Bar.pm' | 47 # 'Foo/Bar.pm' -> '/full/path/to/Foo/Bar.pm' |
60 my $fullModulePath = first { -f } map( File::Spec->catfile($_,$classModuleName), @INC ); | 48 my $fullModulePath = first { -f } map( File::Spec->catfile($_,$classModuleName), @INC ); |
61 | 49 |
62 my @ways = map { | |
63 my @path = ($_); | |
64 push @path,Resources->currentLocale; | |
65 | |
66 File::Spec->catfile($_,Resources->currentLocale,@classNamespace,$classShortName); | |
67 } @Locations; | |
68 | |
69 | |
70 if ($fullModulePath) { | 50 if ($fullModulePath) { |
71 | 51 |
72 # '/full/path/to/Foo/Bar.pm' -> '/full/path/to/Foo' | 52 # '/full/path/to/Foo/Bar.pm' -> '/full/path/to/Foo/locale/' |
73 my ($vol,$dir,$file) = File::Spec->splitpath($fullModulePath); | 53 my ($vol,$dir,$file) = File::Spec->splitpath($fullModulePath); |
74 my $baseDir = File::Spec->catpath($vol,$dir,''); | 54 push @paths, File::Spec->catpath($vol,File::Spec->catdir($dir,'locale'),''); |
75 | |
76 # '/full/path/to/Foo' -> '/full/path/to/Foo/locale/En_US/Bar' | |
77 push @ways, File::Spec->catfile($baseDir,'locale',Resources->currentLocale,$classShortName); | |
78 } | 55 } |
79 | 56 |
80 my $mapFile = first { -f } @ways; | 57 return \@paths, $classShortName; |
81 | |
82 return unless $mapFile; | |
83 | |
84 return ParseStringsMap($mapFile); | |
85 } | 58 } |
86 | 59 |
87 sub ParseStringsMap { | 60 sub _GetMapForClass { |
88 my ($fname) = @_; | 61 my ($self,$class,$data) = @_; |
89 | 62 |
90 open my $hRes, "<:encoding($Encoding)", $fname or die "Failed to open file $fname: $!"; | 63 my $map; |
91 local $_; | 64 |
92 my %Map; | 65 unless ($map) { |
93 my $line = 1; | 66 |
94 while (<$hRes>) { | 67 my ($paths,$name) = $self->_GetResourceLocations($class); |
95 chomp; | 68 |
96 $line ++ and next if /^\s*$/; | 69 $map = StringMap->new($data); |
97 | 70 $map->name($name); |
98 if (/^(\w+)\s*=\s*(.*)$/) { | 71 $map->paths($paths); |
99 $Map{$1} = $2; | 72 |
100 } else { | 73 $maps{$class} = $map; |
101 die "Invalid resource format in $fname at $line"; | 74 |
102 } | 75 } |
103 $line ++; | 76 |
104 } | 77 return $map; |
105 | |
106 return \%Map; | |
107 } | 78 } |
108 | 79 |
109 1; | 80 1; |
110 | 81 |
111 __END__ | 82 __END__ |