#webliberty::String.pm (2006/08/16) #Copyright(C) 2002-2006 Knight, All rights reserved. package webliberty::String; use strict; ### コンストラクタ sub new { my $class = shift; my $self = { string => shift }; bless $self, $class; return $self; } ### ä¸€è¡Œãƒ‡ãƒ¼ã‚¿ä½œæˆ sub create_line { my $self = shift; $self->{string} =~ s/\t//g; $self->{string} =~ s/^\s+//; $self->{string} =~ s/\s+$//; $self->{string} =~ s/\r?\n//g; $self->{string} =~ s/<br \/>//g; return $self->{string}; } ### è¤‡æ•°è¡Œãƒ‡ãƒ¼ã‚¿ä½œæˆ sub create_text { my $self = shift; $self->{string} =~ s/\t//g; $self->{string} =~ s/\r?\n/\r/g; $self->{string} =~ s/^\r+//; $self->{string} =~ s/\r+$//; $self->{string} =~ s/\r/<br \/>/g; return $self->{string}; } ### æ•°å€¤ãƒ‡ãƒ¼ã‚¿ä½œæˆ sub create_number { my $self = shift; $self->{string} = int($self->{string}); return $self->{string}; } ### ãƒ—ãƒ¬ãƒ¼ãƒ³ãƒ‡ãƒ¼ã‚¿ä½œæˆ sub create_plain { my $self = shift; $self->{string} =~ s/\r?\n/\n/g; $self->{string} =~ s/<br \/>/\n/g; return $self->{string}; } ### ãƒªãƒ³ã‚¯ä½œæˆ sub create_link { my $self = shift; my $attribute = shift; if ($attribute) { $attribute = " $attribute"; $attribute =~ s/"/"/g; } $self->{string} = "\n$self->{string}\n"; $self->{string} =~ s/([^\"(")(>)])(https?:\/\/[\w\.\~\-\/\?\&\#\+\=\:\;\@\%]+)([^\"(")(<)])/$1<a href="$2"$attribute>$2<\/a>$3/gi; $self->{string} =~ s/([^\"(")(>)])(ftp:\/\/[\w\.\~\-\/\?\&\#\+\=\:\;\@\%]+)([^\"(")(<)])/$1<a href="$2"$attribute>$2<\/a>$3/gi; $self->{string} =~ s/([^\"(")(>)])([\w\-]+\@[\w\-\.]+)([^\"(")(<)])/$1<a href="mailto:$2">$2<\/a>$3/gi; $self->{string} =~ s/^\n//; $self->{string} =~ s/\n$//; return $self->{string}; } ### ãƒ‘ã‚¹ãƒ¯ãƒ¼ãƒ‰ä½œæˆ sub create_password { my $self = shift; my $salt = pack('CC', int(rand(26) + 65), int(rand(10) + 48)); $self->{string} = crypt($self->{string}, $salt); return $self->{string}; } ### HTML有効化 sub permit_html { my $self = shift; $self->{string} =~ s/"/"/g; $self->{string} =~ s/</</g; $self->{string} =~ s/>/>/g; $self->{string} =~ s/&/&/g; return $self->{string}; } ### æ–‡å—æ•°å–å¾— sub check_length { my $self = shift; return length($self->{string}); } ### 行数å–å¾— sub check_line { my $self = shift; return ($self->{string} =~ s/<br \/>/<br \/>/g) + 1; } ### 指定文å—列数å–å¾— sub check_count { my $self = shift; my $string = shift; return ($self->{string} =~ s/$string/$string/g); } ### ãƒ‘ã‚¹ãƒ¯ãƒ¼ãƒ‰ç…§åˆ sub check_password { my $self = shift; my $password = shift; my $flag; if ($self->{string} and $password and crypt($self->{string}, $password) eq $password) { $flag = 1; } return $flag; } ### データè¨å®š sub set_string { my $self = shift; my $string = shift; $self->{string} = $string; return; } ### ãƒ‡ãƒ¼ã‚¿ç½®æ› sub replace_string { my $self = shift; my $before = shift; my $after = shift; $self->{string} =~ s/$before/$after/g; return $self->{string}; } ### データçœç•¥ sub trim_string { my $self = shift; my $width = shift; my $marker = shift; if (length($self->{string}) > $width) { $self->{string} = substr($self->{string}, 0, $width); if ($self->{string} !~ /[\x00-\x7F]$/) { $self->{string} =~ s/[\xC0-\xFD]$//; $self->{string} =~ s/[\xE0-\xFD][\x80-\xBF]$//; $self->{string} =~ s/[\xF0-\xFD][\x80-\xBF]{2}$//; } $self->{string} .= $marker; } return $self->{string}; } ### データå–å¾— sub get_string { my $self = shift; return $self->{string}; } 1;