# HG changeset patch
# User cin
# Date 1389792054 -14400
# Node ID 2eed076cb944b818f4270465dd4265f84d4d89eb
# Parent  a0d342ac9a36f178e98d938df7f31761f95d682c
rewritten IMPL::Resources::Strings + tests

diff -r a0d342ac9a36 -r 2eed076cb944 Lib/IMPL/Resources.pm
--- a/Lib/IMPL/Resources.pm	Tue Jan 14 20:06:36 2014 +0400
+++ b/Lib/IMPL/Resources.pm	Wed Jan 15 17:20:54 2014 +0400
@@ -20,12 +20,9 @@
 
     local $CurrentLocale;
     $this->SetLocale($locale);    
-    eval {
-        &$code()
-            if $code;
-    };
-    die $@
-        if $@;
+    
+    &$code()
+		if $code;
 }
 
 1;
diff -r a0d342ac9a36 -r 2eed076cb944 Lib/IMPL/Resources/StringLocaleMap.pm
--- a/Lib/IMPL/Resources/StringLocaleMap.pm	Tue Jan 14 20:06:36 2014 +0400
+++ b/Lib/IMPL/Resources/StringLocaleMap.pm	Wed Jan 15 17:20:54 2014 +0400
@@ -1,6 +1,111 @@
 package IMPL::Resources::StringLocaleMap;
 use strict;
 
+use List::Util qw(first);
+use IMPL::lang qw(:base);
+use IMPL::Const qw(:prop);
+use IMPL::declare {
+	require => {
+		Resources => 'IMPL::Resources',
+		StringMap => 'IMPL::Resources::StringMap',
+		Exception => 'IMPL::Exception',
+		FS => 'File::Spec'
+	},
+	base => {
+		'IMPL::Object' => '@_'
+	},
+	props => [
+		_maps => PROP_RW,
+		name => PROP_RW,
+		paths => PROP_RW | PROP_LIST
+	]
+};
 
+sub CTOR {
+	my ($this,$data,$parent) = @_;
+	
+	if (is($data, StringMap)) {
+		$this->_maps({ default => $data });
+	} elsif ( ref($data) eq 'HASH' ) {
+		$this->_maps({ default => StringMap->new($data,$parent)});
+	}
+}
+
+sub GetString {
+	my ($this,$id,$args) = @_;
+	
+	my $locale = Resources->currentLocale || 'default';
+	my $map;
+	
+	if(not $map = $this->_maps->{$locale}) {
+		$map = $this->LoadMap($locale,$this->_maps->{default});
+		if (is($map,StringMap)) {
+			#nop
+		} elsif (ref($map) eq 'HASH') {
+			$map = StringMap->new($map,$this->_maps->{default});
+		} elsif( not $map ) {
+			$map = $this->_maps->{default};
+		} else {
+			die Exception->new("ResolveLocale returned unexpected data", $map);
+		}
+		
+		$this->_maps->{$locale} = $map;
+	}
+	
+	return $map->GetString($id,$args);
+}
+
+sub LoadMap {
+	my ($this,$locale,$default) = @_;
+	
+	my $file = first { -f } map {
+		my $name = FS->catfile($_,$locale,$this->name);
+		("$name.s", "$name.p");
+	} $this->paths;
+	
+	if($file) {
+		if ($file =~ /\.s$/) {
+			return $this->LoadStringMap($file);
+		} else {
+			return $this->LoadPerlMap($file,$default);
+		}
+	}
+	
+	return;
+}
+
+sub LoadPerlMap {
+	my ($self,$file,$parent) = @_;
+	
+	my $data = do $file;
+	my $e = $@;
+	die Exception->new("Failed to load file '$file'", $e) if $e;
+	die IOException->new("Failed to load file '$file'", $!) if not defined $data and $!;
+	die Exception->new("Failed to load file '$file'", "A hash data is expected") unless ref($data) eq 'HASH';
+	
+	return StringMap->new($data,$parent);
+}
+
+sub LoadStringMap {
+    my ($this,$fname) = @_;
+    
+    open my $hRes, "<:encoding(utf-8)", $fname or die "Failed to open file $fname: $!";
+    local $_;
+    my %map;
+    my $line = 1;
+    while (<$hRes>) {
+        chomp;
+        $line ++ and next if /^\s*$/;
+        
+        if (/^(\w+)\s*=\s*(.*)$/) {
+            $map{$1} = $2;
+        } else {
+            die "Invalid resource format in $fname at $line";
+        }
+        $line ++;
+    }
+    
+    return \%map;
+}
 
 1;
\ No newline at end of file
diff -r a0d342ac9a36 -r 2eed076cb944 Lib/IMPL/Resources/StringMap.pm
--- a/Lib/IMPL/Resources/StringMap.pm	Tue Jan 14 20:06:36 2014 +0400
+++ b/Lib/IMPL/Resources/StringMap.pm	Wed Jan 15 17:20:54 2014 +0400
@@ -1,4 +1,4 @@
-package IMPL::Web::Resources::StringMap;
+package IMPL::Resources::StringMap;
 use strict;
 
 use IMPL::Const qw(:prop);
