blog.nomadscafe.jp

CGI.pmのheaderをHTTP headerを作るためだけに使いたいというときに、普通のCGIなら良いのですが、Apache::Registoryなどmod_perlで動かしていると、

my $str = $q->header(-charset=>'EUC-JP');

とした瞬間にApacheにsend_cgi_header(send_http_header)が送られてしまって具合よろしくありません。

my $str = $q->header(-charset=>'EUC-JP');
$strになにか処理。
print $str;

というのはうまく動かない。実際のところ$strは空です。CGI.pmのheaderメソッドは便利なので、これをもう少し汎用的に使いたいのでこれを修正したいと。CGI.pmのその分のコードをみると、

    my $header = join($CRLF,@header)."${CRLF}${CRLF}";
    if ($MOD_PERL and not $nph) {
        $self->r->send_cgi_header($header);
        return '';
    }
    return $header;

となっているので、$MOD_PERLの値をlocalで変更すればOKかなと思ってCGI.pmを継承してheader_as_stringメソッドを追加するモジュールをつくってみた。簡単なのでソース貼付け

package CGI::HeaderAsString;

use strict;
use CGI;
use Exporter;
use base qw(CGI);
use vars qw($VERSION);
$VERSION='0.01';

sub import{
	if(grep { /:(?:standard|cgi)/ } @_){
		my $header_as_string_sub= caller(0) . '::header_as_string';
		my $redirect_as_string_sub= caller(0) . '::redirect_as_string';
		{
			no strict 'refs';
			*{$header_as_string_sub}   = \&header_as_string;
			*{$redirect_as_string_sub}   = \&redirect_as_string;
		}
	}
	goto &CGI::import;
}

sub header_as_string {
	my($self,@p) = CGI::self_or_default(@_);
	local $CGI::HEADERS_ONCE=0;
	local $CGI::MOD_PERL=0;
	return $self->header(@p);
}

sub redirect_as_string{
	my($self,@p) = CGI::self_or_default(@_);
	local $CGI::HEADERS_ONCE=0;
	local $CGI::MOD_PERL=0;
	return $self->redirect(@p);
}


1;