# -------------------------------------------------------------------------------------
# MKDoc::Registry
# -------------------------------------------------------------------------------------
#
#       Author : Jean-Michel Hiver (jhiver@mkdoc.com).
#    Copyright : (c) MKDoc Holdings Ltd, 2001
# 
#      This module is free software, it is distributed under the
#      same license as Perl itself
#
#    Description:
#
#      MKDoc::Registry is a replacement for Apache::Registry. Its sole purpose is
#      fix an Apache::Registry bug which causes Apache to send the document body
#      on HTTP HEAD requests
#
# -------------------------------------------------------------------------------------
package MKDoc::Registry;
use Apache::Registry;
use File::Spec;
use Carp;
use strict;
use vars qw /@ISA/;
@ISA = qw /Apache::Registry/;
use Data::Dumper;


##
# handler ($r);
# -------------
#   Handles the Apache $r request and fixes the HTTP HEAD request "feature" :-)
#   For some reason which I absolutely don't understand, redirecting STDOUT to
#   /dev/null makes apache output the headers only
##
sub handler
{
    my $r = shift;
    if ($r->header_only)
    {
	# File::Spec should give the right dev null file no matter
	# what the platform is
	my $devnull = File::Spec->devnull;
	
	# see perldoc -f open
	open DEVNULL, ">$devnull";
	open (OLDOUT, ">&STDOUT") or
	    croak "MKDoc::Registry - Cannot save STDOUT to OLDOUT";
	
	open (STDOUT, '>&DEVNULL') or
	    croak "MKDoc::Registry - Can't redirect stdout";
	
	select (STDOUT); $| = 1;
	
	# we have closed STDOUT, let's call the super class
	# handler function (BTW, it being a function rather than a
	# method really sucks, because I can't do $class->SUPER::handler ($r)
      Apache::Registry::handler ($r);
	
	# reopen STDOUT as if nothing happened
	close (STDOUT);
	close (DEVNULL);
	open (STDOUT, ">&OLDOUT") or
	    croak "MKDoc::Registry - Cannot restore STDOUT from OLDOUT";
    }
    else
    {
      Apache::Registry::handler ($r);
    }
}


1;