@@ -8,6 +8,9 @@
 		IOException => '-IMPL::IOException',
 		ArgException => '-IMPL::InvalidArgumentException'
 	},
+	base => [
+		'IMPL::Object' => '@_'
+	],
 	props => [
 		_data => PROP_RW,
 		_parent => PROP_RW
@@ -21,7 +24,7 @@
 		unless ref($data) eq 'HASH';
 		
 	die ArgException->new( data => 'A hash must contain either scalars or subs')
-		if ref($_) && ref($_) ne 'CODE', values %$data;
+		if grep ref($_) && ref($_) ne 'CODE', values %$data;
 	
 	$this->_data($data);
 	$this->_parent($parent);
@@ -31,7 +34,7 @@
 	my ($this,$id,$args) = @_;
 	
 	if(my $format = $this->_data->{$id}) {
-		return $this->FormatString($format,$args);
+		return ref($format) eq 'CODE' ? &$format($this,$args || {}) : $this->FormatString($format,$args);
 	} else {
 		return $this->_parent? $this->_parent->GetString($id,$args) : "[ $id ]";
 	}
@@ -54,12 +57,11 @@
 	my ($self,$text,$args) = @_;
     
     $args ||= {};
-    $resolver ||= \&_defaultResolver;
     $text ||= '';
     
-    $string =~ s/%(\w+(?:\.\w+)*)%/$self->GetValue($args,$1,"\[$1\]")/ge;
+    $text =~ s/%(\w+(?:\.\w+)*)%/$self->GetValue($args,$1,"\[$1\]")/ge;
     
-    return $string;
+    return $text;
 	
 }
 
@@ -83,18 +85,6 @@
     return ( eval { $obj->can($prop) } ? $obj->$prop() : undef );
 }
 
-sub _LoadMap {
-	my ($self,$file,$parent) = @_;
-	
-	my $data = do $file;
-	my $e = $@;
-	die Exception->new("Failed to load file '$file'", $e) if $e;
-	die IOException->new("Failed to load file '$file'", $!) if not defined $data and $!;
-	die Exception->new("Failed to load file '$file'", "A hash data is expected") unless ref($data) eq 'HASH';
-	
-	return $self->new($data,$parent);
-}
-
 1;
 
 __END__
diff -r a0d342ac9a36 -r 2eed076cb944 Lib/IMPL/Resources/Strings.pm
--- a/Lib/IMPL/Resources/Strings.pm	Tue Jan 14 20:06:36 2014 +0400
+++ b/Lib/IMPL/Resources/Strings.pm	Wed Jan 15 17:20:54 2014 +0400
@@ -3,12 +3,10 @@
 
 use File::Spec;
 use List::Util qw(first);
-use IMPL::Resources::Format qw(FormatMessage);
 use IMPL::require {
-    Resources => 'IMPL::Resources'
+    StringMap => 'IMPL::Resources::StringLocaleMap'
 };
 
-our $Encoding ||= 'utf-8';
 our @Locations;
 my %maps;
 
