【common2.plの編集】

設定改名履歴 ※このキーワードは元キーワードの作成者のみ作成・編集が可能です。

■キーワード内容

sub get_browser {
	my (%browser);
	my (@ip) = split(/\./ ,$ENV{"REMOTE_ADDR"});
	my ($ip) = pack('C4', @ip);
	my ($hostname) = gethostbyaddr($ip, 2);
	my ($user_agent) = $ENV{"HTTP_USER_AGENT"};

# i-mode
	if ($hostname =~ m|\.docomo\.ne\.jp$| && $user_agent =~ m|DoCoMo|) {
		$browser{'kind'} = 'i-mode';
		if ($user_agent =~ m|DoCoMo/1|) {
			$browser{'type'} = 'mova';
			$browser{'size'} = 10 * 1024;
		} elsif ($user_agent =~ m|DoCoMo/2|) {
			$browser{'type'} = 'foma';
			$browser{'size'} = 20 * 1024;
		}

# ezweb
	} elsif ($hostname =~ m|\.ezweb\.ne\.jp$| && $user_agent =~ m|UP\.Browser|) {
		$browser{'kind'} = 'ezweb';
		$browser{'type'} = 'ezweb';
		$browser{'size'} = 9 * 1024;

# j-phone
	} elsif ($hostname =~ m|\.jp-[a-z]{1}\.ne\.jp$|) {
		$browser{'kind'} = 'vodafone';
		if ($user_agent =~ m|J-PHONE/2|) {
			$browser{'type'} = 'not_station';
			$browser{'size'} = 5000;
		} elsif ($user_agent =~ m|J-PHONE/3|) {
			$browser{'type'} = 'station';
			$browser{'size'} = 6 * 1024;
		} elsif ($user_agent =~ m|J-PHONE/4\.[012]|) {
			$browser{'type'} = 'packet_12k';
			$browser{'size'} = 12 * 1024;
		} elsif ($user_agent =~ m|J-PHONE/4\.3|) {
			$browser{'type'} = 'packet_30k';
			$browser{'size'} = 30 * 1024;
		} elsif ($user_agent =~ m|J-PHONE/5|) {
			$browser{'type'} = 'vgs';
			$browser{'size'} = 200 * 1024;
		} elsif ($user_agent =~ m|Vodafone/1| || $user_agent =~ m|MOT-V980/|) {
			$browser{'type'} = 'vodafone3g';
			$browser{'size'} = 300 * 1024;
		}

# pc
	} else {
		$browser{'kind'} = 'pc';
		$browser{'type'} = 'pc';
		$browser{'size'} = 1000 * 1024;
	}
	$browser{'useragent'} = $user_agent;
	return %browser;
}

sub encode {
	my $str = shift;
	$str =~ s/(.)/unpack('H2', $1)/eg;
	return $str;
}

sub decode {
	my $str = shift;
	$str =~ s/([0-9A-Fa-f][0-9A-Fa-f])/pack('H2', $1)/eg;
	return $str;
}

sub escape_tag {
	my $str = shift;
	$str =~ s|\r\n|\n|g;
	$str =~ s|\&|&amp;|g;
	$str =~ s|\<|&lt;|g;
	$str =~ s|\>|&gt;|g;
	$str =~ s|\"|&quot;|g;
	return $str;

}

sub encode_url {
	my $str = shift;
	&convert_jcode(\$str,'sjis','euc');
	$str =~ s|([^\w ])|'%'.unpack('H2', $1)|eg;
	return $str;
}

sub counter {
	my ($filepath, $value) = @_;
	my ($total);
	if (open(FILE, "+< $filepath")) {
		flock(FILE, 2);
		$total = <FILE>;
	} else {
		open(FILE, "> $filepath") || &error("Can't Create $filepath(&counter)");
		flock(FILE, 2);
	}
	$total += $value;
	truncate(FILE, 0);
	seek(FILE, 0, 0);
	print FILE $total;
	close(FILE);
	return $total;
}

