# HG changeset patch
# User sergey
# Date 1351466122 -14400
# Node ID 7c517134c42f3f0c72017338899d28c9629368d5
# Parent  a02b110da931a759c814d50979003153902523c7
Added Unsupported media type Web exception
corrected resourceLocation setting in the resource
Implemented localizable resources for text messages
fixed TT view scopings, INIT block in controls now sets globals correctly.

diff -r a02b110da931 -r 7c517134c42f Lib/IMPL/DOM/Schema.pm
--- a/Lib/IMPL/DOM/Schema.pm	Mon Oct 22 04:09:27 2012 +0400
+++ b/Lib/IMPL/DOM/Schema.pm	Mon Oct 29 03:15:22 2012 +0400
@@ -109,7 +109,7 @@
     
     my @errors = $class->MetaSchema->Validate($schema);
     
-    die new IMPL::Exception("Schema is invalid",$file,map( $_->Message, @errors ) ) if @errors;
+    die new IMPL::Exception("Schema is invalid",$file,map( $_->message, @errors ) ) if @errors;
     
     $schema->Process;
     
diff -r a02b110da931 -r 7c517134c42f Lib/IMPL/Resources/Strings.pm
--- a/Lib/IMPL/Resources/Strings.pm	Mon Oct 22 04:09:27 2012 +0400
+++ b/Lib/IMPL/Resources/Strings.pm	Mon Oct 29 03:15:22 2012 +0400
@@ -1,53 +1,87 @@
 use strict;
 use warnings;
 
-package IMPL::Resources::Strings::Storage;
 package IMPL::Resources::Strings;
+
 use File::Spec;
+use List::Util qw(first);
+use IMPL::Resources::Format qw(FormatMessage);
 
 our $Locale ||= 'default';
-our $Base ||='locale';
 our $Encoding ||= 'utf-8';
 our @Locations;
 
-@Locations = ('.') unless @Locations;
-
 sub import {
     my ($self,$refStrings,%options) = @_;
     
-    my ($class,$pathModule) = caller;
+    no strict 'refs';
+    
+    my $class = caller;
+    
+    if (ref $refStrings eq 'HASH') {
+        my %map;
+        while(my ($name,$format) = each %$refStrings) {
+            $map{default}{$name} = $format;
+            
+            *{"${class}::$name"} = sub {
+                my $args = @_ == 1 ? shift : { @_ };
+                
+                return _FormatMapMessage($class,$name,\%map,$Locale,$args);
+            }
+        }
+    }    
+}
+
+sub _FormatMapMessage {
+    my ($class,$msg,$map,$locale,$args) = @_;
     
-    my ($vol,$dir,$file) = File::Spec->splitpath($pathModule);
-    my $baseDir = File::Spec->catpath($vol,$dir,'');
+    if (not exists $map->{$locale} ) {
+        $map->{$locale} = LoadStrings($class,$locale);        
+    }
+    
+    return FormatMessage( ($map->{$locale} || $map->{default})->{$msg}, $args );
+}
+
+sub LoadStrings {
+    my ($class,$locale) = @_;
     
-    my @pathClass = split /::/,$class;
-    my $fileClass = pop @pathClass;
+    # Foo::Bar -> ('Foo','Bar')
+    my @classNamespace = split /::/,$class;
+    
+    my $classShortName = pop @classNamespace;
+
+    # Foo::Bar -> 'Foo/Bar.pm'    
+    my $classModuleName = File::Spec->catfile(@classNamespace,"${classShortName}.pm");
+    
+    # '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,$Base;
         push @path,$Locale;
         
-        File::Spec->catfile(@path,@pathClass,$fileClass);
+        File::Spec->catfile($_,$Locale,@classNamespace,$classShortName);
     } @Locations;
     
-    push @ways, File::Spec->catfile($baseDir,'locale',$Locale,$fileClass);
-    
-    
     
-    my $stringsStorage = findResource($class,@ways);
+    if ($fullModulePath) {
+
+        # '/full/path/to/Foo/Bar.pm' -> '/full/path/to/Foo' 
+        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',$Locale,$classShortName);
+    }
     
