#!/usr/bin/perl use strict; my $self = q(/~wakaba/-temp/test/http/encode/encoded.cgi); my $mode = $main::ENV{PATH_INFO}; my $src_hdr = <

Test (@{[escape($mode)]}) success!

Your Accept CE:: @{[escape($ENV{HTTP_ACCEPT_ENCODING})]}
Your Accept TE:: @{[escape($ENV{HTTP_TE})]}

EOH sub escape ($) { my $s = shift; $s =~ s/&/&/ge; $s =~ s//>/ge; $s =~ s/"/"/ge; $s; } if ($mode =~ /gzip-deflate/) { require Compress::Zlib; $src = Compress::Zlib::compress(Compress::Zlib::memGzip ($src)); print $src_hdr; print qq(Transfer-Encoding: gzip,deflate\n); print "\n"; print $src; } elsif ($mode =~ /chunked-gzip-chunked/) { require Compress::Zlib; $src = Compress::Zlib::memGzip (sprintf ('%X',length($src))."\x0D\x0A".$src."\x0D\x0A0\x0D\x0A\x0D\x0A"); print $src_hdr; print qq(Transfer-Encoding: gzip,chunked\n); print "\n"; print sprintf ('%X',length($src))."\x0D\x0A".$src."\x0D\x0A0\x0D\x0A\x0D\x0A"; } elsif ($mode =~ /gzip-chunked/) { require Compress::Zlib; $src = Compress::Zlib::memGzip ($src); print $src_hdr; print qq(Transfer-Encoding: gzip,chunked\n); print "\n"; print sprintf ('%X',length($src))."\x0D\x0A".$src."\x0D\x0A0\x0D\x0A\x0D\x0A"; } elsif ($mode =~ /gzip-chunked/) { require Compress::Zlib; $src = Compress::Zlib::memGzip (sprintf ('%X',length($src))."\x0D\x0A".$src."\x0D\x0A0\x0D\x0A\x0D\x0A"); print $src_hdr; print qq(Transfer-Encoding: gzip,chunked\n); print "\n"; print $src; } elsif ($mode =~ /gzip/) { require Compress::Zlib; $src = Compress::Zlib::memGzip ($src); print $src_hdr; my $e = 'gzip'; $e = 'x-gzip' if $mode =~ /x-gzip/; if ($mode !~ /transfer/) { print qq(Content-Encoding: $e\n); } else { print qq(Transfer-Encoding: $e\n); } print "\n"; print $src; } elsif ($mode =~ /deflate/) { require Compress::Zlib; $src = Compress::Zlib::compress ($src); print $src_hdr; my $e = 'deflate'; $e = 'x-deflate' if $mode =~ /x-deflate/; if ($mode !~ /transfer/) { print qq(Content-Encoding: $e\n); } else { print qq(Transfer-Encoding: $e\n); } print "\n"; print $src; } elsif ($mode =~ /bzip/) { print $src_hdr; my $e = 'bzip'; $e .= '2' if $mode =~ /bzip2/; $e = 'x-'.$e if $mode =~ /x-bzip/; if ($mode !~ /transfer/) { print qq(Content-Encoding: $e\n); } else { print qq(Transfer-Encoding: $e\n); } print "\n"; open BZ, "| bzip2"; print BZ $src; while (<>) { print; } close BZ; } elsif ($mode =~ /compress/) { print $src_hdr; my $e = 'compress'; $e = 'x-'.$e if $mode =~ /x-compress/; if ($mode !~ /transfer/) { print qq(Content-Encoding: $e\n); } else { print qq(Transfer-Encoding: $e\n); } print "\n"; open BZ, "| compress"; print BZ $src; while (<>) { print; } close BZ; } elsif ($mode =~ /deflate/) { print $src_hdr; if ($mode !~ /transfer/) { print qq(Content-Encoding: x-unknown\n); } else { print qq(Transfer-Encoding: x-unknown\n); } print "\n"; print $src; } elsif ($mode =~ /chunked-chunked/) { print $src_hdr; print qq(Transfer-Encoding: chunked,chunked ); $src = sprintf ('%X',length($src))."\x0D\x0A".$src."\x0D\x0A0\x0D\x0A\x0D\x0A"; print sprintf ('%X',length($src))."\x0D\x0A".$src."\x0D\x0A0\x0D\x0A\x0D\x0A"; } elsif ($mode =~ /chunked/) { print $src_hdr; my $nl = $mode =~ m!/cr/! ? "\x0D" : $mode =~ m!/lf/! ? "\x0A" : "\x0D\x0A"; my $param = ""; $param = "; x-param".$nl if $mode =~ m!/param/!; print qq(Transfer-Encoding: chunked @{[sprintf '%X', length($src)]}).$nl.$param; print $src.$nl; print q(0).$nl.$param; print "Some-Header: test".$nl if $mode =~ /trailer/; print $nl; } else { # identity print $src_hdr; print "\n"; print $src; }