Tripletail::Filter - CGI出力加工

  $TL->setContentFilter('Tripletail::Filter::HTML', charset => 'UTF-8');

  $TL->print("foo\n");

# -----------------------------------------------------------------------------
# Tripletail::Filter - CGI出力加工
# -----------------------------------------------------------------------------
package Tripletail::Filter;
use strict;
use warnings;
use Tripletail;

1;

sub _new {
	my $class = shift;
	my $this = bless {} => $class;

	# 既にヘッダを出力したかどうか
	$this->{header_flushed} = undef;

	# 置換するヘッダ(setHeaderで設定されたもの)
	$this->{replacement} = {}; # {キー => 値}

	# 追加するヘッダ(addHeaderで設定されたもの)
	$this->{addition} = {}; # {キー => [値, ...]}

	$this->{option} = { @_ };

	$this;
}

sub setHeader {
	my $this = shift;
	my $key = shift;
	my $value = shift;

	if(!defined($key)) {
		die __PACKAGE__."#setHeader: arg[1] is not defined. (第1引数が指定されていません)\n";
	} elsif(ref($key)) {
		die __PACKAGE__."#setHeader: arg[1] is a reference. [$key] (第1引数がリファレンスです)\n";
	}

	if(!defined($value)) {
		die __PACKAGE__."#setHeader: arg[2] is not defined. (第1引数が指定されていません)\n";
	} elsif(ref($value)) {
		die __PACKAGE__."#setHeader: arg[2] is a reference. [$value] (第1引数がリファレンスです)\n";
	}

	$this->{replacement}{$key} = $value;
	$this;
}

sub addHeader {
	my $this = shift;
	my $key = shift;
	my $value = shift;

	if(!defined($key)) {
		die __PACKAGE__."#addHeader: arg[1] is not defined. (第1引数が指定されていません)\n";
	} elsif(ref($key)) {
		die __PACKAGE__."#addHeader: arg[1] is a reference. [$key] (第1引数がリファレンスです)\n";
	}

	if(!defined($value)) {
		die __PACKAGE__."#addHeader: arg[2] is not defined. (第2引数が指定されていません)\n";
	} elsif(ref($value)) {
		die __PACKAGE__."#addHeader: arg[2] is a reference. [$value] (第2引数がリファレンスです)\n";
	}

	my $old = $this->{addition}{$key};
	if($old) {
		push @$old, $value;
	} else {
		$this->{addition}{$key} = [$value];
	}

	$this;
}

sub print {
	# デフォルトの実装。必要に応じてオーバーライドする。
	my $this = shift;
	my $data = shift;

	if(ref($data)) {
		die __PACKAGE__."#print: arg[1] is a reference. [$data] (第1引数がリファレンスです)\n";
	}

	my $output = $this->_flush_header;
	$output .= $data;

	$output;
}

sub flush {
	# デフォルトの実装。必要に応じてオーバーライドする。
	my $this = shift;

	my $data = $this->_flush_header;

	$data;
}

sub _make_header {
	# フィルタが独自のヘッダを追加する場合は
	# このメソッドをオーバーライドする。

	# 戻り値: {ヘッダ名 => 値}
	#         または {ヘッダ名 => [値1, 値2, ...]}
	return {};
}

sub _flush_header {
	my $this = shift;
	if($this->{header_flushed}) {
		# 既にヘッダは出力済み。
		return '';
	}

	my $header = $this->_make_header;

	# 置換
	while(my ($key, $val) = each %{$this->{replacement}}) {
		$header->{$key} = $val;
	}

	# 追加
	while(my ($key, $val) = each %{$this->{addition}}) {
		my $oldval = $header->{$key};
		if(!defined($oldval)) {
			$header->{$key} = $val;
		} elsif(ref($oldval) eq 'ARRAY') {
			push @$oldval, @$val;
		} else {
			$header->{$key} = [$oldval, @$val];
		}
	}

	my $output;
	if( $TL->{mod_perl} )
	{
		my $r = $TL->{mod_perl}{request};
		$r->content_type(delete $header->{'Content-Type'});
		if( exists($header->{'Location'}) )
		{
			$r->status(302); # 302 Found.
		}
		my $headers_out = $r->headers_out;
		while(my ($key, $val) = each %$header) {
			if(ref($val) eq 'ARRAY') {
				foreach(@$val) {
					$headers_out->add($key, $_);
				}
			} else {
				$headers_out->set($key, $val);
			}
		}
		$output = '';
	}else
	{
		# 文字列化
		while(my ($key, $val) = each %$header) {
			if(ref($val) eq 'ARRAY') {
				foreach(@$val) {
					$output .= sprintf "%s: %s\r\n", $key, $_;
				}
			} else {
				$output .= sprintf "%s: %s\r\n", $key, $val;
			}
		}
		$output .= "\r\n";
	}

	$this->{header_flushed} = 1;
	$output;
}

sub _fill_option_defaults {
	my $this = shift;
	my $defaults = shift;

	foreach(@$defaults) {
		my ($key, $val) = @$_;
		if(exists($this->{option}{$key})) {
			next;
		}

		$this->{option}{$key} = do {
			if(ref($val) eq 'CODE') {
				$val->();
			} else {
				$val;
			}
		};
	}

	$this;
}

sub _check_options {
	my $this = shift;
	my $check = shift;

	foreach my $key (keys %$check) {
		if(!(exists $this->{option}{$key})) {
			# 未定義だった
			$this->{option}{$key} = undef;
		}
	}

	while(my ($key, $val) = each %{$this->{option}}) {
		my $list = $check->{$key};
		if(!defined($list)) {
			# このオプションは許されていない。
			die "TL#setContentFilter: ".ref($this)." does not accept option [$key]. (${key}は使用できないオプションです)\n";
		}

		foreach(@$list) {
			if($_ eq 'defined') {
				if(!defined($val)) {
					die "TL#setContentFilter: ".ref($this).": option [$key] has to be defined. (${key}オプションが指定されていません)\n";
				}
			} elsif($_ eq 'no_empty') {
				if(defined($val) && !ref($val) && $val eq '') {
					die "TL#setContentFilter: ".ref($this).": option [$key] has to be not empty. (${key}オプションが空です)\n";
				}
			} elsif($_ eq 'scalar') {
				if(defined($val) && ref($val)) {
					die "TL#setContentFilter: ".ref($this).": option [$key] has to be not a reference. [$val] (${key}オプションがリファレンスです)\n";
				}
			} elsif($_ eq 'array') {
				if(defined($val) && ref($val) ne 'ARRAY') {
					die "TL#setContentFilter: ".ref($this).": option [$key] has to be an ARRAY Ref. [$val] (${key}オプションが配列のリファレンスではありません)\n";
				}
			} else {
				die "TL#setContentFilter: ".ref($this).": internal error; unknown check type [$_]. (内部エラー:${key}オプションのチェック方法が不明です)\n";
			}
		}
	}

	$this;
}

sub reset {
	# デフォルトの実装。必要に応じてオーバーライドする。
	my $this = shift;

	$this->{header_flushed} = undef;
	%{$this->{replacement}} = ();
	%{$this->{addition}} = ();

	$this;
}


__END__