comparison Lib/IMPL/Web/HttpResponse.pm @ 230:6d8092d8ce1b

*reworked IMPL::Security *reworked IMPL::Web::Security *refactoring
author sergey
date Mon, 08 Oct 2012 03:37:37 +0400
parents 47f77e6409f7
children 23daf2fae33a
comparison
equal deleted inserted replaced
229:47f77e6409f7 230:6d8092d8ce1b
46 if(my $charset = $this->charset) { 46 if(my $charset = $this->charset) {
47 $q->charset($charset); 47 $q->charset($charset);
48 binmode $out, ":encoding($charset)"; 48 binmode $out, ":encoding($charset)";
49 } 49 }
50 50
51 $q->header(\%headers); 51 print $out $q->header(\%headers);
52 52
53 if(my $body = $this->body) { 53 if(my $body = $this->body) {
54 if(ref $body eq 'CODE') { 54 if(ref $body eq 'CODE') {
55 $body->($out); 55 $body->($out);
56 } else { 56 } else {
60 } 60 }
61 61
62 #used to map a pair name valie to a valid cookie object 62 #used to map a pair name valie to a valid cookie object
63 sub _createCookie { 63 sub _createCookie {
64 return UNIVERSAL::isa($_[1], 'CGI::Cookie') ? $_[1] : CGI::Cookie->new(-name => $_[0], -value => $_[1] ); 64 return UNIVERSAL::isa($_[1], 'CGI::Cookie') ? $_[1] : CGI::Cookie->new(-name => $_[0], -value => $_[1] );
65 }
66
67 sub InternalError {
68 my ($self,%args) = @_;
69
70 $args{status} ||= '500 Internal Server Error';
71
72 return $self->new(%args);
73 }
74
75 sub Redirect {
76 my ($self,%args) = @_;
77
78 return $self->new(
79 status => $args{status} || '303 See other',
80 headers => {
81 location => $args{location}
82 }
83 );
65 } 84 }
66 85
67 1; 86 1;
68 87
69 __END__ 88 __END__