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__ | 