sub counter2 {
	my ($filepath, $value) = @_;
	my (%count, $name, $count);
	if (open(FILE, "+< $filepath")) {
		flock(FILE, 2);
		my @record = <FILE>;
		foreach my $record (@record) {
			chomp($record);
			($name,$count) = split(/ = /, $record);
			if ($name ne '') {
				$count{$name} = $count;
			}
		}
		undef $count;
	} else {
		open(FILE, "> $filepath") || &error("Can't Create $filepath(&counter2)");
		flock(FILE, 2);
	}
	if (substr(&get_time('LocalTime'),0,6) ne substr(&get_time('LastUpdateTime', 'FilePath' => $filepath),0,6)) {
		$count{'LastMonth'} = $count{'ThisMonth'};
		$count{'ThisMonth'} = 0;
	}
	if (substr(&get_time('LocalTime'),0,8) ne substr(&get_time('LastUpdateTime', 'FilePath' => $filepath),0,8)) {
		$count{'Yesterday'} = $count{'Today'};
		$count{'Today'} = 0;
	}
	$count{'Total'} += $value;
	$count{'Today'} += $value;
	$count{'ThisMonth'} += $value;
	foreach $name (keys %count) {
		$count .= "$name = $count{$name}\n";
	}
	truncate(FILE, 0);
	seek(FILE, 0, 0);
	print FILE $count;
	close(FILE);
	return %count;
}

sub read_file {
	my ($filepath, %option) = @_;
	my (@record);
	if (open(IN, $filepath)) {
		if ($option{'ReadLine'}) {
			while (<IN>) {
				push(@record, $_);
				last if $option{'ReadLine'} <= int(@record);
			}
		} else {
			@record = <IN>;
		}
		close(IN);
	} else {
		return undef if $option{'NoError'};
		&error("Can't Open $filepath(&read_file)");
	}
	for (my $i = 0; $i <= $#record; $i++) {
		$record[$i] =~ s/\r?\n$//;
	}
	return wantarray ? @record : join("\n", @record);
}

sub write_file {
	my ($filepath, @record) = @_;
	for (my $i = 0; $i <= $#record; $i++) {
		$record[$i] =~ s/\r?\n$//;
	}
	open(OUT,"> $filepath") || &error("Can't Write $filepath(&write_file)");
	print OUT join("\n", @record);
	close(OUT);
}

sub append_file {
	my ($filepath, $record) = @_;
	open(OUT,">> $filepath") || &error("Can't Append $filepath(&append_file)");
	print OUT $record;
	close(OUT);
}

sub cycle_file {
	my ($filepath,$record,$maxline) = @_;
	my (@record, $i);
	@record = &read_file($filepath, 'NoError' => 1);
	for($i = $#record; $i < $maxline - 1; $i++){
		unshift(@record, "\n");
	}
	shift(@record);
	push(@record,$record);
	&write_file($filepath,@record);
}

sub join_record {
	my (@item) = @_;
	my ($record);
	foreach my $item (@item){
		$item =~ s/\t/<<-TAB->>/g;
		$item =~ s/\r?\n/<br>/g;
		$record .= $item."\t";
	}
	chop($record);
	$record .= "\n";
	return $record;
}

sub split_record {
	my $record = shift;
	my (@item);
	foreach my $item ( split(/\t/, $record) ){
		$item =~ s/<<-TAB->>/\t/g;
		$item =~ s/<br>/\n/g;
		push(@item, $item);
	}
	return @item;
}

sub read_infofile {
	my ($filepath, $getname) = @_;
	my ($name, $info);
	foreach my $record ( &read_file($filepath) ){
		($name, $info) = split(/ = /, $record);
		$info{$name} = $info;
		$info{$name} =~ s/<<-EQUAL->>/ = /;
		return $info{$name} if ($name eq $getname);
	}
	return %info;
}

sub write_infofile {
	my ($filepath, %info) = @_;
	my (@infofile);
	foreach my $name (keys %info) {
		$info{$name} =~ s/\r?\n/<br>/;
		$info{$name} =~ s/ = /<<-EQUAL->>/;
		push(@infofile, "$name = $info{$name}") if length($info{$name}) != 0;
	}
	&write_file($filepath, @infofile);
}

