annotate Lib/IMPL/Web/QueryHandler/PageFormat.pm @ 214:4683002758aa

sync
author sergey
date Mon, 06 Aug 2012 17:27:47 +0400
parents 4d0e1962161c
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
62
c64bd1bf727d Web application
wizard
parents:
diff changeset
1 package IMPL::Web::QueryHandler::PageFormat;
166
4267a2ac3d46 Added Class::Template,
wizard
parents: 162
diff changeset
2 use parent qw(IMPL::Web::QueryHandler IMPL::Object::Autofill);
136
f6af119ac741 url routines for templates
wizard
parents: 134
diff changeset
3 use strict;
62
c64bd1bf727d Web application
wizard
parents:
diff changeset
4
c64bd1bf727d Web application
wizard
parents:
diff changeset
5 __PACKAGE__->PassThroughArgs;
c64bd1bf727d Web application
wizard
parents:
diff changeset
6
140
fb896377389f to_json and escape_string functions for the templates
wizard
parents: 137
diff changeset
7 use JSON;
62
c64bd1bf727d Web application
wizard
parents:
diff changeset
8 use IMPL::Class::Property;
77
9d24db321029 Refactoring Web::TT
wizard
parents: 65
diff changeset
9 use IMPL::Web::TT::Document;
136
f6af119ac741 url routines for templates
wizard
parents: 134
diff changeset
10 use Template::Plugin::URL;
171
59e5fcb59d86 Исправления, изменена концепция веб-форм
sourcer
parents: 166
diff changeset
11 use IMPL::Security::Context();
59e5fcb59d86 Исправления, изменена концепция веб-форм
sourcer
parents: 166
diff changeset
12 use File::Spec();
59e5fcb59d86 Исправления, изменена концепция веб-форм
sourcer
parents: 166
diff changeset
13 use HTML::TreeBuilder();
59e5fcb59d86 Исправления, изменена концепция веб-форм
sourcer
parents: 166
diff changeset
14 use URI();
63
76b878ad6596 Added serialization support for the IMPL::Object::List
wizard
parents: 62
diff changeset
15 use Error qw(:try);
171
59e5fcb59d86 Исправления, изменена концепция веб-форм
sourcer
parents: 166
diff changeset
16 use Encode();
62
c64bd1bf727d Web application
wizard
parents:
diff changeset
17
136
f6af119ac741 url routines for templates
wizard
parents: 134
diff changeset
18 $Template::Plugin::URL::JOINT = '&';
f6af119ac741 url routines for templates
wizard
parents: 134
diff changeset
19
64
259cd3df6e53 Doc generation
wizard
parents: 63
diff changeset
20 BEGIN {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
21 public property templatesCharset => prop_all;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
22 public property templatesBase => prop_all;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
23 public property includes => prop_all | prop_list;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
24 public property pathinfoPrefix => prop_all;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
25 public property cache => prop_all;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
26 public property preprocess => prop_all;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
27 public property formatOutput => prop_all;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
28 public property template => prop_all;
64
259cd3df6e53 Doc generation
wizard
parents: 63
diff changeset
29 }
259cd3df6e53 Doc generation
wizard
parents: 63
diff changeset
30
259cd3df6e53 Doc generation
wizard
parents: 63
diff changeset
31 sub CTOR {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
32 my ($this) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
33
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
34 $this->templatesCharset('utf-8') unless $this->templatesCharset;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
35 $this->cache(File::Spec->rel2abs($this->cache)) if $this->cache;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
36 $this->templatesBase(File::Spec->rel2abs($this->templatesBase)) if $this->templatesBase;
64
259cd3df6e53 Doc generation
wizard
parents: 63
diff changeset
37 }
259cd3df6e53 Doc generation
wizard
parents: 63
diff changeset
38
62
c64bd1bf727d Web application
wizard
parents:
diff changeset
39 sub Process {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
40 my ($this,$action,$nextHandler) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
41
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
42 my $doc = new IMPL::Web::TT::Document(cache => $this->cache, preprocess => $this->preprocess);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
43
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
44 try {
97
964587c5183c Added SecureCall to Web QueryHandlers stack
wizard
parents: 77
diff changeset
45
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
46 $this->templatesBase($ENV{DOCUMENT_ROOT}) unless $this->templatesBase;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
47
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
48 my ($requestUri) = split( /\?/, $ENV{REQUEST_URI} );
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
49
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
50 my $pathInfo;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
51 my @root = ('');
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
52 my @base;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
53
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
54 if ( $requestUri eq $ENV{SCRIPT_NAME}.$ENV{PATH_INFO} ) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
55 # CGI with path info, for example
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
56 # /base/cgi-bin/myscript.cgi/path/info
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
57 # PATH_INFO will be /path/info
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
58 $pathInfo = $ENV{PATH_INFO};
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
59 } else {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
60 # usual url, for exmaple
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
61 # /base/script.cgi will have PATH_INFO /base/script.cgi
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
62 # /base/ will have PATH_INFO /base/index.cgi (if index.cgi is a DirectoryIndex)
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
63 $pathInfo = $ENV{PATH_INFO};
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
64
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
65 if (my $rx = $this->pathinfoPrefix) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
66 $requestUri =~ s/^($rx)//;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
67 $pathInfo =~ s/^($rx)//;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
68 push @root, grep $_, split /\//, $1 if $1;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
69 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
70 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
71
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
72 @base = grep $_, split /\//, ($pathInfo ? substr $requestUri,0, -length($pathInfo) : $requestUri);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
73
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
74 local $ENV{PATH_INFO} = $pathInfo;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
75
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
76 my @path = grep $_, split /\//, ($ENV{PATH_INFO} || '') or die new IMPL::Exception("PATH_INFO is empty and no defaultTarget specified" );
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
77
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
78 my @pathContainer = @path;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
79 pop @pathContainer;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
80
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
81 $doc->LoadFile (
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
82 ($this->template || File::Spec->catfile($this->templatesBase,@path)),
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
83 $this->templatesCharset,
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
84 [$this->templatesBase, $this->includes],
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
85 {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
86 result => scalar($nextHandler->()),
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
87 action => $action,
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
88 app => $action->application,
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
89
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
90 absoluteUrl => sub { new URI(join ('/', @root, $_[0]) ) },
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
91 baseUrl => sub { new URI (join ('/', @root, @base, $_[0]) ) },
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
92 relativeUrl => sub { new URI(join ('/', @root, @base, @pathContainer,$_[0]) ) },
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
93
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
94 user => IMPL::Security::Context->current->principal,
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
95 session => IMPL::Security::Context->current,
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
96
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
97 to_json => \&to_json,
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
98 escape_string => sub { $_[0] =~ s/"/"/g; $_[0] },
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
99 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
100 );
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
101
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
102 $action->response->contentType('text/html');
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
103 my $hOut = $action->response->streamBody;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
104 if ($this->formatOutput == 1) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
105 my $tree = new HTML::TreeBuilder();
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
106 try {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
107 $tree->parse_content($doc->Render());
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
108 print $hOut $tree->as_HTML('<>&'," ",{});
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
109 } finally {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
110 $tree->delete;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
111 };
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
112 } elsif ($this->formatOutput() == 2 ) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
113 (my $data = $doc->Render()) =~ s/\s+/ /g;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
114 print $hOut $data;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
115 } else {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
116 print $hOut $doc->Render();
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
117 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
118 } finally {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
119 $doc->Dispose;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
120 };
62
c64bd1bf727d Web application
wizard
parents:
diff changeset
121 }
c64bd1bf727d Web application
wizard
parents:
diff changeset
122
154
eb478083f72b Url support
wizard
parents: 146
diff changeset
123 sub URI::_query::new_params {
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
124 my ($this,$params) = @_;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
125
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
126 my $clone = $this->clone;
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
127 if (ref $params eq 'HASH' ) {
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
128 my %newParams = ($clone->query_form , %$params);
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
129 $clone->query_form(map { $_, ( Encode::is_utf8( $newParams{$_} ) ? Encode::encode('utf-8', $newParams{$_}) : $newParams{$_} ) } sort keys %newParams );
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
130 }
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
131 return $clone;
154
eb478083f72b Url support
wizard
parents: 146
diff changeset
132 }
eb478083f72b Url support
wizard
parents: 146
diff changeset
133
65
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
134 1;
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
135
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
136 __END__
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
137
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
138 =pod
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
139
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
140 =head1 NAME
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
141
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 171
diff changeset
142 C<IMPL::Web::QueryHandler::PageFormat> - Выдача результатов в виде HTML страницы, построенной из шаблона.
65
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
143
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
144 =head1 SYNOPSIS
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
145
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 171
diff changeset
146 В файле конфигурации приложения
65
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
147
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
148 =begin code xml
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
149
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
150 <handlersQuery type="IMPL::Object::List">
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
151 <item type="IMPL::Web::QueryHandler::PageFormat">
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
152 <charsetTemplates>utf-8</charsetTemplates>
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
153 </item>
65
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
154 </handlersQuery>
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
155
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
156 =end code xml
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
157
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 171
diff changeset
158 Программно
65
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
159
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
160 =begin code
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
161
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
162 my $app = new IMPL::Web::Application();
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
163 $app->handlersQuery->Add(
194
4d0e1962161c Replaced tabs with spaces
cin
parents: 180
diff changeset
164 new IMPL::Web::QueryHandler::PageFormat( charsetTemplates=> 'utf-8' );
65
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
165 );
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
166
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
167 =end
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
168
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
169 =head1 DESCRIPTION
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
170
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 171
diff changeset
171 Обработчик запроса для веб приложения. Загружает шаблон, путь к котрому берется
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 171
diff changeset
172 из C<ENV{PATH_INFO}> относительно пути из свойства C<templatesBase>.
65
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
173
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 171
diff changeset
174 Наследуется от C<IMPL::Web::QueryHandler> для реализации функционала
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 171
diff changeset
175 обработчика запроса и переопределяет метод C<Process>.
65
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
176
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
177 C<Serializable>
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
178
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
179 =head1 MEMBERS
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
180
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
181 =over
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
182
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
183 =item C<CTOR(%props)>
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
184
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 171
diff changeset
185 Создает новый экземпляр и заполняет свойства.
65
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
186
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
187 =item C<[get,set] templatesCharset>
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
188
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 171
diff changeset
189 Кодировка шаблонов. По умолчанию utf-8.
65
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
190
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
191 =item C<[get,set] templatesBase>
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
192
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 171
diff changeset
193 Каталог относительно которого ищется шаблон.
65
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
194
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
195 =item C<[override] Process($action,$nextHandler)>
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
196
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 171
diff changeset
197 Метод, переопределяющий C<IMPL::Web::QueryHandler->Process> и которому передается управление
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 171
diff changeset
198 для выполнения действий.
65
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
199
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
200 =back
2840c4c85db8 Application configuration improvements
wizard
parents: 64
diff changeset
201
180
d1676be8afcc Перекодировка в utf-8
sourcer
parents: 171
diff changeset
202 =cut