Perl/小物関数

URIエンコード/デコード

sub encode
{
	my ($src) = @_;
	$src =~ s/(\W)/'%' . unpack('H2', $1)/ego;
	return $src;
}

sub decode
{
	my ($src) = @_;
	$src =~ tr/+/ /;
	$src =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack('H2', $1)/ego;
	return $src;
}

形式変換

桁数にあわせて無理矢理切る。
早そうだが未確認。

sub dec2bin
{
	my $value	= int(shift);
	my $figure	= int(shift);
	$figure = 1 if ($figure <= 0);

	return substr(unpack("B32", pack("N", $value)), -$figure);
}

sub dec2bin
{
	my $value	= int(shift);
	my $figure	= int(shift);
	$figure = 1 if ($figure <= 0);

	while ($value > 0) {
		$retval = ($val % 2) . $retval;
		$val >>= 1;
		$figure--;
	}	
	return (0 x $figure) . $retval;
}

パス関係

package Path;

use strict;

=head2 chompSlash($path)

	最後の / を削除する
	$/ = '/'としているだけでchompと同様

=cut

sub chompSlash
{
	local $/ = '/';
	chomp @_;
}


=head2 absolute2relative2($base,$target)

	2つの絶対パスから相対パスを求める
	$base（のあるディレクトリ）から$targetへのパス

	@param	$baseはディレクトリ

	@return	ディレクトリの場合最後に/は含まない

=cut

sub absolute2relative2
{
	&chompSlash(@_);
	my ($base,$target) = @_;

	# 合っていることが確定したディレクトリ のインデックス
	my $indexDir = 0;
	# 合っていることが確認した文字列のインデックス
	my $index = 0;
	# チェックする長さ
	my $length = (length($base) < length($target)) ? length($base) : length($target);

	foreach my $i (0..$length-1) {
		if (substr($base,$i,1) eq substr($target,$i,1)) {
			# base[i] == target[i] (char単位)
			$index = $i;
			if (substr($base,$i,1) eq '/') {
				$indexDir = $i;
			}
		}
	}
	# 最後までマッチした場合の処理
	#
	# 片方の次の文字が /	→ foo と foo/〜
	# 両方''				→ foo と foo
	#
	# indexDir最後のディレクトリまで進める
	$indexDir = $length
		if ($index == $length-1
			and (	substr($base,$length,1) eq '/'
				or	substr($target,$length,1) eq '/'
				or	substr($base,$length,1) eq '' && substr($target,$length,1) eq '') );

	my $count = (substr($base,$indexDir) =~ s|/| |g);
	return '.' . ('/..' x $count) . substr($target,$indexDir);
}

1;