[MKDoc-commit] [MKDoc-Apache-Cache] refactoring,
tests and documentation
bruno at mkdoc.demon.co.uk
bruno at mkdoc.demon.co.uk
Fri Apr 1 17:11:48 BST 2005
Log Message:
-----------
[MKDoc-Apache-Cache] refactoring, tests and documentation
Modified Files:
--------------
MKDoc-Apache_Cache:
Changes
MANIFEST
META.yml
MKDoc-Apache_Cache/lib/MKDoc:
Apache_Cache.pm
MKDoc-Apache_Cache/t:
001.t
Added Files:
-----------
MKDoc-Apache_Cache/lib/MKDoc/Apache_Cache:
Capture.pm
util.pm
MKDoc-Apache_Cache/t:
002.http_date.t
003.uncompress_body.t
004.strip_headers.t
005.make_cache_friendly.t
MKDoc-Apache_Cache/t/data:
gzipped-no-body-no-separator.mime
gzipped-no-body.mime
gzipped-with-body.mime
no-body-no-separator.mime
no-body.mime
with-body.mime
-------------- next part --------------
Index: MANIFEST
===================================================================
RCS file: /var/spool/cvs/MKDoc-Apache_Cache/MANIFEST,v
retrieving revision 1.1
retrieving revision 1.2
diff -LMANIFEST -LMANIFEST -u -r1.1 -r1.2
--- MANIFEST
+++ MANIFEST
@@ -1,7 +1,20 @@
+.cvsignore
Changes
lib/MKDoc/Apache_Cache.pm
+lib/MKDoc/Apache_Cache/Capture.pm
+lib/MKDoc/Apache_Cache/util.pm
Makefile.PL
MANIFEST This list of files
META.yml
README
t/001.t
+t/002.http_date.t
+t/003.uncompress_body.t
+t/004.strip_headers.t
+t/005.make_cache_friendly.t
+t/data/gzipped-no-body-no-separator.mime
+t/data/gzipped-no-body.mime
+t/data/gzipped-with-body.mime
+t/data/no-body-no-separator.mime
+t/data/no-body.mime
+t/data/with-body.mime
Index: META.yml
===================================================================
RCS file: /var/spool/cvs/MKDoc-Apache_Cache/META.yml,v
retrieving revision 1.1
retrieving revision 1.2
diff -LMETA.yml -LMETA.yml -u -r1.1 -r1.2
--- META.yml
+++ META.yml
@@ -1,7 +1,7 @@
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: MKDoc-Apache_Cache
-version: 0.71
+version: 0.72
version_from: lib/MKDoc/Apache_Cache.pm
installdirs: site
requires:
Index: Changes
===================================================================
RCS file: /var/spool/cvs/MKDoc-Apache_Cache/Changes,v
retrieving revision 1.12
retrieving revision 1.13
diff -LChanges -LChanges -u -r1.12 -r1.13
--- Changes
+++ Changes
@@ -1,5 +1,8 @@
Revision history for MKDoc::Apache_Cache
+0.72
+ - Refactoring and documentation
+
0.71 Thu Feb 3 15:45:00 2005
- Fixed some 'uninitialized value in length' warnings when delivering
content without body
Index: Apache_Cache.pm
===================================================================
RCS file: /var/spool/cvs/MKDoc-Apache_Cache/lib/MKDoc/Apache_Cache.pm,v
retrieving revision 1.17
retrieving revision 1.18
diff -Llib/MKDoc/Apache_Cache.pm -Llib/MKDoc/Apache_Cache.pm -u -r1.17 -r1.18
--- lib/MKDoc/Apache_Cache.pm
+++ lib/MKDoc/Apache_Cache.pm
@@ -1,45 +1,3 @@
-package MKDoc::Apache_Cache::Capture;
-use base qw /Apache::RegistryNG Apache/;
-use bytes;
-
-sub new
-{
- my ($class, $r) = @_;
- $r ||= Apache->request();
-
- tie *STDOUT, $class, $r;
- return tied *STDOUT;
-}
-
-
-sub print
-{
- my $self = shift;
- $self->{_data} ||= '';
- $self->{_data} .= join ('', @_);
-}
-
-
-sub data
-{
- my $self = shift;
- return $self->{_data};
-}
-
-
-sub TIEHANDLE
-{
- my ($class, $r) = @_;
- return bless { r => $r, _r => $r, _data => undef }, $class;
-}
-
-
-sub PRINT
-{
- shift->print (@_);
-}
-
-
package MKDoc::Apache_Cache;
use base qw /Apache::RegistryNG/;
use strict;
@@ -47,14 +5,14 @@
use Apache;
use Apache::Constants;
use MKDoc::Control_List;
+use MKDoc::Apache_Cache::Capture;
+use MKDoc::Apache_Cache::util qw /make_cache_friendly uncompress_body http_date expiration_time/;
use Cache::FileCache;
use File::Spec;
use vars qw /$Request/;
use CGI;
-use Compress::Zlib;
-use Digest::MD5;
-our $VERSION = '0.71';
+our $VERSION = '0.72';
sub handler ($$)
@@ -86,17 +44,7 @@
# ungzip && send.
$ENV{HTTP_ACCEPT_ENCODING} ||= '';
lc $ENV{'HTTP_ACCEPT_ENCODING'} !~ /gzip/ and do {
-
- my ($headers, $body) = split /\r?\n\r?\n/, $data, 2;
- $body ||= '';
- $headers = join "\r\n",
- grep !/content-length\:/i,
- grep !/content-encoding\:/i,
- grep !/vary\:/i,
- split /\r?\n/, $headers;
- $body = Compress::Zlib::memGunzip ($body);
- $headers .= "\r\nContent-Length: " . length ($body) if ($body);
- $data = $headers . "\r\n\r\n" . $body;
+ $data = uncompress_body ($data);
};
$ENV{REQUEST_METHOD} =~ /HEAD/i and do {
@@ -108,6 +56,8 @@
return $n_ret;
}
+# args when not in cache: ('30 min', 'GET:www.example.com/')
+# otherwise empty
sub _do_cached
{
@@ -116,7 +66,7 @@
my $timeout = shift || return $class->_do_request();
my $identifier = shift || $class->_default_identifier();
- $timeout = _expiration_time ($timeout);
+ $timeout = expiration_time ($timeout);
my $cache_obj = $class->_cache_object();
my $cached = $cache_obj->get ($identifier) || do {
@@ -130,7 +80,7 @@
return ($ret, $data) if ($data =~ /\nSet-Cookie:.+/);
# add expires: header to be stored in the cached file
- my $expires = _http_date ($timeout + time());
+ my $expires = http_date ($timeout + time());
$data =~ s/\r?\n\r?\n/\r\nExpires: $expires\r\n\r\n/;
$cache_obj->set ($identifier, "$ret\n$data", $timeout);
@@ -146,10 +96,11 @@
my $class = shift;
my $fake_r = MKDoc::Apache_Cache::Capture->new ($Request);
my $ret = $class->SUPER::handler ($fake_r);
- return ($ret, _make_cache_friendly ($fake_r->data()));
+ return ($ret, make_cache_friendly ($fake_r->data()));
}
+# never gets called??
sub _default_identifier
{
my $class = shift;
@@ -202,100 +153,6 @@
defined $val and do { $args->{$opt} = $val };
}
-
-# borrowed from http://www.mnot.net/cgi_buffer/
-# --------------------------------------------------------------------------------
-# (c) 2000 Copyright Mark Nottingham
-# <mnot at pobox.com>
-#
-# This software may be freely distributed, modified and used,
-# provided that this copyright notice remain intact.
-#
-# This software is provided 'as is' without warranty of any kind.
-#
-# Note from JM: This has been heavily modified from the original, which uses
-# deprecated libs, doesn't compile under 'use strict', and doesn't care about
-# unicode.
-sub _make_cache_friendly
-{
- my $buf = shift;
- $buf ||= '';
- my ($headers, $body) = split /\r?\n\r?\n/, $buf, 2;
- $headers ||= '';
- $body ||= '';
- my @o = ();
-
- # Figure out some kind of content_type
- my ($content_type) = grep /^content-type\:/i, split (/\r?\n/, $headers);
- $content_type ||= 'application/octet-stream';
-
- # Gzip body if content type probably needs gzipping
-
- # Vary: Accept-Encoding is here to tell proxies to keep a separate
- # cache for every different Accept-Encoding that is being sent.
- $content_type !~ /zip/ and $content_type =~ /(text|xml)/ and do {
- $body = Compress::Zlib::memGzip ($body);
- push @o, "Content-Encoding: gzip";
- push @o, "Vary: Accept-Encoding";
- };
-
- # Compute ETag
- push @o, "ETag: " . Digest::MD5::md5_hex ($body) if ($body);
-
- # Compute Content-Length
- push @o, "Content-Length: " . length ($body) if ($body);
-
- push @o, $headers;
- push @o, "";
- push @o, $body;
- return join "\r\n", @o;
-}
-
-
-# borrowed from http://search.cpan.org/src/RSE/lcwa-1.0.0/lib/lwp/lib/HTTP/Date.pm
-# --------------------------------------------------------------------------------
-our @DoW = qw(Sun Mon Tue Wed Thu Fri Sat);
-our @MoY = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
-
-sub _http_date (;$)
-{
- my $time = shift;
- $time = time unless defined $time;
- my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($time);
- sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
- $DoW[$wday],
- $mday, $MoY[$mon], $year+1900,
- $hour, $min, $sec);
-}
-# --------------------------------------------------------------------------------
-
-
-# borrowed / modded from Cache::BaseCache
-# --------------------------------------------------------------------------------
-our $EXPIRES_NOW = 'now';
-our $EXPIRES_NEVER = 'never';
-our %Expiration_Units = ( map(($_, 1), qw(s second seconds sec)),
- map(($_, 60), qw(m minute minutes min)),
- map(($_, 60*60), qw(h hour hours)),
- map(($_, 60*60*24), qw(d day days)),
- map(($_, 60*60*24*7), qw(w week weeks)),
- map(($_, 60*60*24*30), qw(M month months)),
- map(($_, 60*60*24*365), qw(y year years)) );
-sub _expiration_time
-{
- my ($p_expires_in) = @_;
- uc ($p_expires_in) eq uc ($EXPIRES_NOW) and return 0;
- uc ($p_expires_in) eq uc ($EXPIRES_NEVER) and return;
- $p_expires_in =~ /^\s*([+-]?(?:\d+|\d*\.\d*))\s*$/ and return $p_expires_in;
- $p_expires_in =~ /^\s*([+-]?(?:\d+|\d*\.\d*))\s*(\w*)\s*$/ and
- exists $Expiration_Units{$2} and
- return $Expiration_Units{$2} * $1;
-
- return 0;
-}
-# --------------------------------------------------------------------------------
-
-
1;
--- /dev/null
+++ lib/MKDoc/Apache_Cache/Capture.pm
@@ -0,0 +1,43 @@
+package MKDoc::Apache_Cache::Capture;
+use base qw /Apache::RegistryNG Apache/;
+use bytes;
+
+sub new
+{
+ my ($class, $r) = @_;
+ $r ||= Apache->request();
+
+ tie *STDOUT, $class, $r;
+ return tied *STDOUT;
+}
+
+
+sub print
+{
+ my $self = shift;
+ $self->{_data} ||= '';
+ $self->{_data} .= join ('', @_);
+}
+
+
+sub data
+{
+ my $self = shift;
+ return $self->{_data};
+}
+
+
+sub TIEHANDLE
+{
+ my ($class, $r) = @_;
+ return bless { r => $r, _r => $r, _data => undef }, $class;
+}
+
+
+sub PRINT
+{
+ shift->print (@_);
+}
+
+1;
+
--- /dev/null
+++ lib/MKDoc/Apache_Cache/util.pm
@@ -0,0 +1,179 @@
+package MKDoc::Apache_Cache::util;
+
+=head1 NAME
+
+MKDoc::Apache_Cache::util - utilities for MKDoc::Apache_Cache
+
+=head1 SYNOPSIS
+
+L<MKDoc::Apache_Cache> functions for manipulating HTTP responses
+
+=head2 Utility functions
+
+=cut
+
+use strict;
+use warnings;
+use Compress::Zlib;
+use Digest::MD5;
+use Exporter;
+use vars qw /@ISA @EXPORT_OK/;
+ at ISA = qw /Exporter/;
+ at EXPORT_OK = qw /make_cache_friendly uncompress_body http_date expiration_time/;
+
+# borrowed from http://www.mnot.net/cgi_buffer/
+# --------------------------------------------------------------------------------
+# (c) 2000 Copyright Mark Nottingham
+# <mnot at pobox.com>
+#
+# This software may be freely distributed, modified and used,
+# provided that this copyright notice remain intact.
+#
+# This software is provided 'as is' without warranty of any kind.
+#
+# Note from JM: This has been heavily modified from the original, which uses
+# deprecated libs, doesn't compile under 'use strict', and doesn't care about
+# unicode.
+
+sub make_cache_friendly ($)
+{
+ my $data = shift;
+ return '' unless $data;
+ my ($headers, $body) = _split_headers_body ($data);
+ my @o = ();
+
+ # Figure out some kind of content_type
+ my ($content_type) = grep /^content-type\:/i, split (/\r?\n/, $headers);
+ $content_type ||= '';
+
+ my ($content_encoding) = grep /^content-encoding\:/i, split (/\r?\n/, $headers);
+ $content_encoding ||= '';
+
+ # we are going to recalculate these
+ $headers = _strip_headers ($headers, 'content-length', 'etag');
+
+ # TODO ETag needs to vary if the uri varies
+
+ # Compute ETag. should be the same whether gzipped or not
+ push @o, "ETag: " . Digest::MD5::md5_hex ($body) if ($body =~ /./);
+
+ # Gzip body if content probably needs gzipping
+ $content_type !~ /zip/ and $content_type =~ /(text|xml)/ and $content_encoding !~ /zip/ and do {
+ $body = Compress::Zlib::memGzip ($body) if ($body =~ /./);
+ # Vary: Accept-Encoding is here to tell proxies to keep a separate
+ # cache for every different Accept-Encoding that is being sent.
+ $headers = _strip_headers ($headers, 'content-encoding', 'vary');
+ push @o, "Content-Encoding: gzip";
+ push @o, "Vary: Accept-Encoding";
+ };
+
+ # Compute Content-Length
+ push @o, "Content-Length: " . length ($body) if ($body =~ /./);
+
+ push @o, $headers;
+ push @o, "";
+ push @o, $body;
+ return join "\r\n", @o;
+}
+
+=pod
+
+Given a simple HTTP response structure consisting of a header and an optional
+single mime part. Uncompress the body if it is gzipped, otherwise leave it
+alone.
+
+ $data = uncompress_body ($data);
+
+As appropriate, this removes any 'Vary:' or 'Content-Encoding:' headers and
+recalculates the 'Content-Length:'.
+
+=cut
+
+sub uncompress_body ($)
+{
+ my $data = shift;
+ my ($headers, $body) = _split_headers_body ($data);
+ return $data unless $headers =~ /(^|\r?\n)content-encoding: gzip($|\r?\n)/i;
+ $headers = _strip_headers ($headers, 'content-length', 'content-encoding', 'vary');
+ $body = Compress::Zlib::memGunzip ($body) if ($body =~ /./);
+ $headers .= "\r\nContent-Length: " . length ($body);
+ $data = $headers . "\r\n\r\n" . $body;
+ return $data;
+}
+
+sub _split_headers_body ($)
+{
+ my $data = shift;
+ my ($headers, $body) = split /\r?\n\r?\n/, $data, 2;
+ $body ||= '';
+ $headers =~ s/[\r\n]+$//;
+ return ($headers, $body);
+}
+
+sub _strip_headers ($@)
+{
+ my $headers = shift;
+ return $headers unless @_;
+ my $killregex = '('. join ('|', @_) .')';
+ $headers = join "\r\n",
+ grep !/^$killregex\:/i,
+ split /\r?\n/, $headers;
+ return $headers;
+}
+
+=pod
+
+Assemble an HTTP style date string like so:
+
+ $out = MKDoc::Apache_Cache::http_date (1112396898);
+
+$out is now 'Fri, 01 Apr 2005 23:08:18 GMT'
+
+=cut
+
+# borrowed from http://search.cpan.org/src/RSE/lcwa-1.0.0/lib/lwp/lib/HTTP/Date.pm
+# --------------------------------------------------------------------------------
+our @DoW = qw(Sun Mon Tue Wed Thu Fri Sat);
+our @MoY = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
+
+sub http_date (;$)
+{
+ my $time = shift;
+ $time = time unless defined $time;
+ my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($time);
+ sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
+ $DoW[$wday],
+ $mday, $MoY[$mon], $year+1900,
+ $hour, $min, $sec);
+}
+# --------------------------------------------------------------------------------
+
+
+# borrowed / modded from Cache::BaseCache
+# --------------------------------------------------------------------------------
+our $EXPIRES_NOW = 'now';
+our $EXPIRES_NEVER = 'never';
+our %Expiration_Units = ( map(($_, 1), qw(s second seconds sec)),
+ map(($_, 60), qw(m minute minutes min)),
+ map(($_, 60*60), qw(h hour hours)),
+ map(($_, 60*60*24), qw(d day days)),
+ map(($_, 60*60*24*7), qw(w week weeks)),
+ map(($_, 60*60*24*30), qw(M month months)),
+ map(($_, 60*60*24*365), qw(y year years)) );
+sub expiration_time
+{
+ my ($p_expires_in) = @_;
+ uc ($p_expires_in) eq uc ($EXPIRES_NOW) and return 0;
+ uc ($p_expires_in) eq uc ($EXPIRES_NEVER) and return;
+ $p_expires_in =~ /^\s*([+-]?(?:\d+|\d*\.\d*))\s*$/ and return $p_expires_in;
+ $p_expires_in =~ /^\s*([+-]?(?:\d+|\d*\.\d*))\s*(\w*)\s*$/ and
+ exists $Expiration_Units{$2} and
+ return $Expiration_Units{$2} * $1;
+
+ return 0;
+}
+# --------------------------------------------------------------------------------
+
+
+1;
+
--- /dev/null
+++ t/005.make_cache_friendly.t
@@ -0,0 +1,60 @@
+use strict;
+use warnings;
+use Test::More 'no_plan';
+
+use lib ('lib', '../lib');
+use MKDoc::Apache_Cache::util;
+use Digest::MD5;
+
+local $/;
+my $data;
+
+open FILE, "<t/data/gzipped-with-body.mime";
+binmode (FILE, ":bytes");
+$data = <FILE>;
+close FILE;
+is (length ($data), 524);
+$data = MKDoc::Apache_Cache::util::make_cache_friendly ($data);
+is (length ($data), 524);
+
+
+open FILE, "<t/data/with-body.mime";
+binmode (FILE, ":bytes");
+$data = <FILE>;
+close FILE;
+$data = MKDoc::Apache_Cache::util::make_cache_friendly ($data);
+is (length ($data), 524);
+
+open FILE, "<t/data/gzipped-no-body.mime";
+binmode (FILE, ":bytes");
+$data = <FILE>;
+close FILE;
+$data = MKDoc::Apache_Cache::util::make_cache_friendly ($data);
+is (Digest::MD5::md5_hex ($data), '304411703242bdc037de3a44650f5f94');
+
+
+open FILE, "<t/data/gzipped-no-body-no-separator.mime";
+binmode (FILE, ":bytes");
+$data = <FILE>;
+close FILE;
+$data = MKDoc::Apache_Cache::util::make_cache_friendly ($data);
+is (Digest::MD5::md5_hex ($data), '304411703242bdc037de3a44650f5f94');
+
+
+open FILE, "<t/data/no-body.mime";
+binmode (FILE, ":bytes");
+$data = <FILE>;
+close FILE;
+
+$data = MKDoc::Apache_Cache::util::make_cache_friendly ($data);
+is (Digest::MD5::md5_hex ($data), '304411703242bdc037de3a44650f5f94');
+
+
+open FILE, "<t/data/no-body-no-separator.mime";
+binmode (FILE, ":bytes");
+$data = <FILE>;
+close FILE;
+
+$data = MKDoc::Apache_Cache::util::make_cache_friendly ($data);
+is (Digest::MD5::md5_hex ($data), '304411703242bdc037de3a44650f5f94');
+
--- /dev/null
+++ t/003.uncompress_body.t
@@ -0,0 +1,111 @@
+use strict;
+use warnings;
+use Test::More 'no_plan';
+
+use lib ('lib', '../lib');
+use MKDoc::Apache_Cache::util;
+
+local $/;
+my $data;
+
+open FILE, "<t/data/gzipped-with-body.mime";
+binmode (FILE, ":bytes");
+$data = <FILE>;
+close FILE;
+
+like ($data, '/Content-Length: 334/');
+
+$data = MKDoc::Apache_Cache::util::uncompress_body ($data);
+
+like ($data, '/ETag: 3ca4b7f2c6ce8e2dc8f88237a2e125ea/');
+like ($data, '/Content-Type: text/html; charset=UTF-8/');
+like ($data, '/Expires: Thu, 31 Mar 2005 16:47:26 GMT/');
+like ($data, '/Content-Length: 578/');
+like ($data, '/<!DOCTYPE html PUBLIC/');
+like ($data, '/</html>/');
+unlike ($data, '/Content-Encoding: gzip/');
+
+
+open FILE, "<t/data/with-body.mime";
+binmode (FILE, ":bytes");
+$data = <FILE>;
+close FILE;
+
+$data = MKDoc::Apache_Cache::util::uncompress_body ($data);
+
+like ($data, '/ETag: 3ca4b7f2c6ce8e2dc8f88237a2e125ea/');
+like ($data, '/Content-Type: text/html; charset=UTF-8/');
+like ($data, '/Expires: Thu, 31 Mar 2005 16:47:26 GMT/');
+like ($data, '/Content-Length: 578/');
+like ($data, '/<!DOCTYPE html PUBLIC/');
+like ($data, '/</html>/');
+unlike ($data, '/Content-Encoding: gzip/');
+
+
+open FILE, "<t/data/gzipped-no-body.mime";
+binmode (FILE, ":bytes");
+$data = <FILE>;
+close FILE;
+
+like ($data, '/Content-Length: 0/');
+
+$data = MKDoc::Apache_Cache::util::uncompress_body ($data);
+
+like ($data, '/Content-Type: text/html; charset=UTF-8/');
+like ($data, '/Expires: Thu, 31 Mar 2005 16:47:26 GMT/');
+like ($data, '/Content-Length: 0/');
+unlike ($data, '/Content-Encoding: gzip/');
+unlike ($data, '/<!DOCTYPE html PUBLIC/');
+
+
+open FILE, "<t/data/gzipped-no-body-no-separator.mime";
+binmode (FILE, ":bytes");
+$data = <FILE>;
+close FILE;
+
+like ($data, '/Content-Length: 0/');
+
+$data = MKDoc::Apache_Cache::util::uncompress_body ($data);
+
+like ($data, '/Content-Type: text/html; charset=UTF-8/');
+like ($data, '/Expires: Thu, 31 Mar 2005 16:47:26 GMT/');
+like ($data, '/Content-Length: 0/');
+unlike ($data, '/Content-Encoding: gzip/');
+unlike ($data, '/<!DOCTYPE html PUBLIC/');
+
+
+
+
+open FILE, "<t/data/no-body.mime";
+binmode (FILE, ":bytes");
+$data = <FILE>;
+close FILE;
+
+like ($data, '/Content-Length: 0/');
+
+$data = MKDoc::Apache_Cache::util::uncompress_body ($data);
+
+like ($data, '/Content-Type: text/html; charset=UTF-8/');
+like ($data, '/Expires: Thu, 31 Mar 2005 16:47:26 GMT/');
+like ($data, '/Content-Length: 0/');
+unlike ($data, '/Content-Encoding: gzip/');
+unlike ($data, '/<!DOCTYPE html PUBLIC/');
+
+
+
+open FILE, "<t/data/no-body-no-separator.mime";
+binmode (FILE, ":bytes");
+$data = <FILE>;
+close FILE;
+
+like ($data, '/Content-Length: 0/');
+
+$data = MKDoc::Apache_Cache::util::uncompress_body ($data);
+
+like ($data, '/Content-Type: text/html; charset=UTF-8/');
+like ($data, '/Expires: Thu, 31 Mar 2005 16:47:26 GMT/');
+like ($data, '/Content-Length: 0/');
+unlike ($data, '/Content-Encoding: gzip/');
+unlike ($data, '/<!DOCTYPE html PUBLIC/');
+
+
Index: 001.t
===================================================================
RCS file: /var/spool/cvs/MKDoc-Apache_Cache/t/001.t,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -Lt/001.t -Lt/001.t -u -r1.1.1.1 -r1.2
--- t/001.t
+++ t/001.t
@@ -1,2 +1,9 @@
+use strict;
+use warnings;
use Test::More 'no_plan';
-ok (1);
+use lib ('lib', '../lib');
+
+use_ok ('MKDoc::Apache_Cache');
+use_ok ('MKDoc::Apache_Cache::Capture');
+use_ok ('MKDoc::Apache_Cache::util');
+
--- /dev/null
+++ t/004.strip_headers.t
@@ -0,0 +1,39 @@
+use strict;
+use warnings;
+use Test::More 'no_plan';
+use lib ('lib', '../lib');
+
+use MKDoc::Apache_Cache::util;
+
+my $data =
+"Content-Type: text/plain\r
+From: Archie Apples <archie\@example.com>
+X-From: Evil Edna <evil\@example.com>
+To: MKDoc developers <mkdoc-dev\@lists.webarch.co.uk>\r
+
+Dear Sir,\r
+\r
+I wish to congratulate you on your spiffing software.\r
+
+Yours,
+
+Archie Apples";
+
+my ($headers, $body) = MKDoc::Apache_Cache::util::_split_headers_body ($data);
+
+like ($headers, '/mkdoc-dev@/');
+unlike ($body, '/mkdoc-dev@/');
+like ($body, '/spiffing/');
+unlike ($headers, '/spiffing/');
+
+$headers = MKDoc::Apache_Cache::util::_strip_headers ($headers, 'from');
+unlike ($headers, '/(^|\n|\r)From:/');
+like ($headers, '/(^|\n|\r)Content-Type:/');
+
+($headers, $body) = MKDoc::Apache_Cache::util::_split_headers_body ($data);
+
+$headers = MKDoc::Apache_Cache::util::_strip_headers ($headers, 'from', 'content-type');
+unlike ($headers, '/(^|\n|\r)From:/');
+unlike ($headers, '/(^|\n|\r)Content-Type:/');
+like ($headers, '/(^|\n|\r)To:/');
+
--- /dev/null
+++ t/002.http_date.t
@@ -0,0 +1,16 @@
+use strict;
+use warnings;
+use Test::More 'no_plan';
+
+use lib ('lib', '../lib');
+use_ok ('MKDoc::Apache_Cache::util');
+
+my $out;
+
+$out = MKDoc::Apache_Cache::util::http_date ();
+like ($out, '/^..., .. ... .... ..:..:.. GMT$/i', 'This looks like a HTTP date string');
+
+my $date = 1112396898;
+
+$out = MKDoc::Apache_Cache::util::http_date ($date);
+is ($out, 'Fri, 01 Apr 2005 23:08:18 GMT', "Correct date string for $date");
--- /dev/null
+++ t/data/with-body.mime
@@ -0,0 +1,20 @@
+ETag: 3ca4b7f2c6ce8e2dc8f88237a2e125ea
+Content-Type: text/html; charset=UTF-8
+Expires: Thu, 31 Mar 2005 16:47:26 GMT
+Content-Length: 578
+
+<!DOCTYPE html PUBLIC
+ "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en" dir="ltr">
+ <head>
+ <title>Test Document</title>
+ <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
+ <meta http-equiv="Content-Language" content="en" />
+ <meta content="vim" name="generator" />
+ </head>
+ <body lang="en" xml:lang="en" dir="ltr">
+ <h1>Test Document</h1>
+ <p>This is a test document for MKDoc::Apache_Cache</p>
+ </body>
+</html>
--- /dev/null
+++ t/data/no-body.mime
@@ -0,0 +1,4 @@
+Content-Length: 0
+Content-Type: text/html; charset=UTF-8
+Expires: Thu, 31 Mar 2005 16:47:26 GMT
+
--- /dev/null
+++ t/data/no-body-no-separator.mime
@@ -0,0 +1,3 @@
+Content-Length: 0
+Content-Type: text/html; charset=UTF-8
+Expires: Thu, 31 Mar 2005 16:47:26 GMT
--- /dev/null
+++ t/data/gzipped-no-body-no-separator.mime
@@ -0,0 +1,5 @@
+Content-Encoding: gzip
+Vary: Accept-Encoding
+Content-Length: 0
+Content-Type: text/html; charset=UTF-8
+Expires: Thu, 31 Mar 2005 16:47:26 GMT
--- /dev/null
+++ t/data/gzipped-no-body.mime
@@ -0,0 +1,6 @@
+Content-Encoding: gzip
+Vary: Accept-Encoding
+Content-Length: 0
+Content-Type: text/html; charset=UTF-8
+Expires: Thu, 31 Mar 2005 16:47:26 GMT
+
More information about the MKDoc-commit
mailing list