annotate Lib/IMPL/Web/CGIWrapper.pm @ 250:129e48bb5afb

DOM refactoring ObjectToDOM methods are virtual QueryToDOM uses inflators Fixed transform for the complex values in the ObjectToDOM QueryToDOM doesn't allow to use complex values (HASHes) as values for nodes (overpost problem)
author sergey
date Wed, 07 Nov 2012 04:17:53 +0400
parents a02b110da931
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
244
a02b110da931 refactoring
sergey
parents:
diff changeset
1 package IMPL::Web::CGIWrapper;
a02b110da931 refactoring
sergey
parents:
diff changeset
2 use strict;
a02b110da931 refactoring
sergey
parents:
diff changeset
3
a02b110da931 refactoring
sergey
parents:
diff changeset
4 use parent qw(CGI);
a02b110da931 refactoring
sergey
parents:
diff changeset
5 use Encode;
a02b110da931 refactoring
sergey
parents:
diff changeset
6
a02b110da931 refactoring
sergey
parents:
diff changeset
7 our $NO_DECODE = 0;
a02b110da931 refactoring
sergey
parents:
diff changeset
8
a02b110da931 refactoring
sergey
parents:
diff changeset
9 sub param {
a02b110da931 refactoring
sergey
parents:
diff changeset
10 my $this = shift;
a02b110da931 refactoring
sergey
parents:
diff changeset
11
a02b110da931 refactoring
sergey
parents:
diff changeset
12 return $this->SUPER::param(@_) if $NO_DECODE;
a02b110da931 refactoring
sergey
parents:
diff changeset
13
a02b110da931 refactoring
sergey
parents:
diff changeset
14 if (wantarray) {
a02b110da931 refactoring
sergey
parents:
diff changeset
15 my @result = $this->SUPER::param(@_);
a02b110da931 refactoring
sergey
parents:
diff changeset
16
a02b110da931 refactoring
sergey
parents:
diff changeset
17 return map Encode::is_utf8($_)
a02b110da931 refactoring
sergey
parents:
diff changeset
18 ? $_
a02b110da931 refactoring
sergey
parents:
diff changeset
19 : Encode::decode( $this->charset, $_, Encode::LEAVE_SRC ), @result;
a02b110da931 refactoring
sergey
parents:
diff changeset
20 }
a02b110da931 refactoring
sergey
parents:
diff changeset
21 else {
a02b110da931 refactoring
sergey
parents:
diff changeset
22 my $result = $this->SUPER::param(@_);
a02b110da931 refactoring
sergey
parents:
diff changeset
23
a02b110da931 refactoring
sergey
parents:
diff changeset
24 return Encode::is_utf8($result)
a02b110da931 refactoring
sergey
parents:
diff changeset
25 ? $result
a02b110da931 refactoring
sergey
parents:
diff changeset
26 : Encode::decode( $this->charset, $result, Encode::LEAVE_SRC );
a02b110da931 refactoring
sergey
parents:
diff changeset
27 }
a02b110da931 refactoring
sergey
parents:
diff changeset
28
a02b110da931 refactoring
sergey
parents:
diff changeset
29 }
a02b110da931 refactoring
sergey
parents:
diff changeset
30
a02b110da931 refactoring
sergey
parents:
diff changeset
31 sub upload {
a02b110da931 refactoring
sergey
parents:
diff changeset
32 my $this = shift;
a02b110da931 refactoring
sergey
parents:
diff changeset
33
a02b110da931 refactoring
sergey
parents:
diff changeset
34 local $NO_DECODE = 1;
a02b110da931 refactoring
sergey
parents:
diff changeset
35 my $oldCharset = $this->charset();
a02b110da931 refactoring
sergey
parents:
diff changeset
36 $this->charset('ISO-8859-1');
a02b110da931 refactoring
sergey
parents:
diff changeset
37
a02b110da931 refactoring
sergey
parents:
diff changeset
38 my $fh = $this->SUPER::upload(@_);
a02b110da931 refactoring
sergey
parents:
diff changeset
39
a02b110da931 refactoring
sergey
parents:
diff changeset
40 $this->charset($oldCharset);
a02b110da931 refactoring
sergey
parents:
diff changeset
41 return $fh;
a02b110da931 refactoring
sergey
parents:
diff changeset
42 }
a02b110da931 refactoring
sergey
parents:
diff changeset
43
a02b110da931 refactoring
sergey
parents:
diff changeset
44 1;
a02b110da931 refactoring
sergey
parents:
diff changeset
45
a02b110da931 refactoring
sergey
parents:
diff changeset
46 __END__
a02b110da931 refactoring
sergey
parents:
diff changeset
47
a02b110da931 refactoring
sergey
parents:
diff changeset
48 =pod
a02b110da931 refactoring
sergey
parents:
diff changeset
49
a02b110da931 refactoring
sergey
parents:
diff changeset
50 =head1 NAME
a02b110da931 refactoring
sergey
parents:
diff changeset
51
a02b110da931 refactoring
sergey
parents:
diff changeset
52 C<IMPL::Web::CGIWrapper> - обетрка вокруг стандартного объекта C<CGI>
a02b110da931 refactoring
sergey
parents:
diff changeset
53
a02b110da931 refactoring
sergey
parents:
diff changeset
54 =head1 DESCRIPTION
a02b110da931 refactoring
sergey
parents:
diff changeset
55
a02b110da931 refactoring
sergey
parents:
diff changeset
56 Наследуется от C<CGI>, и переопределяет метод C<param> для декодирования
a02b110da931 refactoring
sergey
parents:
diff changeset
57 строковых параметров. В остальном функциональность аналогична стандартному
a02b110da931 refactoring
sergey
parents:
diff changeset
58 модулю C<CGI>.
a02b110da931 refactoring
sergey
parents:
diff changeset
59
a02b110da931 refactoring
sergey
parents:
diff changeset
60 =head1 MEMBERS
a02b110da931 refactoring
sergey
parents:
diff changeset
61
a02b110da931 refactoring
sergey
parents:
diff changeset
62 =head2 C<$NO_DECODE>
a02b110da931 refactoring
sergey
parents:
diff changeset
63
a02b110da931 refactoring
sergey
parents:
diff changeset
64 Глобальная переменная для отключения декодирования параметров.
a02b110da931 refactoring
sergey
parents:
diff changeset
65
a02b110da931 refactoring
sergey
parents:
diff changeset
66 =begin code
a02b110da931 refactoring
sergey
parents:
diff changeset
67
a02b110da931 refactoring
sergey
parents:
diff changeset
68 {
a02b110da931 refactoring
sergey
parents:
diff changeset
69 local $IMPL::Web::CGIWrapper::NO_DECODE = 1;
a02b110da931 refactoring
sergey
parents:
diff changeset
70 my $raw = $q->param('binary');
a02b110da931 refactoring
sergey
parents:
diff changeset
71 }
a02b110da931 refactoring
sergey
parents:
diff changeset
72
a02b110da931 refactoring
sergey
parents:
diff changeset
73 =end code
a02b110da931 refactoring
sergey
parents:
diff changeset
74
a02b110da931 refactoring
sergey
parents:
diff changeset
75 =cut