Tripletail::RawCookie - Tripletail::RawCookie documentation

  my $rawcookie = $TL->getRawCookie;

  my $val = $rawcookie->get('Cookie1');
  $rawcookie->set('Cookie2' => 'val2');

# -----------------------------------------------------------------------------
# Tripletail::RawCookie - 汎用的なクッキー管理を行う
# -----------------------------------------------------------------------------
package Tripletail::RawCookie;
use strict;
use warnings;
use Tripletail;

sub _POST_REQUEST_HOOK_PRIORITY() { -4_000_000 } # 順序は問わない

our $_INSTANCES = {}; # group => Tripletail::RawCookie

1;

sub _getInstance {
	my $class = shift;
	my $group = shift;

	if(!defined($group)) {
		$group = 'Cookie';
	}

	my $obj = $_INSTANCES->{$group};
	if($obj) {
		return $obj;
	}

	$obj = $_INSTANCES->{$group} = $class->__new($group);

	# postRequestフックに、保存されているインスタンスを削除する関数を
	# インストールする。そうしなければFCGIモードで過去のリクエストのクッキーが
	# いつまでも残る。
	$TL->setHook(
		'postRequest',
		_POST_REQUEST_HOOK_PRIORITY,
		sub {
			if(%$_INSTANCES) {
				%$_INSTANCES = ();
				#$TL->log('Tripletail::RawCookie' => 'Deleted a cookie object created in this request.');
			}
		},
	);

	$obj;
}

sub get {
	my $this = shift;
	my $name = shift;

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

	if(my $data = $this->{set_cookies}{$name}) {
		# setまたはdeleteされている。
		return $data;
	}

	$this->__readEnvIfNeeded;

	$this->{got_cookies}{$name};
}

sub set {
	my $this = shift;
	my $name = shift;
	my $value = shift;

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

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

	$this->{set_cookies}{$name} = $value;
	$this;
}

sub delete {
	my $this = shift;
	my $name = shift;

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

	$this->{set_cookies}{$name} = undef;
	$this;
}

sub clear {
	my $this = shift;

	$this->__readEnvIfNeeded;

	foreach my $key (keys %{$this->{got_cookies}},keys %{$this->{set_cookies}}) {
		$this->{set_cookies}{$key} = undef;
	}

	$this;
}

sub _makeSetCookies {
	# Set-Cookie:の値として使えるようにクッキーを文字列化するクラスメソッド。
	# 結果は配列で返される。
	my $class = shift;
	my @result;

	foreach my $this (values %$_INSTANCES) {
		push @result, $this->__makeSetCookie;
	}

	@result;
}

sub _isSecure {
	my $this = shift;
	$TL->INI->get($this->{group} => 'secure');
}

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

	$this->{group} = $group;
	$this->{read} = undef; # 環境変数からロードした後は真。
	$this->{got_cookies} = {}; # キー => 値 (飽くまでキャッシュ。{set_cookies}が優先される。)
	$this->{set_cookies} = {}; # キー => 値 (undefの値はクッキーの削除)

	$this;
}

sub __readEnvIfNeeded {
	# $ENV{HTTP_COOKIE}を読む。
	my $this = shift;

	if($this->{read}) {
		return $this;
	}

	if(my $cookie = $ENV{HTTP_COOKIE}) {
		$cookie =~ tr/\x0a\x0d//d;

		my $str;
		foreach my $pair (split /;/, $cookie) {
			$pair =~ s/ //g;

			my ($key, $value) = split /=/, $pair;
			$this->{got_cookies}{$key} = $value;
		}
	}

	$this->{read} = 1;
	$this;
}

sub __cookieTime {
	my $this = shift;
	my $epoch = shift;

	local $[ = 0;

	my @DoW = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
	my @MoY = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);

	my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime $epoch;
	$year += 1900;

	sprintf '%s, %02d-%s-%04d %02d:%02d:%02d GMT',
		$DoW[$wday], $mday, $MoY[$mon], $year, $hour, $min, $sec;
}

sub __makeSetCookie {
	my $this = shift;
	my @result;

	while(my ($key, $value) = each %{$this->{set_cookies}}) {
		my @parts;
		push @parts, sprintf('%s=%s', $key, defined $value ? $value : '');

		if(defined($value)) {
			if(defined(my $expires = $TL->INI->get($this->{group} => 'expires'))) {
				push @parts, "expires=".$this->__cookieTime(
					time + $TL->parsePeriod($expires));
			}
		} else {
			push @parts, "expires=".$this->__cookieTime(0);
		}

		if(defined(my $path = $TL->INI->get($this->{group} => 'path'))) {
			push @parts, "path=$path";
		}
		if(defined(my $domain = $TL->INI->get($this->{group} => 'domain'))) {
			push @parts, "domain=$domain";
		}
		if($TL->INI->get($this->{group} => 'secure')) {
			push @parts, 'secure';
		}
		if($TL->INI->get($this->{group} => 'httponly')) {
			push @parts, 'httponly';
		}

		my $line = join '; ', @parts;
		if(length($line) > 1024 * 4) {
			die __PACKAGE__."#_makeSetCookies: the cookie became too large. Decrease its content. [$line] (クッキーが大きくなりすぎました。保存するデータを減らしてください)";
		}

		push @result, $line;
	}

	@result;
}


__END__