sub get_primary_no {
	my $primary_no = shift;
	my $time = &get_time('LocalTime');
	$primary_no .= substr($time, 3, 1);
	$primary_no .= substr($time, 4, 1) * 4 + substr($time,6,1);
	$primary_no .= substr($time, 5, 1);
	$primary_no .= substr($time, 7, 1);
	$primary_no .= substr($time, 8, 1) * 3 + int(rand(3));
	$primary_no .= substr($time, 9, 5);
	$primary_no .= int(rand(10));
	return $primary_no;
}

sub convert_metachar {
	my ($str) = @_;
	my ($cstr);
	foreach my $char ( split(//, $str) ){
		if($char =~ /[\!\"\#\$\%\&\'\=\~\|\@\`\[\{\;\+\:\*\]\}\,\<\.\>\/\?\\\_]/){
			$char = "\\".$char;
		}
		$cstr .= $char;
	}
	return $cstr;
}

sub get_random {
	my ($low, $high) = @_;
	my $random = int(rand($high - $low + 1)) + $low;
	return $random;
}

sub replace_string {
	my ($string, $before_string, $after_string) = @_;
	$string =~ s|\Q$before_string\E|$after_string|g;
	return $string;
}

sub get_filesize {
	return -s shift;
}

sub remove_linefeed {
	my ($string, $case) = @_;
	$string =~ s/\r?\n//g  unless $case;
	$string =~ s/\r?\n$//g if $case eq 'last';
	return $string;
}

sub read_directory {
	my ($dirpath, $filter, $pos, $no_error) = @_;
	my (@filelist);
	if (chdir($dirpath)) {
		if ($filter) {
			@filelist = <$filter*>  if ($pos eq 'first');
			@filelist = <*$filter*> if ($pos eq 'middle' || $pos eq '');
			@filelist = <*$filter>  if ($pos eq 'last');
		} else {
			@filelist = <*>;
		}
		chdir($BaseDir);
	}else{
		return undef if $no_error;
		&error("Can't Open $dirpath(&read_directory)");
	}
	return @filelist;
}

sub read_directory_contents {
	my ($dirpath) = @_;
	my (@filename) = &read_directory($dirpath);
	my (@dirrecord, @record);
	foreach $filename (@filename) {
		@record = &read_file("$dirpath/$filename");
		push(@dirrecord, "<<-$filename->>", @record, "\n");
	}
	return @dirrecord;
}

sub get_match_string {
	my ($string, $ereg) = @_;
	$string =~ m/$ereg/;
	return $&;
}

sub delete_file {
	my ($filepath, $no_error) = @_;
	unless (unlink $filepath) {
		return undef if $no_error;
		&error("Can't Delete $filepath(&delete_file)");
	}
	return 1;
}

sub rename_file {
	my($beforepath, $afterpath, $no_error) = @_;
	unless (rename $beforepath,$afterpath) {
		return undef if $no_error;
		&error("Not Found $beforepath(&rename_file)") unless -e $beforepath;
		&error("Can't Rename $beforepath to $afterpath(&rename_file)");
	}
	return 1;
}

sub copy_file {
	my ($original_filepath, $copy_filepath, $no_error) = @_;
	unless (open(IN, $original_filepath) ){
		return undef if $no_error;
		&error("Not Found $original_filepath(&copy_file)");
	}
	unless (open(OUT, "> $copy_filepath")) {
		close(IN);
		return undef if $no_error;
		&error("Can't Create $copy_filepath(&copy_file)");
	}
	binmode(IN);
	binmode(OUT);
	my @tmpfile = <IN>;
	print OUT @tmpfile;
	close(IN);
	close(OUT);
}

sub sendmail {
	my ($from, $to, $subject, $body) = @_;
	my (@mail);
	&convert_jcode(\$subject, 'jis', '', 'z');
	&convert_jcode(\$body,    'jis', '', 'z');
	open(MAIL, '|'.$SendMail.' -t') || return 0;
	push(@mail, "To:$to");
	push(@mail, "From:$from");
	push(@mail, "Subject:$subject");
	push(@mail, "Content-Transfer-Encoding: 7bit");
	push(@mail, "Content-Type: text/plain; charset=\"ISO-2022-JP\"");
	push(@mail, "");
	push(@mail, "$body");
	print MAIL join("\n", @mail);
	close(MAIL);
	return 1;
}

sub get_split_item {
	my ($separator, $string, $position) = @_;
	my (@item) = split($separator, $string);
	$position = 0      if $position eq 'first';
	$position = $#item if $position eq 'last';
	return $item[$position];
}

sub trim {
	my($str, $option) = @_;
	$str =~ s/^[\s\t\r\n$option]+//;
	$str =~ s/[\s\t\r\n$option]+$//;
	return $str;
}

sub create_directory {
	my ($dirpath, $permission) = @_;
	return 0 if -d $dirpath;
	mkdir($dirpath, 0777) || &error("Can't Create $dirpath(&create_directory)");
	return 1;
}

sub convert_jcode {
	my ($contentref, $mojicode_to, $mojicode_from, $hz) = @_;
	if ($$contentref && ($mojicode_to ne $mojicode_from || $hz)) {
		&jcode::convert($contentref, $mojicode_to, $mojicode_from, $hz);   # for jcode.pl
	}
	return $$contentref;
}

sub get_time {
	my ($mode, %option) = @_;
	my ($sec, $min, $hour, $day, $mon, $year, $time);
	$option{'Length'} = 14 if (!$option{'Length'});
	if ($mode eq 'LocalTime') {
		($sec, $min, $hour, $day, $mon, $year, $wday) = localtime(time);
	} elsif ($mode eq 'LastUpdateTime') {
		($sec, $min, $hour, $day, $mon, $year, $wday) = localtime( ( stat($option{'FilePath'}) )[9] );
	}
	($year, $mon) = ($year + 1900, $mon + 1);
	$time = sprintf("%04d%02d%02d%02d%02d%02d", $year, $mon, $day, $hour, $min, $sec);
	$time = substr($time, 0, $option{'Length'});
	$time = &format_time($time) if $option{'Format'};
	return $time;
}

sub remove_extension {
	my $filename = shift;
	$filename =~ /^(\w*)/;
	return $1;
}

sub get_scriptname {
	my $script = $ENV{'SCRIPT_NAME'};
	$script =~ /([\w\.]*)$/;
	return $1;
}

sub format_time {
	my ($time) = @_;
	my ($sec, $min, $hour, $day, $mon, $year, $wday, $yr, $mt);
	my (@week) = ($resource{'Sun'}, $resource{'Mon'}, $resource{'Tue'}, $resource{'Wed'}, $resource{'Thu'}, $resource{'Fri'}, $resource{'Sat'});
	if ($time =~ /^(\d\d\d\d)(\d\d)(\d\d)(\d\d)?(\d\d)?(\d\d)?/) {
		($year, $mon, $day, $hour, $min, $sec) = ($1, $2, $3, $4, $5, $6);
		($yr, $mt) = ($mon == 1 || $mon == 2) ? ($year - 1, $mon + 12) : ($year, $mon);
		$wday = ($yr + int($yr / 4) - int($yr / 100) + int($yr / 400) + int((13 * $mt + 8) / 5) + $day) % 7;
	}
	if ($time =~ /^(\d){8}$/) {
		return sprintf("%04d-%02d-%02d (%s)", $year, $mon, $day, $week[$wday]);
	} elsif ($time =~ /^(\d){12}$/) {
		return sprintf("%04d-%02d-%02d(%s)%02d:%02d", $year, $mon, $day, $week[$wday], $hour, $min);
	} elsif ($time =~ /^(\d){14}$/) {
		return sprintf("%04d-%02d-%02d (%s) %02d:%02d:%02d", $year, $mon, $day, $week[$wday], $hour, $min, $sec);
	}
}

return 1;

■G-ID

KeyWiki Ver 0.6.9
(c) 2004 Ryota