+    my $mapFile = first { -f } @ways;
+    
+    return unless $mapFile;
+    
+    return ParseStringsMap($mapFile);
 }
 
-sub findResource {
-    my ($class,$refWays) = @_;
-    
-    
-}
-
-
-
-sub parseResource {
+sub ParseStringsMap {
     my ($fname) = @_;
     
     open my $hRes, "<:encoding($Encoding)", findFile($fname) or die "Failed to open file $fname: $!";
@@ -69,13 +103,6 @@
     return \%Map;
 }
 
-package IMPL::Resources::Strings::Storage;
-use parent qw(IMPL::Object);
-
-sub get {
-    my ($this,$msg_name) = @_;
-}
-
 1;
 
 __END__
@@ -93,7 +120,7 @@
 package Foo;
 
 use IMPL::Resources::Strings {
-    msg_say_hello => "Hello, %name!",
+    msg_say_hello => "Hello, %name%!",
     msg_module_name => "Simple Foo class"
 }, auto => 1, locale => 'en-US';
 
@@ -114,7 +141,7 @@
 При импорте ищутся модули по следующему алгоритму:
 
 В каталогах из массива C<@Locations> ищется файл с относительным путем
-C<$Base/$Locale/$ModName>, где C<$Base>, C<$Locale> - глобальные переменные
+C<$Locale/$ModName>, где C<$Locale> - глобальная переменная
 модуля C<IMPL::Resourses::Strings>, а переменная C<$ModName> получена
 путем замены 'C<::>' в имени целевого модуля на 'C</>'.
 
diff -r a02b110da931 -r 7c517134c42f Lib/IMPL/Security.pm
--- a/Lib/IMPL/Security.pm	Mon Oct 22 04:09:27 2012 +0400
+++ b/Lib/IMPL/Security.pm	Mon Oct 29 03:15:22 2012 +0400
@@ -5,6 +5,7 @@
 ##VERSION##
 
 require IMPL::Exception;
+require IMPL::Security::Principal;
 require IMPL::Security::AbstractContext;
 require IMPL::Security::Rule::RoleCheck;
 
@@ -48,6 +49,17 @@
     return $authority;
 }
 
+sub principal {
+    return
+        IMPL::Security::AbstractContext->current
+        && IMPL::Security::AbstractContext->current->principal
+        || IMPL::Security::Principal->nobody; 
+}
+
+sub context {
+    IMPL::Security::AbstractContext->current;
+}
+
 1;
 
 __END__
diff -r a02b110da931 -r 7c517134c42f Lib/IMPL/Web/Application/Action.pm
--- a/Lib/IMPL/Web/Application/Action.pm	Mon Oct 22 04:09:27 2012 +0400
+++ b/Lib/IMPL/Web/Application/Action.pm	Mon Oct 29 03:15:22 2012 +0400
@@ -32,7 +32,21 @@
 sub param {
     my ($this,$name,$rx) = @_;
     
-    $this->_launder(scalar( $this->query->param($name) ), $rx );
+    my $value;
+    
+    if (
+        $this->requestMethod eq 'GET'
+        or
+        $this->query->content_type eq 'multipart/form-data'
+        or
+        $this->query->content_type eq 'application/x-www-form-urlencoded'
+    ) {
+        $value = scalar( $this->query->param($name) );
+    } else {
+        $value = scalar( $this->query->url_param($name) );
+    }
+    
+    $this->_launder($value, $rx );
 }
 
 sub requestMethod {
diff -r a02b110da931 -r 7c517134c42f Lib/IMPL/Web/Application/Resource.pm
--- a/Lib/IMPL/Web/Application/Resource.pm	Mon Oct 22 04:09:27 2012 +0400
+++ b/Lib/IMPL/Web/Application/Resource.pm	Mon Oct 29 03:15:22 2012 +0400
@@ -51,8 +51,10 @@
           allow => join( ',', map( uc, keys %{ $this->contract->verbs } ) )
       )
         unless $operation;
