|
49
|
1 use strict;
|
|
|
2 package Engine::CGI;
|
|
165
|
3 use parent 'CGI';
|
|
49
|
4 use Encode;
|
|
|
5 use Common;
|
|
|
6
|
|
|
7 BEGIN {
|
|
|
8 DeclareProperty Expires => ACCESS_ALL;
|
|
|
9 }
|
|
|
10
|
|
|
11 my $query;
|
|
|
12
|
|
|
13 sub Query {
|
|
|
14 $query = new Engine::CGI unless $query;
|
|
|
15 return $query;
|
|
|
16 }
|
|
|
17
|
|
|
18
|
|
|
19 my $fcgi_loaded = 0;
|
|
|
20 sub Accept {
|
|
|
21 my ($self) = shift;
|
|
|
22 require CGI::Fast unless $fcgi_loaded;
|
|
|
23 $fcgi_loaded = 1;
|
|
|
24
|
|
|
25 my $fquery = CGI::Fast->new();
|
|
|
26 $query = $fquery ? $self->new($fquery) : undef;
|
|
|
27 return $query;
|
|
|
28 }
|
|
|
29
|
|
|
30 sub as_list {
|
|
|
31 return( map { UNIVERSAL::isa($_,'ARRAY') ? @{$_} : defined $_ ? $_ : () } @_ );
|
|
|
32 }
|
|
|
33
|
|
|
34 sub header {
|
|
|
35 my ($this,%args) = @_;
|
|
|
36
|
|
|
37 $args{'-cookies'} = [as_list($args{'-cookies'}), values %{$this->{'cookies_list'}}] if $this->{'cookies_list'};
|
|
|
38 $args{'-expires'} = $this->{$Expires} || 'now';
|
|
|
39
|
|
|
40 $this->SUPER::header(%args);
|
|
|
41 }
|
|
|
42
|
|
|
43 sub SetCookies {
|
|
|
44 my ($this,@cookies) = @_;
|
|
|
45
|
|
|
46 foreach (@cookies) {
|
|
|
47 $this->{'cookies_list'}{$_->name} = $_;
|
|
|
48 }
|
|
|
49 }
|
|
|
50
|
|
|
51 sub param {
|
|
|
52 my ($this) = shift;
|
|
|
53 my $charset = $this->charset or die new Exception("Encoding is not defined");
|
|
|
54 if (wantarray) {
|
|
|
55 return map { Encode::is_utf8($_) ? $_ : Encode::decode($charset,$_,Encode::LEAVE_SRC) } $this->SUPER::param( map Encode::encode($charset,$_,Encode::LEAVE_SRC ), @_ );
|
|
|
56 } else {
|
|
|
57 my $val = $this->SUPER::param( map Encode::encode($charset,$_,Encode::LEAVE_SRC ), @_ );
|
|
|
58 return (Encode::is_utf8($val) ? $val : Encode::decode($charset,$val,Encode::LEAVE_SRC));
|
|
|
59 }
|
|
|
60 }
|
|
|
61
|
|
|
62 sub param_raw {
|
|
|
63 my $this = shift;
|
|
|
64 return $this->SUPER::param(@_);
|
|
|
65 }
|
|
|
66
|
|
|
67 1;
|
