view release on metacpan or  search on metacpan

lib/Tripletail/InputFilter.pm  view on Meta::CPAN

# -----------------------------------------------------------------------------
# Tripletail::InputFilter - CGIクエリパラメータを読み取る
# -----------------------------------------------------------------------------
package Tripletail::InputFilter;
use strict;
use warnings;
use Tripletail;

1;

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

	$this;
}

sub _formFromPairs {
	# 戻り値: Tripletail::Form
	my $this = shift;
	my $pairs = shift;
	my $filename_h = shift;

	my $incode = $this->_getIncode($pairs);

	my $form = $TL->newForm;
	foreach my $pair (@$pairs) {
		my ($key, $value) = @$pair;

		if( exists($filename_h->{$key}) )
		{
			# このキーに対するファイル名が存在する。
			$form->setFileName(
				$this->_raw2utf8($key => $incode) => $this->_raw2utf8($filename_h->{$key} => $incode));
		}

		if (ref $value) {
			$form->setFile(
				$this->_raw2utf8($key => $incode) => $value);
		}
		else {
			$form->add(
				$this->_raw2utf8($key => $incode) => $this->_raw2utf8($value => $incode)
			);
		}
	}

	$form;
}

sub _raw2utf8 {
	my $this = shift;
	my $str = shift;
	my $incode = shift;

	$TL->charconv($str, $incode => 'utf8');
}

sub _getIncode {
	# 戻り値: UniJP文字コード名
	my $this = shift;
	my $pairs = shift;

	# CCCを探し、文字コードを判定。
	my $CCC;
	for(my $i = 0; $i < @$pairs; $i++) {
		if($pairs->[$i][0] eq 'CCC' && $pairs->[$i][1]) {
			$CCC = $pairs->[$i][1];

			splice @$pairs, $i, 1; # CCCをpairsから消す
			last;
		}
	}