【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|\&|&|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;

---