#! /usr/bin/perl package CgiMaker; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); require Exporter; @ISA = qw(Exporter AutoLoader); # デフォルトで書き出すもの @EXPORT = qw(FORMg FORMp HTMLHead URLe URLd Browser IP LOGr LOGw CodeSjis Calendar); $VERSION = '3.72'; ############################################## ExportMethods ############# # FORMからの受け取り METHOD=GET 戻りは [form名前]=[Value]の配列 # @{&FORMg}; sub FORMg{my $buffer=$ENV{'QUERY_STRING'};my @FORMg=split(/&/,$buffer);return \@FORMg;} # FORMからの受け取り METHOD=POST 戻りは [form名前]=[Value]の配列 # @{&FORMp}; sub FORMp{my $buffer; read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); $buffer=~s/%25/%/ig; my @FORMp=split(/&/,$buffer);return \@FORMp;} # HTMLHead書きだし宣言ヘッダー # HTMLHead; sub HTMLHead{ # print "Cache-Control: no-cache\n"; print "Cache-Control: no-store, no-cache, must-revalidate, post-check=0, pre-check=0\n"; print "Pragma: no-cache\n"; print "Expires: 0;\n"; print "Content-type: text/html;charset=Shift_JIS\n\n"; print ''."\n\n";} # $スカラー自体をURL形式に文字列をエンコード # URLe $スカラー; sub URLe{my $URLencode=shift;$URLencode=~s/([^0-9A-Za-z_ ])/'%'.unpack('H2',$1)/ge;$URLencode=~s/\s/+/g;return \$URLencode;} # $スカラー自体をURL形式から文字列にデコード # URLd $スカラー; sub URLd{my $URLdecode=shift;$URLdecode=~tr/+/ /;$URLdecode=~s/%([a-fA-F0-9]{2})/pack("C",hex($1))/eg;return \$URLdecode;} # ${&Browser}; Browserの拾得 sub Browser{\$ENV{HTTP_USER_AGENT}} # ${&IP}; IPの拾得 sub IP{\$ENV{REMOTE_ADDR}} # ログ読み込み # @{&LOGr($スカラー)}; sub LOGr{my $ChatLog=shift;my @dat;open(FILE,$ChatLog),chomp(@dat=),close(FILE);return \@dat} # ファイル書き込み # &LOGw($スカラー,@配列); sub LOGw{my $FIL=shift;my @dat=@_; open(LOG, '+<'.$FIL);$|=1;eval{flock(LOG, 2)};truncate(LOG, 0);seek(LOG, 0,0); for(@dat){tr/ / /;next unless($_);print LOG;print LOG "\n";}close(LOG);} # 文字をテストしSift-jisで無ければSift-jisに変換(EUCとJISをSJISへ) # map{&CodeSjis($_)}@LogData; sub CodeSjis{$_[0]=${&CodeEuc($_[0])} if ${&CodeLooker($_[0])} eq 'euc'; $_[0]=${&Codejis($_[0])} if ${&CodeLooker($_[0])} eq 'jis';return $_[0];} ############################################## AutoloadMethods ########### # リダイレクター (戻り値無し指定URLにとばす) # $スカラー=URL; # &CgiMaker::redai($スカラー); sub redai{my $urlz=shift;print "Expires: 0;\nLocation: $urlz\n\n";exit;} # 配列の一つごとの数値フィールドを指定しそれを比較してソートした配列を返す # $スカラー='フィールドの区切りもじ'; # @{&CgiMaker::Fsort($スカラー,数字,@配列)}; sub Fsort{my $spritkey=shift;my $field=shift;my @in=@_;my @out; @out=map{$_->[0]}sort{$a->[1]<=>$b->[1]}map{[$_,(split /$spritkey/)[$field]]}@in;return \@out;} # 配列のだぶりとり # @{&CgiMaker::CleanList(@配列)}; sub CleanList{my @dat=@_;my %seen; @dat=grep(!$seen{$_}++,@dat);return \@dat;} # リストシャッフル (元配列はそのままで返値はシャッフルした配列のリファレンス) # @{&CgiMaker::Shuffle(@配列)} sub Shuffle{my @OUT;srand;push @OUT,splice @_,rand @_,1 while @_;return \@OUT;} # 数字に桁うちします(戻り値はスカラーリファレンス) # ${&CgiMaker::keta($スカラー)}; sub keta{my $number=shift;1 while $number=~s/(.*\d)(\d\d\d)/$1,$2/g; return \$number;} # 一つ前のページを参照 # ${&CgiMaker::FromURL}; sub FromURL{\$ENV{'HTTP_REFERER'}} # 書きだし宣言ヘッダーいろいろ # &CgiMaker::HeadEX; sub HeadEX{my $type=shift; if($type eq '1'){print "Content-type: image/jpg\n\n"; }elsif($type eq '2'){print "Content-type: image/jpeg\n\n"; }elsif($type eq '3'){print "Content-type: image/gif\n\n"; }elsif($type eq '4'){print "Content-type: video/mpeg\n\n"; }elsif($type eq '5'){print "Content-type: video/mpg\n\n"; }else{print "Content-type: text/plain\n\n";}} # 日本時間日時曜日を返す # ${&CgiMaker::Jdate(\d)}; time数字列をセット # ${&CgiMaker::Jdate}; 現在 sub Jdate{my $times=shift;$times=time unless($times);my ($sec,$min,$hour,$mday,$month,$year,$youbi)=localtime($times);$min = "0$min" if ($min < 10); $month++;$youbi=('日','月','火','水','木','金','土')[$youbi];$year+=1900;my $date="$month/$mday($youbi)$hour時$min分";return \$date;} # オートリンク # &CgiMaker::AutoLink($_); sub AutoLink{ my $AutoLink=shift; $AutoLink=~s/(http:\/\/[\w\$\#\~\.\/\-\?\=\&]+\.gif)/\[GIF<\/A>\]/ig unless(@_[0]=~/JPEG<\/A>\]/ig unless(@_[0]=~/LINK<\/A>\]/ig unless(@_[0]=~/2);my $zure=(($mzure+$yzure) % 7);my @monthday=(0,31,28,31,30,31,30,31,31,30,31,30,31);$monthday[2]=$monthday[2]+$uru;for($i=1;$i<=$zure;$i++){push(@days,' ');}for($i=1;$i<=$monthday[$month1];$i++){$i=' '.$i if $i<10;push (@days,$i);}return \@days;} # カレンダー生成 # ${&Calendar(1999,10)}; sub Calendar{my $Yr=shift;my $TodayZ;my $Mn=shift;my @CALENDER=@{&calc($Yr,$Mn)};my ($Da,$Mo,$Ye)=(localtime(time))[3,4,5];$Mo++;$Ye+=1900;my $LINK=$0.'?C='.$Yr.'-'.$Mn.'&D=';my $Flag=0;my $Calendar='
',"\n";$Calendar.=$Yr.'月';$Calendar.=$Mn.'日';$Calendar.='';$Calendar.='',"\n";$Calendar.=''."\n".'';while(@CALENDER){$Calendar.="\n" and $Flag=0 if $Flag eq 7;my $DAYX=shift @CALENDER;$DAYX=~s/\s//g;if(($Yr eq $Ye)&&($Mn eq $Mo)&&($DAYX eq $Da)){$Calendar.='';$Flag++;}my $CNT=7-$Flag;$Calendar.=''x$CNT;$Calendar.='
';}else{$Calendar.='';}if($DAYX){$Calendar.=''; if($Flag eq 0){$Calendar.='';}elsif($Flag eq 6){$Calendar.='';}else{$Calendar.='';} $Calendar.=$DAYX;$Calendar.='';$Calendar.='';}else{$Calendar.=' ';}$Calendar.=' 
';$Calendar.='
';return \$Calendar;} ############################################## Sift-JIS Tools ########### sub CodeLooker{my $code;unless (@_[0]=~/[\e\200-\377]/){$code = undef; }elsif(@_[0]=~/\e\$\@|\e\$B|\e&\@\e\$B|\e\$\(D|\e\([BJ]|\e\(I/o){ $code = 'jis';}elsif(@_[0]=~/[\000-\006\177\377]/o) {$code = 'binary'; }else{my ($sjis, $euc);$sjis += length($1) while @_[0]=~/(([\201-\237\340-\374][\100-\176\200-\374])+)/go;$euc += length($1) while @_[0]=~/(([\241-\376][\241-\376]|\216[\241-\337]|\217[\241-\376][\241-\376])+)/go;&max($sjis, $euc);sub max{$_[$[+($_[$[]<$_[$[+1])]}$code = ('euc', undef, 'sjis')[($sjis<=>$euc) + $[ + 1];}\$code;} sub CodeEuc{my $string = shift;my ($result,$j,$c,$c2,$c3,@c);my $ctype = '1';@c = split(//,$string);for($j=0;$j<=$#c;$j++){$c=$c[$j];if($c=~/[\x00-\x7f]/){$result.=$c;}elsif($c=~/[\xa1-\xfe]/){last if(++$j>$#c);$c2=$c[$j];if($c2=~/[\xa1-\xfe]/){$result.=_euc2sjis($c,$c2);}else{$result.=$c.$c2;}}elsif($c eq "\x8e"){last if(++$j>$#c);$c2=$c[$j];if($c2=~/[\xa1-\xdf]/){$result.=$c2;}else{$result.=$c.$c2;}}elsif($c eq "\x8f"){last if(++$j > $#c); $c2=$c[$j];last if(++$j > $#c);$c3=$c[$j];if($c2=~/[\xa1-\xfe]/ && $c3=~/[\xa1-\xfe]/){$result.="■";}else{$result.=$c.$c2.$c3;}}else{ $result.=$c;}}\$result;} sub _euc2sjis{my $c1=shift;my $c2=shift;$c1=ord($c1)-128;$c2=ord($c2)-128;chr((($c1+1)>>1)+($c1<95 ? 112 : 176)).chr($c2+(($c1 % 2) ? ($c2 > 95 ? 32 : 31) : 126));} sub Codejis{my $string = shift;my ($result,$j,$c,$c2,$c3,@c);my $ctype = '1';@c=split(//,$string);for($j=0;$j<=$#c;$j++){$c=$c[$j];if($c eq "\e"){last if(++$j>$#c);$c=$c[$j];if($c eq '$'){last if(++$j > $#c);$c = $c[$j];if($c eq '@' || $c eq 'B'){$ctype='2';}elsif( $c eq '(' ){last if(++$j>$#c); $c = $c[$j];if($c eq 'D'){ $ctype = '3';}}}elsif($c eq '&'){last if(++$j > $#c);$c = $c[$j];if($c eq '@'){ $ctype = '2';}}elsif($c eq 'K'){ $ctype = '2';}elsif($c eq '('){last if(++$j>$#c);$c=$c[$j];if($c=~/[JHB]/){$ctype='1';}elsif($c eq 'I'){$ctype='K';}}}elsif($c eq "\x0e"){$ctype='K';}elsif($c eq "\x0f" ){$ctype='1';}elsif($ctype eq '2'){last if(++$j > $#c);$c2=$c[$j];$result.=_jis2sjis($c,$c2);}elsif($ctype eq '3'){last if( ++$j > $#c);$c2 = $c[$j];$result .= "■";}elsif($ctype eq 'K'){$c=chr(ord($c)+128) if($c=~/[\x21-\x5f]/);$result.=$c;}else{$result.=$c;}}\$result;} sub _jis2sjis{my $c1=ord(shift);my $c2=ord(shift);chr((($c1 + 1)>>1)+($c1<95 ? 112 : 176)).chr($c2+(($c1%2) ? ($c2>95 ? 32 : 31) : 126));} ############################################## Sift-JIS Tools ########### 1; __END__ # Below is the stub of documentation for your module. You better edit it! =head1 NAME CgiMaker - Perl extension for Japanese =head1 SYNOPSIS BEGIN{sort @INC; use CgiMaker;} # sort @INCは自分の階層である . を一番始めに探すようにという配慮(実験中) HTMLHead; print '貴方は'.${&Browser}.'でアクセスしました。'; =head1 DESCRIPTION 処理する同じディレクトリーにぶちこんで このライブラリーを使うスクリプトに以下を書く。 BEGIN{sort @INC;} use CgiMaker; 自分用リアルタイムチェッカーヒント @dat=@{&CleanList(@{&LOGr($FL)},$MyValue)}; # ファイル名$FLからログを読み # リストをクリーニングしたもの @dat=grep{(split /:/)[0] < $T+120}@dat; # 120秒前のものは消せ =head1 AUTHOR KAIN 加印 (加の銘入りソースシリーズ) Hiroki Kagamoto, kain@tech-web.net =head1 SEE ALSO perl(1). =cut