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__