annotate Lib/Engine/CGI.pm @ 7:94d47b388442

Улучшены тесты Исправлены ошибки Улучшена документация Работа над схемой DOM
author Sergey
date Mon, 24 Aug 2009 01:05:34 +0400
parents 03e58a454b20
children 16ada169ca75
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
1 use strict;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
2 package Engine::CGI;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
3 use base 'CGI';
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
4 use Encode;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
5 use Common;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
6
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
7 BEGIN {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
8 DeclareProperty Expires => ACCESS_ALL;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
9 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
10
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
11 my $query;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
12
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
13 sub Query {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
14 $query = new Engine::CGI unless $query;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
15 return $query;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
16 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
17
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
18
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
19 my $fcgi_loaded = 0;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
20 sub Accept {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
21 my ($self) = shift;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
22 require CGI::Fast unless $fcgi_loaded;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
23 $fcgi_loaded = 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
24
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
25 my $fquery = CGI::Fast->new();
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
26 $query = $fquery ? $self->new($fquery) : undef;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
27 return $query;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
28 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
29
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
30 sub as_list {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
31 return( map { UNIVERSAL::isa($_,'ARRAY') ? @{$_} : defined $_ ? $_ : () } @_ );
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
32 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
33
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
34 sub header {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
35 my ($this,%args) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
36
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
37 $args{'-cookies'} = [as_list($args{'-cookies'}), values %{$this->{'cookies_list'}}] if $this->{'cookies_list'};
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
38 $args{'-expires'} = $this->{$Expires} || 'now';
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
39
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
40 $this->SUPER::header(%args);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
41 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
42
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
43 sub SetCookies {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
44 my ($this,@cookies) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
45
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
46 foreach (@cookies) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
47 $this->{'cookies_list'}{$_->name} = $_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
48 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
49 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
50
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
51 sub param {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
52 my ($this) = shift;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
53 my $charset = $this->charset or die new Exception("Encoding is not defined");
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
54 if (wantarray) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
55 return map { Encode::is_utf8($_) ? $_ : Encode::decode($charset,$_,Encode::LEAVE_SRC) } $this->SUPER::param( map Encode::encode($charset,$_,Encode::LEAVE_SRC ), @_ );
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
56 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
57 my $val = $this->SUPER::param( map Encode::encode($charset,$_,Encode::LEAVE_SRC ), @_ );
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
58 return (Encode::is_utf8($val) ? $val : Encode::decode($charset,$val,Encode::LEAVE_SRC));
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
59 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
60 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
61
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
62 sub param_raw {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
63 my $this = shift;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
64 return $this->SUPER::param(@_);
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
65 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
66
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
67 1;