Mercurial > pub > Impl
comparison Lib/Engine/CGI.pm @ 0:03e58a454b20
Создан репозитарий
author | Sergey |
---|---|
date | Tue, 14 Jul 2009 12:54:37 +0400 |
parents | |
children | 16ada169ca75 |
comparison
equal
deleted
inserted
replaced
-1:000000000000 | 0:03e58a454b20 |
---|---|
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; |