# HG changeset patch # User sergey # Date 1338307642 -14400 # Node ID 6adaeb86945ddc429a405c05983414b6346feb55 # Parent a8db61d0ed3380d50717aa78dbdf3d2dfeca62a1 added IMPL::Web::AutoLocator diff -r a8db61d0ed33 -r 6adaeb86945d Lib/IMPL/Web/AutoLocator.pm --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Lib/IMPL/Web/AutoLocator.pm Tue May 29 20:07:22 2012 +0400 @@ -0,0 +1,81 @@ +package IMPL::Web::AutoLocator; +use strict; + +use IMPL::lang qw(:declare :constants :hash); +use URI; +use URI::Escape; +use IMPL::declare { + require => { + Exception => 'IMPL::Exception', + ArgumentException => '-IMPL::InvalidArgumentException' + }, + base => [ + 'IMPL::Object' => undef, + 'IMPL::Object::Autofill' => '@_', + 'IMPL::Object::Serializable' => '@_' + ] +}; + +BEGIN { + public property base => PROP_GET | PROP_OWNERSET; + public property view => PROP_ALL; + public property query => PROP_ALL; + public property hash => RPOP_ALL; +} + +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"); + + # safe + $child = uri_escape($child); + + my %args; + + $args{base} = $this->base =~ /\/$/ ? $this->base . $child : $this->base . '/' . $child; + $args{view} = $this->view if $this->view; + $args{hash} = $this->hash if $this->hash; + + if (@_) { + my $query = shift; + + $args{query} = ref $query eq 'HASH' ? hashMerge($this->query,$query) : $query; + } + + return __PACKAGE__->new() +} + + + +1; + +__END__ + +=head1 NAME + +=head1 SYNOPSIS + +C - Обертка вокруг адреса ресурса. + +=begin code + +use IMPL::require { + Locator => 'IMPL::Web::Locator' +}; + +my $bugTracker = Locator->new("http://myhost.org/bugzilla")->view("cgi"); + +my $bug = $bugTracker->show_bug({id = 1}); + +my $wikiPages = Locator->new("http://myhost.org/wiki/bin/view"); + +my $page = $wiki->Main->HowTo; + +=end code + +=head1 DESCRIPTION + +Для удобстав навигации по ресурсам, полностью отражает классическую структуру иерархически +организованных ресурсов. позволяет гибко работать с параметрами запроса и хешем. Для постоты +чтения реализует метод C для доступа к дочерним ресурсам \ No newline at end of file diff -r a8db61d0ed33 -r 6adaeb86945d Lib/IMPL/lang.pm --- a/Lib/IMPL/lang.pm Mon May 28 19:58:56 2012 +0400 +++ b/Lib/IMPL/lang.pm Tue May 29 20:07:22 2012 +0400 @@ -165,7 +165,7 @@ } sub hashMerge { - return hashApply( { %{$_[0]} }, $_[1] ); + return hashApply( { %{$_[0] || {}} }, $_[1] ); } sub hashApply { diff -r a8db61d0ed33 -r 6adaeb86945d _test/temp.pl --- a/_test/temp.pl Mon May 28 19:58:56 2012 +0400 +++ b/_test/temp.pl Tue May 29 20:07:22 2012 +0400 @@ -1,1 +1,46 @@ -print "asd::asd" =~ /^[a-zA-Z]+(?:::[a-zA-Z]+)*$/; \ No newline at end of file +#!/usr/bin/perl +use strict; + +use Time::HiRes qw(gettimeofday tv_interval); + +my $obj = {}; +my @vals = qw(a b c d e f g h i j k); +my @names = qw(one two three four five six); + +sub CreateMethod { + my ($dt) = @_; + + $obj->{one} = $vals[1]; + $obj->{two} = $vals[2]; + $obj->{three} = $vals[3]; + $obj->{four} = $vals[4]; + $obj->{five} = $vals[5]; + $obj->{six} = $vals[6]; +} + +my @pairs = map { [$names[$_],$_] } (1 .. $#names); + +sub CreateMethodEval { + my ($dt) = @_; + my $i = 0; + map $obj->{$_} = $vals[$i++], @names; +} + +my $t = [gettimeofday]; + + + +CreateMethod($_) foreach (1..1000000); + +print "Build: ",tv_interval($t,[gettimeofday]),"\n"; + +$t = [gettimeofday]; + +CreateMethodEval($_) foreach (1..1000000); + +print "Eval: ",tv_interval($t,[gettimeofday]),"\n"; + +use URI::Escape; + +print uri_escape("/child///&?"), "\n"; +