|
244
|
1 package IMPL::Web::CGIWrapper;
|
|
|
2 use strict;
|
|
|
3
|
|
|
4 use parent qw(CGI);
|
|
|
5 use Encode;
|
|
|
6
|
|
|
7 our $NO_DECODE = 0;
|
|
|
8
|
|
|
9 sub param {
|
|
|
10 my $this = shift;
|
|
|
11
|
|
|
12 return $this->SUPER::param(@_) if $NO_DECODE;
|
|
|
13
|
|
|
14 if (wantarray) {
|
|
|
15 my @result = $this->SUPER::param(@_);
|
|
|
16
|
|
|
17 return map Encode::is_utf8($_)
|
|
|
18 ? $_
|
|
|
19 : Encode::decode( $this->charset, $_, Encode::LEAVE_SRC ), @result;
|
|
|
20 }
|
|
|
21 else {
|
|
|
22 my $result = $this->SUPER::param(@_);
|
|
|
23
|
|
|
24 return Encode::is_utf8($result)
|
|
|
25 ? $result
|
|
|
26 : Encode::decode( $this->charset, $result, Encode::LEAVE_SRC );
|
|
|
27 }
|
|
|
28
|
|
|
29 }
|
|
|
30
|
|
|
31 sub upload {
|
|
|
32 my $this = shift;
|
|
|
33
|
|
|
34 local $NO_DECODE = 1;
|
|
|
35 my $oldCharset = $this->charset();
|
|
|
36 $this->charset('ISO-8859-1');
|
|
|
37
|
|
|
38 my $fh = $this->SUPER::upload(@_);
|
|
|
39
|
|
|
40 $this->charset($oldCharset);
|
|
|
41 return $fh;
|
|
|
42 }
|
|
|
43
|
|
|
44 1;
|
|
|
45
|
|
|
46 __END__
|
|
|
47
|
|
|
48 =pod
|
|
|
49
|
|
|
50 =head1 NAME
|
|
|
51
|
|
|
52 C<IMPL::Web::CGIWrapper> - обетрка вокруг стандартного объекта C<CGI>
|
|
|
53
|
|
|
54 =head1 DESCRIPTION
|
|
|
55
|
|
|
56 Наследуется от C<CGI>, и переопределяет метод C<param> для декодирования
|
|
|
57 строковых параметров. В остальном функциональность аналогична стандартному
|
|
|
58 модулю C<CGI>.
|
|
|
59
|
|
|
60 =head1 MEMBERS
|
|
|
61
|
|
|
62 =head2 C<$NO_DECODE>
|
|
|
63
|
|
|
64 Глобальная переменная для отключения декодирования параметров.
|
|
|
65
|
|
|
66 =begin code
|
|
|
67
|
|
|
68 {
|
|
|
69 local $IMPL::Web::CGIWrapper::NO_DECODE = 1;
|
|
|
70 my $raw = $q->param('binary');
|
|
|
71 }
|
|
|
72
|
|
|
73 =end code
|
|
|
74
|
|
|
75 =cut |
