| 49 | 1 use strict; | 
|  | 2 package Engine::CGI; | 
|  | 3 use base 'CGI'; | 
|  | 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; |