-        
-      $action->context->{resourceLocation} = $this->location; 
+      
+      # в случае, когда один ресурс вызывает HTTP метод другого ресурса, нужно
+      # сохранить оригинальный resourceLocation  
+      $action->context->{resourceLocation} ||= $this->location; 
 
       return $operation->Invoke( $this, $action );
 }
diff -r a02b110da931 -r 7c517134c42f Lib/IMPL/Web/HttpResponse.pm
--- a/Lib/IMPL/Web/HttpResponse.pm	Mon Oct 22 04:09:27 2012 +0400
+++ b/Lib/IMPL/Web/HttpResponse.pm	Mon Oct 29 03:15:22 2012 +0400
@@ -2,7 +2,7 @@
 package IMPL::Web::HttpResponse;
 
 use CGI();
-use IMPL::lang qw(:declare);
+use IMPL::lang qw(:declare :hash);
 use IMPL::declare {
 	require => {
 		Exception => 'IMPL::Exception',
@@ -88,6 +88,14 @@
     );
 }
 
+sub NoContent {
+    my ($self,%args) = @_;
+    
+    return $self->new(
+        status => $args{status} || '204 No Content'
+    );
+}
+
 1;
 
 __END__
diff -r a02b110da931 -r 7c517134c42f Lib/IMPL/Web/UnsupportedMediaException.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Lib/IMPL/Web/UnsupportedMediaException.pm	Mon Oct 29 03:15:22 2012 +0400
@@ -0,0 +1,31 @@
+package IMPL::Web::UnsupportedMediaException;
+use strict;
+
+use IMPL::declare {
+    base => {
+        'IMPL::Web::Exception' => '@_'
+    }
+};
+
+sub status {
+    "415 Unsupported Media Type"
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+C<IMPL::Web::UnsupportedMediaException> - 415 Unsupported Media Type
+
+=head1 DESCRIPTION
+
+The request entity has a media type which the server or resource does not
+support. For example, the client uploads an image as C<image/svg+xml>, but the
+server requires that images use a different format.
+L<http://en.wikipedia.org/wiki/List_of_HTTP_status_codes>
+
+=cut
\ No newline at end of file
diff -r a02b110da931 -r 7c517134c42f Lib/IMPL/Web/View/ObjectFactory.pm
--- a/Lib/IMPL/Web/View/ObjectFactory.pm	Mon Oct 22 04:09:27 2012 +0400
+++ b/Lib/IMPL/Web/View/ObjectFactory.pm	Mon Oct 29 03:15:22 2012 +0400
@@ -13,6 +13,10 @@
 	]
 };
 
+use IMPL::Resources::Strings {
+    MsgNoMethod => 'Method "%method%" isn\'t found in "%target%"'
+};
+
 sub AUTOLOAD {
 	my $this = shift;
 	my ($method) = ($AUTOLOAD =~ m/(\w+)$/);
@@ -22,7 +26,7 @@
 	if ( $target->can($method) ) {
 	   	return $target->$method(@_);
 	} else {
-	   die OpException->new("Method '$method' isn't found in '$target'")
+	   die OpException->new( MsgNoMethod( method => $method, target => $target ) );
 	}
 }
 
diff -r a02b110da931 -r 7c517134c42f Lib/IMPL/Web/View/TTDocument.pm
--- a/Lib/IMPL/Web/View/TTDocument.pm	Mon Oct 22 04:09:27 2012 +0400
+++ b/Lib/IMPL/Web/View/TTDocument.pm	Mon Oct 29 03:15:22 2012 +0400
@@ -88,8 +88,8 @@
         if ( my $template = $this->loader->template($path) ) {
             my $opts = { %{$this->opts} };
 
-            # avoid propagation of local variables 
-            $opts->{STASH} = $this->stash->clone();
+            # factory will create a clone of the stash 
+            # $opts->{STASH} = $this->stash->clone();
  
             my $ctx = new Template::Context($opts);
             
@@ -128,7 +128,7 @@
             $this->loader->layout($this->layout),
             {
             	%{$newArgs},
-                content => sub { $this->RenderContent($newArgs); },
+                content => $this->RenderContent($newArgs),
                 this => $this,
                 template => $this->template
             }