|
210
|
1 package IMPL::Web::AutoLocator;
|
|
|
2 use strict;
|
|
|
3
|
|
|
4 use IMPL::lang qw(:declare :constants :hash);
|
|
|
5 use URI;
|
|
|
6 use URI::Escape;
|
|
|
7 use IMPL::declare {
|
|
|
8 require => {
|
|
|
9 Exception => 'IMPL::Exception',
|
|
|
10 ArgumentException => '-IMPL::InvalidArgumentException'
|
|
|
11 },
|
|
|
12 base => [
|
|
|
13 'IMPL::Object' => undef,
|
|
|
14 'IMPL::Object::Autofill' => '@_',
|
|
|
15 'IMPL::Object::Serializable' => '@_'
|
|
|
16 ]
|
|
|
17 };
|
|
|
18
|
|
|
19 BEGIN {
|
|
|
20 public property base => PROP_GET | PROP_OWNERSET;
|
|
|
21 public property view => PROP_ALL;
|
|
|
22 public property query => PROP_ALL;
|
|
211
|
23 public property hash => PROP_ALL;
|
|
210
|
24 }
|
|
|
25
|
|
211
|
26 sub Fetch {
|
|
210
|
27 my $this = shift;
|
|
211
|
28 my $child = shift or die ArgumentException->new("a child resource identifier is required");
|
|
|
29 die ArgumentException->new("a child resource can't be a reference") if ref $child;
|
|
210
|
30
|
|
|
31 # safe
|
|
|
32 $child = uri_escape($child);
|
|
|
33
|
|
|
34 my %args;
|
|
|
35
|
|
|
36 $args{base} = $this->base =~ /\/$/ ? $this->base . $child : $this->base . '/' . $child;
|
|
|
37 $args{view} = $this->view if $this->view;
|
|
|
38 $args{hash} = $this->hash if $this->hash;
|
|
|
39
|
|
|
40 if (@_) {
|
|
|
41 my $query = shift;
|
|
|
42
|
|
|
43 $args{query} = ref $query eq 'HASH' ? hashMerge($this->query,$query) : $query;
|
|
|
44 }
|
|
|
45
|
|
212
|
46 return $this->new(%args);
|
|
211
|
47 }
|
|
|
48
|
|
|
49 sub SetView {
|
|
|
50 my ($this,$newView) = @_;
|
|
|
51
|
|
|
52 $this->view($newView);
|
|
|
53
|
|
|
54 return $this;
|
|
|
55 }
|
|
|
56
|
|
|
57 sub url {
|
|
|
58 my ($this) = @_;
|
|
|
59
|
|
|
60 my $url = URI->new($this->view ? $this->base . "." . $this->view : $this->base);
|
|
|
61 $url->query_form($this->query);
|
|
|
62 $url->fragment($this->hash);
|
|
|
63
|
|
|
64 return $url;
|
|
|
65 }
|
|
|
66
|
|
|
67 sub AUTOLOAD {
|
|
|
68 our $AUTOLOAD;
|
|
|
69
|
|
|
70 (my $method) = ($AUTOLOAD =~ m/(\w+)$/);
|
|
|
71
|
|
|
72 return if $method eq 'DESTROY';
|
|
|
73
|
|
|
74 my $this = shift;
|
|
|
75 return $this->Fetch($method,@_);
|
|
210
|
76 }
|
|
|
77
|
|
|
78
|
|
|
79
|
|
|
80 1;
|
|
|
81
|
|
|
82 __END__
|
|
|
83
|
|
|
84 =head1 NAME
|
|
|
85
|
|
|
86 =head1 SYNOPSIS
|
|
|
87
|
|
|
88 C<IMPL::Web::AutoLocator> - Обертка вокруг адреса ресурса.
|
|
|
89
|
|
|
90 =begin code
|
|
|
91
|
|
|
92 use IMPL::require {
|
|
|
93 Locator => 'IMPL::Web::Locator'
|
|
|
94 };
|
|
|
95
|
|
212
|
96 my $bugTracker = Locator->new(base => "http://myhost.org/bugzilla")->SetView("cgi");
|
|
210
|
97
|
|
|
98 my $bug = $bugTracker->show_bug({id = 1});
|
|
|
99
|
|
212
|
100 my $wikiPages = Locator->new(base => "http://myhost.org/wiki/bin/view");
|
|
210
|
101
|
|
|
102 my $page = $wiki->Main->HowTo;
|
|
|
103
|
|
|
104 =end code
|
|
|
105
|
|
|
106 =head1 DESCRIPTION
|
|
|
107
|
|
|
108 Для удобстав навигации по ресурсам, полностью отражает классическую структуру иерархически
|
|
|
109 организованных ресурсов. позволяет гибко работать с параметрами запроса и хешем. Для постоты
|
|
211
|
110 чтения реализует метод C<AUTOLOAD> для доступа к дочерним ресурсам.
|
|
|
111
|
|
|
112 =head1 MEMBERS
|
|
|
113
|
|
|
114 =head2 C<CTOR(base => $url,view => $extension, query => $hashQuery, hash => $fragment)>
|
|
|
115
|
|
|
116 Создает новый объект расположение. Позволяет задать путь, расширение, параметры запроса и фрагмент ресурса.
|
|
|
117
|
|
|
118 =head2 C<Fetch($child[,$query])>
|
|
|
119
|
|
|
120 Получает расположение дочернего ресурса. При этом моздается новый объект адреса ресурса.
|
|
|
121
|
|
|
122 =head2 C<AUTLOAD>
|
|
|
123
|
|
|
124 Перенаправляет вызовы методов в метод C<Fetch> передавая первым параметром имя метода.
|
|
212
|
125
|
|
|
126 =cut
|
|
|
127
|
