Mercurial > pub > Impl
changeset 211:2b9b55cfb79b
Completed IMPL::Web::AutoLocator, added tests
| author | cin |
|---|---|
| date | Tue, 05 Jun 2012 07:45:21 +0400 |
| parents | 6adaeb86945d |
| children | 292226770180 |
| files | Lib/IMPL/Resources/Strings.pm Lib/IMPL/Web/AutoLocator.pm Lib/IMPL/declare.pm _test/Test/Web/AutoLocator.pm _test/Web.t |
| diffstat | 5 files changed, 85 insertions(+), 9 deletions(-) [+] |
line wrap: on
line diff
--- a/Lib/IMPL/Resources/Strings.pm Tue May 29 20:07:22 2012 +0400 +++ b/Lib/IMPL/Resources/Strings.pm Tue Jun 05 07:45:21 2012 +0400 @@ -95,7 +95,7 @@ use IMPL::Resources::Strings { msg_say_hello => "Hello, %name!", msg_module_name => "Simple Foo class" -}, auto => 1, locale => 'en-us'; +}, auto => 1, locale => 'en-US'; sub InviteUser { my ($this,$uname) = @_;
--- a/Lib/IMPL/Web/AutoLocator.pm Tue May 29 20:07:22 2012 +0400 +++ b/Lib/IMPL/Web/AutoLocator.pm Tue Jun 05 07:45:21 2012 +0400 @@ -20,13 +20,13 @@ public property base => PROP_GET | PROP_OWNERSET; public property view => PROP_ALL; public property query => PROP_ALL; - public property hash => RPOP_ALL; + public property hash => PROP_ALL; } -sub fetch { +sub Fetch { my $this = shift; - my $child = shift or die ArgumentException->new(child => "a child resource identifier is required"); - die ArgumentException->new(child => "a child resource can't be a reference"); + my $child = shift or die ArgumentException->new("a child resource identifier is required"); + die ArgumentException->new("a child resource can't be a reference") if ref $child; # safe $child = uri_escape($child); @@ -43,7 +43,36 @@ $args{query} = ref $query eq 'HASH' ? hashMerge($this->query,$query) : $query; } - return __PACKAGE__->new() + return __PACKAGE__->new(%args); +} + +sub SetView { + my ($this,$newView) = @_; + + $this->view($newView); + + return $this; +} + +sub url { + my ($this) = @_; + + my $url = URI->new($this->view ? $this->base . "." . $this->view : $this->base); + $url->query_form($this->query); + $url->fragment($this->hash); + + return $url; +} + +sub AUTOLOAD { + our $AUTOLOAD; + + (my $method) = ($AUTOLOAD =~ m/(\w+)$/); + + return if $method eq 'DESTROY'; + + my $this = shift; + return $this->Fetch($method,@_); } @@ -78,4 +107,18 @@ Для удобстав навигации по ресурсам, полностью отражает классическую структуру иерархически организованных ресурсов. позволяет гибко работать с параметрами запроса и хешем. Для постоты -чтения реализует метод C<AUTOLOAD> для доступа к дочерним ресурсам \ No newline at end of file +чтения реализует метод C<AUTOLOAD> для доступа к дочерним ресурсам. + +=head1 MEMBERS + +=head2 C<CTOR(base => $url,view => $extension, query => $hashQuery, hash => $fragment)> + +Создает новый объект расположение. Позволяет задать путь, расширение, параметры запроса и фрагмент ресурса. + +=head2 C<Fetch($child[,$query])> + +Получает расположение дочернего ресурса. При этом моздается новый объект адреса ресурса. + +=head2 C<AUTLOAD> + +Перенаправляет вызовы методов в метод C<Fetch> передавая первым параметром имя метода.
--- a/Lib/IMPL/declare.pm Tue May 29 20:07:22 2012 +0400 +++ b/Lib/IMPL/declare.pm Tue Jun 05 07:45:21 2012 +0400 @@ -31,8 +31,13 @@ my @isa; if (ref $base eq 'ARRAY') { - carp("will be changed in next version"); - @isa = map _require($_), @$base if @$base; + carp "Odd elements number in require" unless scalar(@$base)%2 == 0; + while ( my ($class,$mapper) = splice @$base, 0, 2 ) { + $class = $aliases->{$class} || _require($class); + + push @isa,$class; + $ctor{$class} = $mapper; + } } elsif (ref $base eq 'HASH' ) { while ( my ($class,$mapper) = each %$base ) { $class = $aliases->{$class} || _require($class);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/_test/Test/Web/AutoLocator.pm Tue Jun 05 07:45:21 2012 +0400 @@ -0,0 +1,27 @@ +package Test::Web::AutoLocator; +use strict; + +use IMPL::lang qw(:declare :constants); +use IMPL::Test qw(test assert); +use URI(); + +use IMPL::declare { + require => { + 'Locator' => 'IMPL::Web::AutoLocator' + }, + base => { + 'IMPL::Test::Unit' => '@_' + } +}; + +test TestCreation => sub { + my $location = Locator->new(base => 'http://bugs.company.org', view => "cgi"); + + my $url = $location->show_bug({id => 100}); + assert( $url->url eq "http://bugs.company.org/show_bug.cgi?id=100", $url->url ); + + $url = $location->SetView(undef)->help->CreateBug->HowTo; + assert( $url->url eq "http://bugs.company.org/help/CreateBug/HowTo", $url->url ); +}; + +1; \ No newline at end of file