Tripletail::Value - Tripletail::Value documentation

  my $value = $TL->newValue('null@example.org');

  if ($value->isEmail) {
      print $value->get . " is a valid email address.\n";
  }

  # ｎｕｌｌ＠ｅｘａｍｐｌｅ．ｏｒｇ を表示
  print $value->convWide->get . "\n";

# -----------------------------------------------------------------------------
# Tripletail::Value - 値の検証や変換
# -----------------------------------------------------------------------------
package Tripletail::Value;
use strict;
use warnings;
use Tripletail;

#---------------------------------- 正規表現

my $atext = qr{[\w\!\#\$\%\&\'\*\+\-\/\=\?\^\_\`\{\|\}\~]+};
my $dotString = qr{[\w\!\#\$\%\&\'\*\+\-\/\=\?\^\_\`\{\|\}\~\.]*};
my $pcmailexp = qr{^
		((?:
	  	  (?:$atext(?:\.?$atext)*) # Dot-string
	 	 |
	  	  (?:"(\\[\x20-\x7f]|[\x21\x23-\x5b\x5d-\x7e])+")   # Quoted-string
		)) # Local-part
		\@
		([\w\-]+(?:\.[\w\-]+)+) # Domain-part
\z}x;
my $mobilemailexp = qr{^
		((?:
	  	  (?:$atext(?:$dotString)) # Dot-string
	 	 |
	  	  (?:"(\\[\x20-\x7f]|[\x21\x23-\x5b\x5d-\x7e])+")   # Quoted-string
		)) # Local-part
		\@
		([\w\-]+(?:\.[\w\-]+)+) # Domain-part
\z}x;

my $re_hira = qr/\xe3(?:\x81[\x81-\xbf]|\x82[\x80-\x93]|\x83\xbc)/; # xa-mi,mu-n,ー
my $re_kata = qr/\xe3(?:\x82[\xa1-\xbf]|\x83[\x80-\xb3]|\x83\xbc)/; # xa-ta,da-n,ー
my $re_char = qr/[\x00-\x7f]|[\xc0-\xdf][\x80-\xbf]|[\xe0-\xef][\x80-\xbf]{2}|[\xf0-\xf7][\x80-\xbf]{3}|[\xf8-\xfb][\x80-\xbf]{4}|[\xfc-\xfd][\x80-\xbf]{5}/;
my $re_widenum = qr/\xef\xbc[\x90-\x99]/;

my $re_ipv4_addr = qr{^
        (?: :: (?:f{4}:)? )?
		(
	    	    (?: 0* (?: 2[0-4]\d  |
				   				   25[0-5]   |
				   				   [01]?\d\d |
				   				   \d)
			    			    \.){3}
				0*
				(?: 2[0-4]\d   |
						25[0-5]    |
						[01]?\d\d  |
						\d)
		)
$}ix;

# IPv4 射影 IPv6 アドレス は未サポート
my $re_ipv6_addr = qr{^
        [:a-fA-F0-9]{2,39}
$}x;

# ドメイン
my $re_domain = do {

    my $letter = qr{
                [a-zA-Z]
        }x;

    my $letter_digit = qr{
                [a-zA-Z0-9]
        }x;

    my $letter_digit_hyphen = qr{
                [a-zA-Z0-9\-]
        }x;

    # RFC ではラベルの先頭に数字が来る事を禁止しているが、実際にはそのようなドメ
    # インが存在する。
    my $label = qr{
                ${letter_digit} # RFC としてはここは ${letter} が正しい。
                (?:
                        ${letter_digit_hyphen} {0,61} # ラベルは1文字以上63文字以内。
                        ${letter_digit}
                )?
        }x;
    
    my $domain = qr{^
                $label (?: \. $label)*
        $}x;

    $domain;
};

my @MOBILE_AGENTS = (
    # [正規表現, UniJP の文字コード名]
    
    [qr/^DoCoMo/i    , 'sjis-imode'],
    [qr/^ASTEL/i     , 'sjis-doti' ],
    [qr/^Vodafone/i  , 'utf8-jsky' ],
    [qr/^Vemulator/i , 'utf8-jsky' ],
    [qr/^SoftBank/i  , 'utf8-jsky' ],
    [qr/^Semulator/i , 'utf8-jsky' ],
    [qr/^MOT-/i      , 'utf8-jsky' ],
    [qr/^J-PHONE/i   , 'sjis-jsky' ],
    [qr/^J-EMULATOR/i, 'sjis-jsky' ],
    
    # Softbank端末かつUP.Browserを含むものもあるのでSoftbankの後に判別すること
    [qr/UP\.Browser/i, 'sjis-au'   ],
   );

1;

#---------------------------------- 一般

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

	$this->{value} = undef;

	if(@_) {
		$this->set(@_);
	}

	$this;
}

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

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

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

sub get {
	my $this = shift;

	$this->{value};
}

#---------------------------------- setç³»

sub setDate {
	my $this = shift;
	my $year = shift;
	my $mon = shift;
	my $day = shift;

	if($this->_isExistentDay($year, $mon, $day)) {
		$this->{value} = sprintf '%04d-%02d-%02d', $year, $mon, $day;
	} else {
		$this->{value} = undef;
	}

	$this;
}

sub setDateTime {
	my $this = shift;
	my $year = shift;
	my $mon = shift;
	my $day = shift;
	my $hour = shift;
	my $min = shift || 0;
	my $sec = shift || 0;

	if($this->_isExistentDay($year, $mon, $day)
	&& $this->_isExistentTime($hour, $min, $sec)) {
		$this->{value} = sprintf(
			'%04d-%02d-%02d %02d:%02d:%02d',
			$year, $mon, $day,
			$hour, $min, $sec,
		);
	} else {
		$this->{value} = undef;
	}

	$this;
}

sub setTime {
	my $this = shift;
	my $hour = shift;
	my $min = shift || 0;
	my $sec = shift || 0;

	if($this->_isExistentTime($hour, $min, $sec)) {
		$this->{value} = sprintf '%02d:%02d:%02d', $hour, $min, $sec;
	} else {
		$this->{value} = undef;
	}

	$this;
}

#---------------------------------- getç³»

sub getLen {
	my $this = shift;

	length $this->{value};
}

sub getSjisLen {
	my $this = shift;

	length Unicode::Japanese->new($this->{value})->sjis;
}

sub getCharLen {
	my $this = shift;

	my @chars = grep {defined && length} split /($re_char)/, $this->{value};
	scalar @chars;
}

sub getAge {
	my $this = shift;
	my $date = shift;

	my @from = $this->_parseDate($this->{value});
	my @to = do {
		if(defined($date)) {
			$this->_parseDate($date);
		} else {
			my @lt = localtime;
			$lt[5] += 1900;
			$lt[4]++;
			@lt[5, 4, 3];
		}
	};

	if(!@to || !$this->_isExistentDay(@to)) {
		return undef;
	}

	my $age = $to[0] - $from[0];
	if($to[1] < $from[1] || ($to[1] == $from[1] && $to[2] < $from[2])) {
		$age--;
	}
	$age;
}

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

	my $regexp;

	$type = lc($type);
	if($type eq 'hira') {
		$regexp = $re_hira;
	} elsif($type eq 'kata') {
		$regexp = $re_kata;
	} elsif($type eq 'numbernarrow') {
		$regexp = qr{\d};
	} elsif($type eq 'numberwide') {
		$regexp = $re_widenum;
	} else {
		die __PACKAGE__."#getRegexp: arg[1] is an invalid type. [$type] (指定された正規表現は存在しません)\n";
	}
	
	$regexp;
}

#---------------------------------- isç³»
sub isEmpty {
	my $this = shift;

	not length $this->{value};
}

sub isWhitespace {
	# 半角/全角スペース、タブのみで構成されているなら1。
	# 空文字列やundefならundef。
	my $this = shift;

	if(length($this->{value})) {
		$this->{value} =~ /\A(?:\s|　)+\z/ ? 1 : undef;
	} else {
		undef;
	}
}

sub isBlank {
	my $this = shift;

	if($this->isEmpty || $this->isWhitespace) {
		1;
	} else {
		undef;
	}
}

sub isPrintableAscii {
	my $this = shift;

	if(length($this->{value})) {
		$this->{value} =~ /\A[\x20-\x7e]*\z/ ? 1 : undef;
	} else {
		undef;
	}

}

sub isWide {
	my $this = shift;

	if(length($this->{value})) {
	
		my $sjisvalue = $TL->charconv($this->{value}, 'UTF-8' => 'Shift_JIS');
		
		my $re_char = '[\x81-\x9f\xe0-\xef\xfa-\xfc][\x40-\x7e\x80-\xfc]|[\xa1-\xdf]|[\x00-\x7f]';
		
		my @chars = grep {defined && length} split /($re_char)/, $sjisvalue;
		
		!grep { length($_) == 1 } @chars;
	} else {
		undef;
	}
}

sub isPassword {
	my $this = shift;
	
	if(!defined($this->{value})) {
		return undef;
	}

	if(!$this->isPrintableAscii() )
	{
		return undef;
	}

	my $deftypes = ['alpha', 'ALPHA', 'digit', 'symbol'];
	my $matcher = {
		alpha  => qr/[a-z]/,
		ALPHA  => qr/[A-Z]/,
		digit  => qr/[0-9]/,
		symbol => qr/[\x21-\x2f\x3a-\x40\x5b-\x60\x7b-\x7e]/,
		# ! " # $ % & ' ( ) * + ' - . /
		# : ; < = > ? @   [ \ ] ^ _ `  { | } ~
	};
	my $tokens = @_ ? [@_] : $deftypes;
	my $tmp = $this->{value};
	foreach my $token (@$tokens)
	{
		my $re = $matcher->{$token};
		if( !$re && ref($token) eq 'ARRAY' )
		{
			$re = join('|', @$token);
		}
		$re or die __PACKAGE__."#isPassword: invalid argument. [$token] (無効な値です)\n";
		if( $tmp !~ s/$re//g )
		{
			return undef;
		}
	}
	1; # accepted.
}

sub isZipCode {
	my $this = shift;

	if(!defined($this->{value})) {
		return undef;
	}

	$this->{value} =~ /\A\d{3}-\d{4}\z/ ? 1 : undef;
}

sub isTelNumber {
	my $this = shift;

	if(!defined($this->{value})) {
		return undef;
	}

	$this->{value} =~ /\A\d[\d-]+\d\z/ ? 1 : undef;
}

sub isEmail {
	my $this = shift;

	if(!defined($this->{value})) {
		return undef;
	}

	$this->{value} =~ /$pcmailexp/ ? 1 : undef;
}

sub isMobileEmail {
	my $this = shift;

	if(!defined($this->{value})) {
		return undef;
	}

	$this->{value} =~ /$mobilemailexp/ ? 1 : undef;
}

sub isInteger {
	my $this = shift;
	my $min = shift;
	my $max = shift;

	if(!defined($this->{value})) {
		return undef;
	}

	if($this->{value} =~ m/\A-?\d+\z/) {
		if(defined($min)) {
			$this->{value} >= $min or return undef;
		}
		if(defined($max)) {
			$this->{value} <= $max or return undef;
		}

		1;
	} else {
		undef;
	}
}

sub isReal {
	my $this = shift;
	my $min = shift;
	my $max = shift;

	if(!defined($this->{value})) {
		return undef;
	}

	if($this->{value} =~ m/\A-?\d+(?:\.\d+)?\z/) {
		if(defined($min)) {
			$this->{value} >= $min or return undef;
		}
		if(defined($max)) {
			$this->{value} <= $max or return undef;
		}

		1;
	} else {
		undef;
	}
}

sub isHira {
	my $this = shift;

	if(!defined($this->{value})) {
		return undef;
	}

	$this->{value} =~ m/\A$re_hira+\z/ ? 1 : undef;
}

sub isKata {
	my $this = shift;

	if(!defined($this->{value})) {
		return undef;
	}

	$this->{value} =~ m/\A$re_kata+\z/ ? 1 : undef;
}

sub isExistentDay {
	# YYYY-MM-DD この日が存在するなら1
	my $this = shift;

	if(!defined($this->{value})) {
		return undef;
	}

	my @date = $this->_parseDate($this->{value});
	@date ? $this->_isExistentDay(@date) : undef;
}

sub isGif {
	my $this = shift;

	if(!defined($this->{value})) {
		return undef;
	}

	$this->{value} =~ /\AGIF8[79]a/ ? 1 : undef;
}

sub isJpeg {
	my $this = shift;

	if(!defined($this->{value})) {
		return undef;
	}

	$this->{value} =~ /\A\xFF\xD8/ ? 1 : undef;
}

sub isPng {
	my $this = shift;

	if(!defined($this->{value})) {
		return undef;
	}

	$this->{value} =~ /\A\x89PNG\x0D\x0A\x1A\x0A/ ? 1 : undef;
}

sub isHttpUrl {
	my $this = shift;

	if(!defined($this->{value})) {
		return undef;
	}

	$this->{value} =~ m!\Ahttp://! ? 1 : undef;
}

sub isHttpsUrl {
	my $this = shift;

	if(!defined($this->{value})) {
		return undef;
	}

	$this->{value} =~ m!\Ahttps://! ? 1 : undef;
}

sub isLen {
	my $this = shift;
	my $min = shift;
	my $max = shift;

	if(!defined($this->{value})) {
		return undef;
	}

	my $len = $this->getLen;

	if(defined($min)) {
		$len >= $min or return undef;
	}
	if(defined($max)) {
		$len <= $max or return undef;
	}

	1;
}

sub isSjisLen {
	my $this = shift;
	my $min = shift;
	my $max = shift;

	if(!defined($this->{value})) {
		return undef;
	}

	my $len = $this->getSjisLen;

	if(defined($min)) {
		$len >= $min or return undef;
	}
	if(defined($max)) {
		$len <= $max or return undef;
	}

	1;
}

sub isCharLen {
	my $this = shift;
	my $min = shift;
	my $max = shift;

	if(!defined($this->{value})) {
		return undef;
	}

	my $len = $this->getCharLen;

	if(defined($min)) {
		$len >= $min or return undef;
	}
	if(defined($max)) {
		$len <= $max or return undef;
	}

	1;
}

sub isPortable {
	# 機種依存文字を含んでいないなら1
	my $this = shift;
	my $str  = $this->{value};

	if(!defined($this->{value})) {
		return undef;
	}

	my $unijp = Unicode::Japanese->new;
	
	my @chars = grep {defined && length} split /($re_char)/, $this->{value};
	
	# 機種依存文字
	my $dep_regex 
		= '\xED[\x40-\xFF]|\xEE[\x00-\xFC]'              # NEC選定IBM拡張文字(89-92区)
		. '|[\xFA\xFB][\x40-\xFF]|\xFC[\x40-\x4B]'     # IBM拡張文字(115-119区)
		. '|[\x85-\x87][\x40-\xFF]|\x88[\x40-\x9E]'    # 特殊文字エリア
		. '|[\xF0-\xF8][\x40-\xFF]|\xF9[\x40-\xFC]'    # JIS外字エリア
		. '|\xEA[\xA5-\xFF]|[\xEB-\xFB][\x40-\xFF]|\xFC[\x40-\xFC]' # MAC外字及び縦組用
		. '|\x81[\xBE\xBF\xDA\xDB\xDF\xE0\xE3\xE6\xE7]'; # JIS領域外の13区の記号
	
	# SJIS
	foreach my $str (@chars) {
		my $str_sjis = $unijp->set($str, 'utf8')->sjis;
		return undef if($str_sjis =~ m/\A(?:$dep_regex)\z/o);
	}
	
	# Unicodeのプライベート領域判定（U+E000～U+F8FF、U+F0000～U+10FFFF）
	foreach my $str (@chars) {
		my $str_ucs4 = $unijp->set($str, 'utf8')->ucs4;
		return undef if($str_ucs4 =~ m/\A\x00\x00[\xe0-\xf8][\x00-\xff]\z/o);
		return undef if($str_ucs4 =~ m/\A\x00[\x0f-\x10][\x00-\xff][\x00-\xff]\z/o);
	}
	
	return 1;
}

sub isPcPortable {
	# 携帯絵文字を含んでいないなら1
	my $this = shift;
	my $str  = $this->{value};

	if(!defined($this->{value})) {
		return undef;
	}

	my $unijp = Unicode::Japanese->new;
	
	my @chars = grep {defined && length} split /($re_char)/, $this->{value};
	
	# Unicodeのプライベート領域判定（U+FE000～U+FFFFF）
	foreach my $str (@chars) {
		my $str_ucs4 = $unijp->set($str, 'utf8')->ucs4;
		return undef if($str_ucs4 =~ m/\A\x00\x0f[\xe0-\xff][\x00-\xff]\z/o);
	}
	
	
	return 1;
}

sub isDomainName {
    my $this = shift;

    if (defined $this->{value}) {
        return
          length($this->{value}) <= 255 &&
          $this->{value} =~ m/$re_domain/o;
    }
    else {
        return;
    }
}

sub isIpAddress {
	my $this = shift;
	my $checkmask = shift;
	my $checkip  = $this->{value};

	if(!defined($this->{value})) {
		return undef;
	}
	
	if(!defined($checkmask)) {
		return undef;
	} elsif(ref($checkmask)) {
		return undef;
	}

	my @masks = split /\s+/, $checkmask;
	
	my @ip = $this->_parse_addr($checkip);

	if(@ip != 4 && @ip != 16) {
		# パース失敗
		return undef;
	} else {
		foreach my $mask (@masks) {
			my $bits;
			if($mask =~ s!/(\d+)$!!) {
				$bits = $1;
			}

			my @mask = $this->_parse_addr($mask);
			if(@mask != 4 and @mask != 16) {
				# パース失敗
				return undef;
			}

			if(@mask != @ip) {
				# IPバージョン違い
				next;
			}

			# ビット数が指定されたなかった場合は /32 または /128 と見做す。
			defined $bits or
			  $bits = (@mask == 4 ? 32 : 128);

			if($this->_ip_match(\@ip, \@mask, $bits)) {
				# マッチした
				return 1;
			}
		}

		# どれにもマッチしなかった。
		return undef;
	}
}

sub isDateString {
    my $this   = shift;
    my $format = shift;

    if (!defined $this->{value}) {
        return;
    }

    eval {
        local $SIG{__DIE__} = 'DEFAULT';
        $TL->newDateTime->parseFormat($format, $this->{value});
    };
    if (my $err = $@) {
        # 良くないが、他に方法が無い。
        if ($err =~ m/does not match to/) {
            return;
        }
        else {
            die $@;
        }
    }
    else {
        return 1;
    }
}

sub isChar
{
  my $this = shift;

  if( !@_ )
  {
    die __PACKAGE__."#isChar, no arguments specified. (引数が指定されていません)\n";
  }

  my @chars;
  foreach my $i (1..@_)
  {
    my $val = $_[$i-1];
    if( !defined($val) )
    {
      die __PACKAGE__."#isChar, arg[$i] is not defined. (第$i引数が指定されていません)\n";
    }
    if( ref($val) )
    {
      if( ref($val) ne 'ARRAY' )
      {
        die __PACKAGE__."#isChar, arg[$i] is not array-ref. (第$i引数は配列リファレンスではありません)\n";
      }
      push(@chars, $val);
    }else
    {
      our $MAPS ||= {
        digit      => [0..9],
        loweralpha => ['a'..'z'],
        upperalpha => ['A'..'Z'],
        alpha      => ['a'..'z', 'A'..'Z'],
        '-'        => ['-'],
        '_'        => ['_'],
      };
      foreach my $name (map{lc($_)} split(/[\s,]+/, $val))
      {
        my $list = $MAPS->{$name};
        if( !$list )
        {
          die __PACKAGE__."#isChar, invalid name [$name]. (無効な値です [$name])\n";
        }
        push(@chars, $list);
      }
    }
  }

  if( !defined($this->{value}) )
  {
    # undefined is not acceptable.
    return;
  }

  if( $this->{value} eq '' )
  {
    # empty is not acceptable.
    return;
  }

  foreach my $ch (split(//, $this->{value}))
  {
    my $accepted;
    foreach my $list (@chars)
    {
      if( grep { $_ eq $ch } @$list )
      {
        $accepted = 1;
        last;
      }
    }
    if( !$accepted )
    {
      # rejected.
      return undef;
    }
  }

  # all accepted.
  return 1;
}

#---------------------------------- convç³»
sub convHira {
	my $this = shift;

	if(!defined($this->{value})) {
		return $this;
	}
	
	my $unijp = Unicode::Japanese->new($this->{value});
	$this->{value} = $unijp->kata2hira->get;

	$this;
}

sub convKata {
	my $this = shift;

	if(!defined($this->{value})) {
		return $this;
	}

	my $unijp = Unicode::Japanese->new($this->{value});
	$this->{value} = $unijp->hira2kata->get;

	$this;
}

sub convNumber {
	my $this = shift;

	if(!defined($this->{value})) {
		return $this;
	}

	my $unijp = Unicode::Japanese->new($this->{value});
	$this->{value} = $unijp->z2hNum->get;

	$this;
}

sub convNarrow {
	my $this = shift;

	if(!defined($this->{value})) {
		return $this;
	}

	my $unijp = Unicode::Japanese->new($this->{value});
	$this->{value} = $unijp->z2h->get;

	$this;
}

sub convWide {
	my $this = shift;

	if(!defined($this->{value})) {
		return $this;
	}

	my $unijp = Unicode::Japanese->new($this->{value});
	$this->{value} = $unijp->h2z->get;

	$this;
}

sub convKanaNarrow {
	my $this = shift;

	if(!defined($this->{value})) {
		return $this;
	}

	my $unijp = Unicode::Japanese->new($this->{value});
	$this->{value} = $unijp->z2hKana->get;

	$this;
}

sub convKanaWide {
	my $this = shift;

	if(!defined($this->{value})) {
		return $this;
	}

	my $unijp = Unicode::Japanese->new($this->{value});
	$this->{value} = $unijp->h2zKana->get;

	$this;
}

sub convComma {
	my $this = shift;

	if(!defined($this->{value})) {
		return $this;
	}

	$this->{value} =~ s/\G((?:^[-+])?\d{1,3})(?=(?:\d\d\d)+(?!\d))/$1,/g;

	$this;
}

sub convLF {
	my $this = shift;

	if(!defined($this->{value})) {
		return $this;
	}

	$this->{value} =~ s/\r\n/\n/g;
	$this->{value} =~ s/\r/\n/g;

	$this;
}

sub convBR {
	my $this = shift;

	if(!defined($this->{value})) {
		return $this;
	}

	$this->{value} =~ s/\r\n/\n/g;
	$this->{value} =~ s/\r/\n/g;
	$this->{value} =~ s/\n/<BR>\n/g;

	$this;
}

#---------------------------------- forceç³»
sub forceHira {
	my $this = shift;

	if(!defined($this->{value})) {
		return $this;
	}
	
	$this->{value} = join('', $this->{value}=~/($re_hira+)/go);
	$this;
}

sub forceKata {
	# forceHiraの逆
	my $this = shift;

	if(!defined($this->{value})) {
		return $this;
	}
	
	$this->{value} = join('', $this->{value}=~/($re_kata+)/go);
	$this;
}

sub forceNumber {
	my $this = shift;

	if(!defined($this->{value})) {
		return $this;
	}
	
	$this->{value} = join('', $this->{value}=~/(\d+)/go);
	$this;
}

sub forceMin {
	my $this = shift;
	my $min = shift;
	my $val = shift;

	if(!defined($this->{value})) {
		return $this;
	}

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

	$this->forceNumber;
	if($this->{value} < $min) {
		$this->{value} = $val;
	}

	$this;
}

sub forceMax {
	my $this = shift;
	my $max = shift;
	my $val = shift;

	if(!defined($this->{value})) {
		return $this;
	}

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

	$this->forceNumber;
	if($this->{value} > $max) {
		$this->{value} = $val;
	}

	$this;
}

sub forceMaxLen {
	my $this = shift;
	my $maxlen = shift;

	if(!defined($this->{value})) {
		return $this;
	}

	if(length($this->{value}) > $maxlen) {
		substr($this->{value}, $maxlen) = '';
	}

	$this;
}

sub forceMaxUtf8Len {
	my $this = shift;
	my $maxlen = shift;

	if(!defined($this->{value})) {
		return $this;
	}

	if(length($this->{value}) > $maxlen) {
		# $maxlenバイトに入りきるまで一文字ずつ入れていく

		my @chars = split /($re_char)/, $this->{value};
		$this->{value} = '';
		my $current_len = 0;

		foreach my $c (@chars) {
			if($current_len + length($c) <= $maxlen) {
				$this->{value} .= $c;
				$current_len += length($c);
			} else {
				# これ以上入らない
				last;
			}
		}
	}

	$this;
}

sub forceMaxSjisLen {
	my $this = shift;
	my $maxlen = shift;

	if(!defined($this->{value})) {
		return $this;
	}

	my $unijp = Unicode::Japanese->new;

	if(length($unijp->set($this->{value})->sjis) > $maxlen) {
		# $maxlenバイトに入りきるまで一文字ずつ入れていく

		my @chars = split /($re_char)/, $this->{value};
		$this->{value} = '';
		my $current_len = 0;

		foreach my $c (@chars) {
			my $sjis_c = $unijp->set($c)->sjis;

			if($current_len + length($sjis_c) <= $maxlen) {
				$this->{value} .= $c;
				$current_len += length($sjis_c);
			} else {
				# これ以上入らない
				last;
			}
		}
	}

	$this;
}

sub forceMaxCharLen {
	my $this = shift;
	my $maxlen = shift;

	if(!defined($this->{value})) {
		return $this;
	}

	my @chars = grep {defined && length} split /($re_char)/, $this->{value};
	if(@chars > $maxlen) {
		splice @chars, $maxlen;
		$this->{value} = join '', @chars;
	}

	$this;
}

sub forcePortable {
	my $this = shift;

	if(!defined($this->{value})) {
		return $this;
	}
	
	my $v = $TL->newValue;
	my $newval = '';
	my @chars = grep {defined && length} split /($re_char)/, $this->{value};
	foreach my $ch (@chars) {
		if($v->set($ch)->isPortable) {
			$newval .= $ch;
		}
	}
	
	$this->{value} = $newval;
	$this;
}

sub forcePcPortable {
	my $this = shift;

	if(!defined($this->{value})) {
		return $this;
	}
	
	my $v = $TL->newValue;
	my $newval = '';
	my @chars = grep {defined && length} split /($re_char)/, $this->{value};
	foreach my $ch (@chars) {
		if($v->set($ch)->isPcPortable) {
			$newval .= $ch;
		}
	}
	
	$this->{value} = $newval;
	$this;
}


#---------------------------------- その他

sub trimWhitespace {
	# 文字列前後の半角/全角スペース、タブを削除
	my $this = shift;

	if(!defined($this->{value})) {
		return $this;
	}

	$this->{value} =~ s/\A(?:\s|　)+//;
	$this->{value} =~ s/(?:\s|　)+\z//;

	$this;
}

sub countWords {
	my $this = shift;

	my @words = split /(?:\s|　)+/, $this->{value};
	scalar @words;
}

sub strCut {
	my $this = shift;
	my $charanum = shift;

	if(!defined($this->{value})) {
		return $this;
	}

	my $v = $TL->newValue;
	
	my $value = $this->{value};
	my @output;

	while(length($value)) {
		$v->{value} = $value;
		my $temp = $v->forceMaxCharLen($charanum)->get;
		$value = substr($value,length($temp));
		push(@output,$temp);
	}

	@output;
}

sub strCutSjis {
	my $this = shift;
	my $charanum = shift;

	if(!defined($this->{value})) {
		return $this;
	}

	my $v = $TL->newValue;
	
	my $value = $this->{value};
	my @output;

	while(length($value)) {
		$v->{value} = $value;
		my $temp = $v->forceMaxSjisLen($charanum)->get;
		$value = substr($value,length($temp));
		push(@output,$temp);
	}

	@output;
}

sub strCutUtf8 {
	my $this = shift;
	my $charanum = shift;

	if(!defined($this->{value})) {
		return $this;
	}

	my $v = $TL->newValue;
	
	my $value = $this->{value};
	my @output;

	while(length($value)) {
		$v->{value} = $value;
		my $temp = $v->forceMaxUtf8Len($charanum)->get;
		$value = substr($value,length($temp));
		push(@output,$temp);
	}

	@output;
}

sub genRandomString {
	my $this = shift;
	my $length = shift;
	my $type = shift;

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

	if(!defined($type)) {
		$type = ['std'];
	} elsif(ref($type) ne 'ARRAY') {
		die __PACKAGE__."#genRandomString: arg[2] is not an ARRAY Ref. (第2引数が配列のリファレンスではありません)\n";
	}

	my @str;
	foreach my $key (@$type) {
		if($key eq 'alpha') {
			push(@str,'a'..'z');
		} elsif($key eq 'ALPHA') {
			push(@str,'A'..'Z');
		} elsif($key eq 'num' || $key eq 'NUM') {
			push(@str,'0'..'9');
		} elsif($key eq 'std') {
			push(@str,
			     qw(    2 3 4 5 6 7 8  ),
			     qw(a   c d e f g h         m n   p   r   t u v w x y z),
			     qw(A B C D E F G H   J K L M N   P   R S T U V W X Y Z),
			    );
		} elsif($TL->newValue($key)->isCharLen(1,1)) {
			push(@str,$key);
		} else {
			die __PACKAGE__."#genRandomString: arg[2] [$key] is an invalid type. (第2引数の $key はサポートされていません)\n";
		}
	}
	
	if(!@str) {
		die __PACKAGE__."#genRandomString: arg[2] is not defined. (第2引数が指定されていません)\n";
	}
	
	my $password = '';
	for(1..$length) {
		$password .= $str[int(rand($#str+1))];
	}
	
	$password;
}

sub detectMobileAgent {
    my $this = shift;

    if (defined $this->{value}) {
        foreach my $candidate (@MOBILE_AGENTS) {
            if ($this->{value} =~ m/$candidate->[0]/) {
                return $candidate->[1];
            }
        }
    }

    return;
}

#---------------------------------- 内部メソッド

sub _isLeapYear {
	my $this = shift;
	my $y = shift;

	($y % 4 == 0 &&
		$y % 100 != 0) ||
			$y % 400 == 0;
}

sub _isExistentDay {
	my $this = shift;
	my $year = shift;
	my $mon = shift;
	my $day = shift;

	if($mon < 1 || $mon > 12) {
		return 0;
	}

	my $maxday = do {
		if($this->_isLeapYear($year) && $mon == 2) {
			29;
		} else {
			[31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]->[$mon - 1];
		}
	};

	$day <= $maxday;
}

sub _isExistentTime {
	# うるう秒のチェックはしない。不規則に挿入されるので予期出来ない。
	my $this = shift;
	my $hour = shift;
	my $min = shift;
	my $sec = shift;

	$hour >= 0 && $hour <= 23 &&
		$min >= 0 && $min <= 59 &&
			$sec >= 0 && $sec <= 59;
}

sub _parseDate {
	my $this = shift;
	my $str = shift;

	if($str =~ m!^(\d{4})-(\d{2})-(\d{2})$!) {
		return ($1, $2, $3);
	} else {
		return ();
	}
}

sub _parse_addr {
	my $this = shift;
	my $addr = shift;

	if($addr =~ m/$re_ipv4_addr/) {
		# IPv4
		$1 =~ m/\A(\d+)\.(\d+)\.(\d+)\.(\d+)\z/;
		($1, $2, $3, $4);
	} elsif($addr =~ m/$re_ipv6_addr/) {
		# IPv6
		my $word2bytes = sub {
			my $word = hex shift;
			(($word >> 8) & 0xff, $word & 0xff);
		};
		
		if($addr =~ /::/) {
			# 短縮形式を展開
			my ($left, $right) = split /::/, $addr;
			
			my @left = split /:/, $left;
			my @right = split /:/, $right;
			
			foreach(scalar @left .. 7 - scalar @right) {
				push @left, 0
			};
			
			map { $word2bytes->($_) } (@left, @right);
		} else {
			map { $word2bytes->($_) } split /:/, $addr;
		}
	} else {
		();
	}
}


sub _ip_match {
	my $this = shift;
	my $a = shift;
	my $b = shift;
	my $bits = shift;
	my $i = 0;

	# $bits == 0 ならば何の比較もせずに「一致」として判定。
	# $bits == 最大値 ならば完全一致するかどうかで判定。
	while($bits > 0) {
		if($bits >= 8) {
			$a->[$i] != $b->[$i]
			  and return 0;

			$bits -= 8;
		} else {
			# 上位 $bits ビットのみ比較
			(($a->[$i] >> (8 - $bits)) & (2 ** $bits - 1)) !=
			  (($b->[$i] >> (8 - $bits)) & (2 ** $bits - 1))
				and return 0;

			$bits = 0;
		}
		$i++;
	}
	
	1;
}

__END__