@@ -21,37 +19,27 @@
     my $methods = $options{methods};
     
     if (ref $refStrings eq 'HASH') {
-        my $map = ( $maps{$class} ||= {} );
-        while(my ($name,$format) = each %$refStrings) {
-            $map->{default}{$name} = $format;
-            
-            *{"${class}::$name"} = sub {
+        my $map = $self->_GetMapForClass($class,$refStrings);
+        
+        while(my ($str,$format) = each %$refStrings) {
+            *{"${class}::$str"} = sub {
                 shift if $methods;
                 my $args = @_ == 1 ? shift : { @_ };
                 
-                return _FormatMapMessage($class,$name,$map,Resources->currentLocale,$args);
+                return $map->GetString($str,$args);
             }
         }
     }    
 }
 
-sub _FormatMapMessage {
-    my ($class,$msg,$map,$locale,$args) = @_;
-    
-    if (not exists $map->{$locale} ) {
-        $map->{$locale} = LoadStrings($class,$locale);        
-    }
-    
-    return FormatMessage( ($map->{$locale} || $map->{default})->{$msg}, $args );
-}
-
-sub LoadStrings {
-    my ($class,$locale) = @_;
-    
-    # Foo::Bar -> ('Foo','Bar')
-    my @classNamespace = split /::/,$class;
+sub _GetResourceLocations {
+	my ($self,$class) = @_;
+	
+	my @classNamespace = split /::/,$class;
     
     my $classShortName = pop @classNamespace;
+    
+    my @paths = map File::Spec->catdir($_,@classNamespace), @Locations;
 
     # Foo::Bar -> 'Foo/Bar.pm'    
     my $classModuleName = File::Spec->catfile(@classNamespace,"${classShortName}.pm");
@@ -59,51 +47,34 @@
     # 'Foo/Bar.pm' -> '/full/path/to/Foo/Bar.pm'
     my $fullModulePath = first { -f } map( File::Spec->catfile($_,$classModuleName), @INC );
     
-    my @ways = map {
-        my @path = ($_);
-        push @path,Resources->currentLocale;
-        
-        File::Spec->catfile($_,Resources->currentLocale,@classNamespace,$classShortName);
-    } @Locations;
-    
-    
     if ($fullModulePath) {
 
-        # '/full/path/to/Foo/Bar.pm' -> '/full/path/to/Foo' 
+        # '/full/path/to/Foo/Bar.pm' -> '/full/path/to/Foo/locale/' 
         my ($vol,$dir,$file) = File::Spec->splitpath($fullModulePath);
-        my $baseDir = File::Spec->catpath($vol,$dir,'');
-
-        # '/full/path/to/Foo' -> '/full/path/to/Foo/locale/En_US/Bar' 
-        push @ways, File::Spec->catfile($baseDir,'locale',Resources->currentLocale,$classShortName);
+        push @paths, File::Spec->catpath($vol,File::Spec->catdir($dir,'locale'),'');
     }
     
-    my $mapFile = first { -f } @ways;
-    
-    return unless $mapFile;
-    
-    return ParseStringsMap($mapFile);
+    return \@paths, $classShortName;
 }
 
-sub ParseStringsMap {
-    my ($fname) = @_;
-    
-    open my $hRes, "<:encoding($Encoding)", $fname or die "Failed to open file $fname: $!";
-    local $_;
-    my %Map;
-    my $line = 1;
-    while (<$hRes>) {
-        chomp;
-        $line ++ and next if /^\s*$/;
-        
-        if (/^(\w+)\s*=\s*(.*)$/) {
-            $Map{$1} = $2;
-        } else {
-            die "Invalid resource format in $fname at $line";
-        }
-        $line ++;
-    }
-    
-    return \%Map;
+sub _GetMapForClass {
+	my ($self,$class,$data) = @_;
+	
+	my $map;
+	
+	unless ($map) {
+	
+		my ($paths,$name) = $self->_GetResourceLocations($class);
+		
+		$map = StringMap->new($data);
+		$map->name($name);
+		$map->paths($paths);
+		
+		$maps{$class} = $map;
+	
+	}
+	
+	return $map;
 }
 
 1;
diff -r a0d342ac9a36 -r 2eed076cb944 _test/Resources.t
--- a/_test/Resources.t	Tue Jan 14 20:06:36 2014 +0400
+++ b/_test/Resources.t	Wed Jan 15 17:20:54 2014 +0400
@@ -8,6 +8,7 @@
 
 my $plan = new IMPL::Test::Plan qw(
     Test::Resources::Format
+    Test::Resources::Strings
 );
 
 $plan->AddListener(new IMPL::Test::TAPListener);
diff -r a0d342ac9a36 -r 2eed076cb944 _test/Test/Resources/Strings.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/Test/Resources/Strings.pm	Wed Jan 15 17:20:54 2014 +0400
@@ -0,0 +1,36 @@
+package Test::Resources::Strings;
+use strict;
+
+use IMPL::Test qw(assert test);
+use IMPL::declare {
+	require => {
+		Resources => 'IMPL::Resources'
+	},
+	base => [
+		'IMPL::Test::Unit' => '@_'
+	]
+};
+
+use IMPL::Resources::Strings {
+	HelloMessage => "Hello, %name%!",
+	TitleLabel => "Hellow world!"
+};
+
+test TestDefaultMessage => sub {
+	assert( HelloMessage( name => 'John') eq "Hello, John!" );
+};
+
+test TestPlainResourceFile => sub{
+	Resources->InvokeInLocale(en_INF1 => sub {
+		assert( HelloMessage( name => 'Peter' ) eq "Hi, Peter!" );
+		assert( TitleLabel, "Hellow world!");
+	});
+};
+
+test TestPerlResourceFile => sub {
+	Resources->InvokeInLocale(en_INF2 => sub {
+		assert( HelloMessage( name => 'Sam' ) eq "I know you, Sam!");
+	});
+};
+
+1;
\ No newline at end of file
diff -r a0d342ac9a36 -r 2eed076cb944 _test/Test/Resources/locale/en_INF1/Strings.s
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/Test/Resources/locale/en_INF1/Strings.s	Wed Jan 15 17:20:54 2014 +0400
@@ -0,0 +1,1 @@
+HelloMessage = Hi, %name%!
\ No newline at end of file
diff -r a0d342ac9a36 -r 2eed076cb944 _test/Test/Resources/locale/en_INF2/Strings.p
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/_test/Test/Resources/locale/en_INF2/Strings.p	Wed Jan 15 17:20:54 2014 +0400
@@ -0,0 +1,9 @@
+use utf8;
+use strict;
+{
+	HelloMessage => sub {
+		my ($this,$args) = @_;
+		
+		return "I know you, $args->{name}!";
+	}
+};
\ No newline at end of file