summaryrefslogtreecommitdiff
path: root/lib/VNDB/Util/Response.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/VNDB/Util/Response.pm')
-rw-r--r--lib/VNDB/Util/Response.pm220
1 files changed, 0 insertions, 220 deletions
diff --git a/lib/VNDB/Util/Response.pm b/lib/VNDB/Util/Response.pm
deleted file mode 100644
index c5e9a704..00000000
--- a/lib/VNDB/Util/Response.pm
+++ /dev/null
@@ -1,220 +0,0 @@
-
-package VNDB::Util::Response;
-
-
-use strict;
-use warnings;
-use POSIX ();
-use Encode;
-use XML::Writer;
-use Compress::Zlib;
-use Exporter 'import';
-require bytes;
-
-use vars ('$VERSION', '@EXPORT');
-$VERSION = $VNDB::VERSION;
-@EXPORT = qw| ResRedirect ResNotFound ResDenied ResFile
- ResForceBody ResSetContentType ResAddHeader ResAddTpl ResAddDefaultStuff
- ResStartXML ResGetXML ResGetBody ResGet ResGetCGI ResSetModPerl |;
-
-sub new {
- my $self = shift;
- my $tplo = shift;
- my $type = ref($self) || $self;
- my $me = bless {
- headers => [ ],
- contenttype => 'text/html; charset=UTF-8',
- code => 200,
- tplo => $tplo,
- tpl => { },
- body => undef,
- xmlobj => undef,
- xmldata => undef,
- whattouse => 1,
- }, $type;
-
- return $me;
-}
-
-
-## Some ready-to-use methods
-sub ResRedirect {
- my $self = shift;
- my $url = shift; # should start with '/', if no URL specified, use referer or '/'
- my $type = shift;
- my $info = $self->{_Res} || $self;
-
- if(!$url) {
- $url = "/";
- my $ref = $self->ReqHeader('Referer');
- ($url = $ref) =~ s/^$self->{root_url}// if $ref;
- }
-
- my $code = !$type ? 301 :
- $type eq 'temp' ? 307 :
- $type eq 'post' ? 303 : 301;
- $info->{body} = 'Redirecting...';
- $info->{code} = $code;
- $info->{headers} = [ 'Location', "$self->{root_url}$url" ];
- $info->{contenttype} = 'text/html; charset=UTF-8';
- $info->{whattouse} = 1;
-}
-
-sub ResNotFound {
- my $s = shift;
- my $i = $s->{_Res};
- $i->{code} = 404;
- $i->{whattouse} = 2;
- $i->{tpl} = {
- page => { error => {
- err => 'notfound'
- }},
- };
-}
-
-sub ResDenied {
- my $self = shift;
- $self->ResRedirect('/u/register?n=1', 'temp');
-}
-
-sub ResFile {
- my($s,$f,@h) = @_;
- my $i = $s->{_Res};
- $i->{whattouse} = 4;
- $i->{code} = 200;
- $i->{contenttype} = '';
- push @{$i->{headers}},
- 'X-Sendfile' => $f,
- 'Cache-Control' => sprintf('max-age=%d, public', 7*24*3600),
- @h;
-}
-
-## And some often-used methods
-sub ResForceBody {
- my $self = shift;
- my $body = shift;
- my $info = $self->{_Res} || $self;
- $info->{whattouse} = 1;
- $info->{body} = $body;
-}
-
-sub ResSetContentType {
- my $self = shift;
- my $ctype = shift;
- my $info = $self->{_Res} || $self;
- $info->{contenttype} = $ctype;
- return 1;
-}
-
-sub ResAddHeader {
- my $self = shift;
- die("Odd number in parameters, must be in key => value format!") unless ((@_ % 2) == 0);
- my $info = $self->{_Res} || $self;
- $info->{headers} = [ @{$info->{headers}}, @_ ];
- return 1;
-}
-
-sub ResAddTpl {
- my $self = shift;
- die("Odd number in parameters, must be in key=>value format") unless ((@_ % 2) == 0);
- my $info = $self->{_Res} || $self;
- $info->{tpl} = { page => { } } if !$info->{tpl}->{page};
- $info->{tpl}->{page} = { %{$info->{tpl}->{page}}, @_ };
- $info->{whattouse} = 2;
- return 1;
-}
-
-sub ResStartXML {
- my $self = shift;
- my $info = $self->{_Res} || $self;
- $info->{xmldata} = undef;
- $info->{xmlobj} = XML::Writer->new(
- OUTPUT => \$info->{xmldata},
- NEWLINES => 0,
- ENCODING => 'UTF-8',
- DATA_MODE => 1,
- DATA_INDENT => 2,
- );
- $info->{xmlobj}->xmlDecl();
- $info->{contenttype} = "text/xml; charset=UTF-8";
- # disable caching on XML content, IE < 7 has "some" bugs...
- $self->ResAddHeader('Cache-Control' => 'must-revalidate, post-check=0, pre-check=0',
- 'Pragma' => 'public');
- $info->{whattouse} = 3;
- return $info->{xmlobj};
-}
-
-## And of course some methods to get the information
-sub ResGetXML {
- my $self = shift;
- my $info = $self->{_Res} || $self;
- return undef if !$info->{xmlobj} || !$info->{xmldata};
- $info->{xmlobj}->end();
- my $tmpvar = $info->{xmldata};
- undef $info->{xmldata};
- return $tmpvar;
-}
-
-sub ResGetBody {
- my $self = shift;
- my $info = $self->{_Res} || $self;
- my $whattouse = shift || $info->{whattouse};
- if($whattouse == 1) { return $info->{body}; }
- if($whattouse == 2) {
- $self->AddDefaultStuff() if exists $info->{tpl}->{page};
- my $start = [Time::HiRes::gettimeofday()] if $self->{debug} && $Time::HiRes::VERSION;
- my $output = $info->{tplo}->compile($info->{tpl});
- $info->{_tpltime} = Time::HiRes::tv_interval($start) if $self->{debug} && $Time::HiRes::VERSION;
- return $output;
- }
- if($whattouse == 3) { return $self->ResGetXML; }
-}
-
-sub ResGet {
- my $self = shift;
- my $info = $self->{_Res} || $self;
- my $whattouse = shift || $info->{whattouse};
-
- return ($info->{code}, $info->{headers}, $info->{contenttype}, $self->ResGetBody($whattouse));
-}
-
-
-my %scodes = (
- # just a few useful codes
- 200 => 'OK',
- 301 => 'Moved Permanently',
- 302 => 'Found',
- 303 => 'See Other',
- 304 => 'Not Modified',
- 307 => 'Temporary Redirect',
- 403 => 'Forbidden',
- 404 => 'Not Found',
- 500 => 'Internal Server Error'
-);
-
-# don't rename!
-sub ResSetModPerl {
- my $s = shift;
- my $i = $s->{_Res};
- printf "Status: %d %s\r\n", $i->{code}, $scodes{$i->{code}};
- print "X-Powered-By: Perl\r\n";
- printf "Content-Type: %s\r\n", $i->{contenttype} if $i->{contenttype};
- my $c=0;
- printf "%s: %s\r\n", $i->{headers}[$c++], $i->{headers}[$c++]
- while ($c<$#{$i->{headers}});
-
- my $b = $s->ResGetBody||'';
- if($b && $s->ReqHeader('Accept-Encoding') =~ /gzip/ && $i->{contenttype} =~ /^text/) {
- my $ol = bytes::length($b) if $s->{debug};
- $b = Compress::Zlib::memGzip(Encode::encode_utf8($b));
- $i->{_gzip} = [ $ol, bytes::length($b) ];
- print "Content-Encoding: gzip\n";
- }
- my $l = bytes::length($b);
- printf "Content-Length: %d\r\n", $l if $l;
- print "\r\n";
- print $b;
- $FCGI::Handler::outputted = 1;
-}
-
-1;