changeset 210:6adaeb86945d

added IMPL::Web::AutoLocator
author sergey
date Tue, 29 May 2012 20:07:22 +0400
parents a8db61d0ed33
children 2b9b55cfb79b
files Lib/IMPL/Web/AutoLocator.pm Lib/IMPL/lang.pm _test/temp.pl
diffstat 3 files changed, 128 insertions(+), 2 deletions(-) [+]
line wrap: on
line diff
--- /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<IMPL::Web::AutoLocator> - Обертка вокруг адреса ресурса.
+
+=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<AUTOLOAD> для доступа к дочерним ресурсам
\ No newline at end of file
--- 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 {
--- 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";
+