while (1) { print "無理です"; }
#!/usr/local/bin/perl
if (>>1 = "バカ") {
print "イッテヨシ";
} else {
print "マターリしましょう";
} #!/usr/bin/perl
my $logfile = './count.log';
my $addr = $ENV{'REMOTE_ADDR'};
open( FILE,"+<$logfile" ) or die;
flock( FILE, 2 );
( $_ = <FILE> ) =~ /^(.*?):(.*)$/;
my ( $count, $ip ) = ( $1, $2 );
$count++ if $addr ne $ip;
seek( FILE, 0, 0 );
print FILE "$count\:$addr";
truncate( FILE, tell );
close FILE;
print "Content-type: text/plain\n\n";
printf( "%.5d", $count );
exit;
自作のカウンターです。元はKENTですが原型無いです。
一応多重カウント防止、桁そろえします。
これなんとか7行にできそーなんだけど、どうでそう?
何とかも何も、変数の冗長性を残しても3行になったよ。
#!/usr/bin/perl -w
$addr=$ENV{REMOTE_ADDR};open L,"+<.log";flock L,2;($c,$ip)=split/:/,<L>;
if($addr ne$ip){$c++;seek L,0,0;print L "$c:$addr";truncate L,tell(L);print
"Content-Type:text/plain\n\n$c"}
ワーイ 3行にナッター 有難う。
まだまだperl勉強中の身ですー
と思ったらバグがあった。後半の処理全部ifブロックに入れたらダメじゃん。
しかも3行じゃなくて3行ね。
ついでに変数を短く。flockしなけりゃ3行いけるね。
#!/usr/bin/perl -w
$a=$ENV{REMOTE_ADDR};open L,"+<l";flock L,2;($c,$i)=split/:/,<L>;if($a ne$i){
$c++;seek L,0,0;print L"$c:$a";truncate L,tell L}print"Content-Type:text/plain
\n$c"
>>12
読みやすさを追求してるわけじゃないんだけどね
趣旨を理解してよ SWFファイルからJPEGを取り出す
SWF("$ARGV[0]");
sub SWF{$file="$_[0]";open(FILE,$file);
binmode FILE;while(<FILE>){$ed=unpack("h*","$_");
if($ed=~/ff8dff0e.{2}01a46494640010/){$Wri=pack("h*","$ed");
print FILEX "$Wri";$ed=~s/.*(ff8dff0e.{2}01a46494640010)/$1/;
$c9++;print "$c9\n";$fileX="SWF$file$c9.jpg";open(FILEX,">$fileX");
binmode FILEX;}$Wri=pack("h*","$ed");print FILEX "$Wri";}}
>>8の
truncate( FILE, tell );
これはどういう意味? print <<7LINE;
*******************************************************************************
*******************************************************************************
*******************************************************************************
*******************************************************************************
*******************************************************************************
*******************************************************************************
*******************************************************************************
7LINE
echo "aho1"
echo "aho2"
echo "aho3"
echo "aho4"
echo "aho5"
echo "aho6"
echo "aho7"
掲示板でけた〜〜
#!/usr/bin/perl
if($ENV{'REQUEST_METHOD'}eq'POST'){read(STDIN,$b,$ENV{'CONTENT_LENGTH'});
foreach(split(/&/,$b)){($c,$d)=split(/=/,$_);$d=~tr/+/ /;
$d=~s/%([a-f\d]{2})/pack('H2',$1)/egi;$form{$c}=$d}open(F,'>>z.txt');
print F "$form{y}\n";close F}print"Content-type:text/html\n\n<html>
<form action=x.cgi method=post><input type=text name=y><input type=submit>
</form><br><br>";open(F,'z.txt');while(<F>){print "$_<br>\n"}print'</html>';
てめーら七行もあるのにその程度のモンしか作れねーのかよ(プ
>>30
だからきみのすごい作品を待っています。ハイレベル期待しています。
もうできてる? 今からつくる? 今日中には書き込んでくれ。 実際、Perlだったらかなりのものが出来てもおかしくはないかと。
ム板の7行スレは凄かった。
ム板マ板で相手にされない厨が集まる板はここですか?
WebProg らしく。
--- cgi-lib.po ---
my($m,$l,$i,$e,$x)=@ENV{'REQUEST_METHOD','CONTENT_LENGTH'};my$d=sub{$d=
"Request to receive too much data: $l bytes\n";print"Content-Type: text/plain",
"\n\n$d";die$d};sub ReadParse{$l>$$x?&$d:$m=~/POST/?($e=$l-read STDIN,$i,$l):(
$i=$ENV{QUERY_STRING});local*I=pop;my@i=(split(/[&;]/,$i),($m?():@ARGV));for(@i
){tr/+/ /;s/%([\da-f]{2})/pack'H2',$1/egi for my($k,$v)=split/=/,$_,2;$I{$k}.=
$I{$k}?"\0$v":$v}!$e&&scalar@i}${$x='cgi_lib::maxdata'}=131072
---------------
cgi-lib.pl 互換。Perl4 不可、multipart 未対応。
require 'cgi-lib.po';
$cgi_lib::maxdata = 1024; # POST 時の上限サイズ
ReadParse(*in); # or ReadParse(\%in);
名前入力欄つき掲示板
$q=$ENV{QUERY_STRING}; if($q){@p=split /[&;]/,$q; foreach(@p){($a,$b)=split
"="; $b=~tr/+/ /; $b=~s/%([A-Za-z0-9]{2})/pack("C", hex($1))/eg; $i{$a}=$b;}
open W, ">> b.log"; print W "$i{n}<>$i{m}\n"; close W;} print "Content-type:
text/html\n\n<html>\n<head><title>掲示板</title></head>\n<body>\n"; open R,
"b.log"; while(<R>){chomp; ($n,$m)=split "<>"; print "$n:$m<br>\n";} close R;
print qq{<hr>\n<form>Name<input type="text" name="n"> <input type="text"
name="m" size="64"><input type="submit"></form>\n<hr>\n</body></html>\n}; exit;
改良
$q=$ENV{QUERY_STRING}; if($q){@p=split /[&;]/,$q; foreach(@p){($a,$b)=split
"="; $b=~tr/+/ /; $b=~s/%([A-Za-z0-9]{2})/pack("C", hex($1))/eg; $i{$a}=$b;}
open W, ">> b.log"; print W "$i{n}:$i{m}\n"; close W;} print "Content-type:
text/html\n\n<html>\n<title>BBS</title>\n\n"; open R, "b.log"; while(<R>)
{chomp; print "$_<br>\n";} close R; print qq{<hr>\n<form>Name<input type="text"
name="n"> <input type="text" name="m" size="64"> <input type="submit"> [<a
href="b.cgi">Reload</a>] [<a href="../../">Back</a>]</form>\n<hr>\n</html>\n};
>>24 を発展させてみた。一行掲示板。
--- 7bbs.cgi ---
#!/usr/local/bin/perl
$l='7bbs.log';if(read STDIN,$_,$ENV{'CONTENT_LENGTH'}){for(split/&/){$_=(split
/=/)[1];tr/+/ /;s/%([a-f\d]{2})/pack'H2',$1/egi;push@r,$_}@r=(''.localtime,@r);
open F,"+<$l";flock F,2;@l=(join(': ',@r),"<br>\n",<F>);truncate F,0;print F
@l[0..49]}open F,$l;print join('><input type=',"Content-type: text/html\n\n".
'<title></title><form action=7bbs.cgi method=post','text name=n','text name=w',
'submit></form>'),<F>
----------------
新しい順に表示。50件まで保存。
>>41
ネタが被るねぇ。ゴメンね。(´・ω・`) 動かねぇです大将!>>42>>43
>>42のは半角でも全角でも変な文字が保存されるです!モジコード変えてもダメだったです!
>>43のはファイルが作成されませぬ!
私のミステイクでしょうか!ハラキリ! >>44
open F,"+<$l"; ←注目
つー事で、ログファイルは先に作っといて。
$l='7bbs.log';
のトコがログファイルのパスだから、よろ。 ( そんな事より1さん、ちょっと聞いてよ。スレとあんまり関係ないけどさ。
`ー‐―V―――――――――――――――――――――――――――――
;:'´ ( このあいだ、WebProg板へ行ったんですの。WebProg板。
_....._{{ 〃 \ そしたらなんかRuby!と書かれたレスが多発していましたわ。
, - ' ,..、、.ヾ{{フ'⌒`ヽ、ー―――V――――――――――――――――――
/ ,:', -‐‐` ´ '´⌒ヽ ヾ:、 _....、、、、 ( で、よく見たらrubyistという名前の書き込みで、
. ,' ,'´ ,ィ ,ィ ,' , `ヽ', ',-<´ , `ヽ.`ー――――V― 相手してもらえてないんです。
,' .i /|. /.| { i, i, }. }_,,)) lニ二二ミヽ.、 ':, ,.: '´ ,_.....__`ヽ、 ,..-‐-、),.....`_――――――
! | ! .,'-.{ ! !|; |`、.}゙!.! |. ! ヽ.l ./ ,! ,,`ヾ:、 ':, ./'´ ̄`ヾ、、ヽ,.:'´ ,:‐:、 ,.-、 ヽ.
', ', |Vァ=、゙、 `゙、!-_:ト,リ', l ! | ゙レ__,〃_/リ !.'; .} ./l_|___ノ! l `、 ', / //`''} }.'; ',
ヽ、', l:!Kノ}. f:_.)i゙i: リ ! l ル' ̄`` ´-、,ノノ l l .!,;:=、`:.`:>=、.j,} |__人(( _ノノノ |
| l!iヾ- ' , .!__:ノ ゙ ,リ l リ'´ .|' ̄ヽ __ `><ノ | {;:'ノ ノtrテ;、.Y ! ,--、 __`彡 ノ
. ',|!!、 r‐┐ ` ノ' /,イ ! __ , ⌒'/!| | !.`ー‐'´, ゙じ' ノ ! h. ._: ´ ソ).(
'i!゙、ヽ、 ゙ー' _, ィ,:',:''´ ! !、 ー' ノイ ! | | !、 !フ `フ'リ ! ル'ヽ.._ _..、(ン ノ )
゙:、ィ、jヾー::: 'iヘ ノ',リ./! .| |ー`┬、' ´ 〃 l. トヾ、.゙`ィ'' ´ヽ、/// \二|`\ー‐‐'´
,、- '´ ヽ、゙、 { `>"、 ! ! ! | `>-、 | |、 ________∧_____
/\\ ', } //`ヽ| ',.!゙、 !// ゙!/ ! ( もうね、アホかと。馬鹿かと‥
明文化
・7行×79文字
・Perl
・#!/usr/local/bin/perlは含まない。実質的なプログラムで七行。
・スペースも1文字分。2バイト文字は2文字分。
でいいでしょうか?
掲示板は本家でもうかなり短くなってないか?
別に委員だけど、もっと面白いネタがないかなと。
>>48
プログラムが Web 関連物なら言語は何でもいいんじゃ?
シェバング行は C の #include みたいなモンだから…。
>>51
単に縮めるだけじゃなく、7行をギリギリまで使って機能増やすのも
楽しみの一つだよ。掲示板に食傷気味なのは同意するけど。(w
つー事で改良。
--- 7bbs.cgi ---
#!/usr/local/bin/perl
$l='7bbs.log';if(read STDIN,$_,$ENV{CONTENT_LENGTH}){@r=''.localtime;for(split
/&/){$_=(split/=/)[1];tr/+/ /;s/%([a-f\d]{2})/pack'H2',$1/egi;s/(["&<>])/'?'.
unpack('C',$1).';'/eg;push@r,$_}open F,"+<$l";flock F,2;@l=(join(': ',@r).
"<br>\n",<F>);truncate F,0;seek F,0,0;print F @l[0..49]}open F,$l;print join(
'><input type=',"Content-type: text/html\n\n<title>7BBS</title><form action=".
'7bbs.cgi method=post','text name=n','text name=w',"submit></form>\n"),<F>
----------------
["&<>] を数値文字参照に変換。 >>43
Winではflock 使えなくてエラーに ヽ(*`Д´)ノ ワァァン
>>44
ガ━━━━(;゚Д゚)━━━━ン !!
すいませn原因わかりませn
Windows環境でSJISならうまくいくんだけど・・
>>53
前に2ch型掲示板作ってみたけど、無理確定のような気がする。
誰か作れる人、いるかな 7行2ch型掲示板
ただし、かちゅ〜しゃがないとだめぽ、
read.cgiがないから読めないし、書きこみフォームもないから、あとsubject.txtの新スレは一番下になる。
flockもしていない、かちゅに依存するために変数名が長い。
下記のディレクトリ構成で成功
/test
+--/bbs.cgi
+--/subject.txt
+--/dat/
#!/usr/local/bin/perl
$t=time;read(STDIN,$b,$ENV{'CONTENT_LENGTH'});@p=split(/&/,$b);foreach (@p)
{($a,$v)=split "=";$v=~tr/+/ /;$v=~s/%([A-Za-z0-9]{2})/pack("C", hex($1))/eg;
$i{$a}=$v;}if(!$i{'key'}){$i{'key'}=$t;}open(F,">>./dat/$i{'key'}.dat");
print F "$i{'FROM'}<>$i{'mail'}<>$t<>$i{'MESSAGE'}<>$i{'subject'}\n";close(F);
open(S,">>./subject.txt");print S "$i{'key'}.dat<>$i{'subject'}(1)\n";
close(S);exit;
つーか激しく2ch型から離れているが。
>>55
それは普通掲示板といいません(w
win鯖では動いたけどな。 やはりCGIだと、定型的な部分で多く取られてしまいますな。
[アクセス解析]
CGI名: a.cgi
空ファイル用意: log
そのままアクセスしてログ取り
引数に a をつけて解析結果表示
#!/usr/bin/perl
&a if $ENV{QUERY_STRING}eq'a';($s,$m,$j,$d,$g,$y)=gmtime(time+9*60*60);$i=$ENV{
REMOTE_ADDR};$h=$ENV{REMOTE_HOST}||gethostbyaddr(pack('C4',split(/\./,$i)),2)||
$i;$y=sprintf("%d/%02d/%02d/ %02d:%02d:%02d",$y+=1900,++$g,$d,$j,$m,$s);open(F,
'+<log');@d=<F>;unshift(@d,"$y,$h,$ENV{HTTP_USER_AGENT},$ENV{HTTP_REFERER}\n");
seek(F,0,0);print F @d;sub a{print"Content-type:text/html\n\n";open(F,'log');
while(<F>){($t,$h,$u,$r)=split(/,/,$_);print"$t<br>$h<br>$u<br>$r<hr>"}exit}
>>57
試しにHTMLを分離して作ってみたら大分縮んだ。
http://boobar.hp.infoseek.co.jp/7bbs2/7bbs2_0.0.1.tar.gz
>>58
縮めてみた。
#!/usr/bin/perl
if($ENV{QUERY_STRING}eq'a'){open F,'log';print"Content-Type: text/html\n\n",map
join('<br>',split/,/).'<hr>',<F>;exit}$i=$ENV{REMOTE_ADDR};$h=$ENV{REMOTE_HOST}
||gethostbyaddr(pack('C4',split/\./,$i),2)||$i;($s,$m,$j,$d,$g,$y)=localtime;
open F,'+<log';eval{flock F,2};@d=(sprintf('%d/%02d/%02d %02d:%02d:%02d',1900+
$y,$g+1,$d,$j,$m,$s).",$h,$ENV{HTTP_USER_AGENT},$ENV{HTTP_REFERER}\n",<F>);
truncate F,0;seek F,0,0;print F @d ---- 7wiki.cgi
#!/usr/local/bin/perl -w
use strict; use CGI qw/:standard/; use AnyDBM_File; use Fcntl;
my$id=$ENV{'QUERY_STRING'}||'FrontPage';my$msg=param('msg')||'';
my$url='./7wiki.cgi'; tie(my%DB,'AnyDBM_File','wiki',O_CREAT|O_RDWR,0666)or die;
if ($msg){$DB{$id}=$msg} $msg=escapeHTML $DB{$id}; untie(%DB);print header;
print qq(<form action="$url?$id" method="POST"><input type="submit"><b>$id</b>
<br /><textarea name="msg" rows="6" cols="60">$msg</textarea></form><hr />);
$msg=~s/\b([A-Z][a-z]+([A-Z][a-z]+)+)\b/<a href="$url?$1">$1<\/a>/g;print $msg;
>>66
#!/usr/local/bin/perl -w
use strict;use CGI':standard';use AnyDBM_File;use Fcntl;tie(my%D,'AnyDBM_File',
'7wiki',O_CREAT|O_RDWR,0666)||die;my$i=$ENV{QUERY_STRING}||'FrontPage';$_=
escapeHTML($D{$i}=param('m')||$D{$i});untie%D;print header(),qq(<form
action="7wiki.cgi?$i" method="post"><input type="submit" /><b>$i</b><br />
<textarea name="m" rows="6" cols="60">$_</textarea></form><hr />);
s|\b([A-Z][a-z]+([A-Z][a-z]+)+)\b|<a href="7wiki.cgi?$1">$1</a>|g;print
\b 要る? >>67
thx ...
WikiName の正規表現は \b([A-Z][a-z]+){2,}\b って書けるみたいだね。
\b 要るかどうかしらないけど、個人的には欲しい。
# http://c2.com/cgi/wiki?LinkPattern
> s|\b([A-Z][a-z]+([A-Z][a-z]+)+)\b|<a href="7wiki.cgi?$1">$1</a>|g;
< s|\b([A-Z][a-z]+){2,}\b|a "7wiki.cgi?$1",$1|ge;
多少、汚くても良いのなら、
- use Fcntl やめて O_CREAT|O_RDWR は定数で
- s/standard/all/; tr/"//d; s/AnyDBM/DBM/g; s' /''g;
- s/use strict;/; s/\bmy\b/g;
- etc ..
・・・で、4〜5行くらいにはダイエット出来るかな。
短いwiki・・・他に、こんなのもあるよ。
http://c2.com/cgi/wiki?ShortestWikiContest 間違えた・・
s|\b([A-Z][a-z]+){2,}\b|a{href=>"7wiki.cgi?$1"},$1|ge;
括弧わすれてた・・・ゴメン(再び修正
\b(([A-Z][a-z]+){2,})\b
use CGI':all';use SDBM_File;$i='7wiki.cgi';$j=$ENV{QUERY_STRING}||'FrontPage';
tie%D,'SDBM_File',$i,258,438or die;$_=$D{$j}=param('m')||$D{$j};untie%D;put
header,startform('post',"$i?$j"),submit,b($j),br,textarea('m',$_,6,60),endform
,hr;$_=escapeHTML$_;s|\b(([A-Z][a-z]+){2,})\b|a{href=>"$i?$1"},$1|ge;put$_
折角なので副産物も(ワンライナーだけど
れぎゅれーしょん ちぇっか usage: ./7rc.pl < target_script.pl
#! perl -nw
chomp;length>79||$.>7?die:print"line $. OK\n"
use Fcntl; O_CREAT|O_RDWR を纏めて 286(tie の引数
定数部分は環境依存するかも知れないので
/usr/include/sys/fcntl.h を参照
DB_File なら use した時点で O_CREAT も O_RDWR も使えるようになる罠。
use DB_File;
print join '/', O_CREAT => O_CREAT, O_RDWR => O_RDWR;
そして O_CREAT は実際 512 だったり 256 だったりする罠。
余った行で僅かばかり実用的にしてみる。
#!/usr/local/bin/perl -w
use CGI qw(:all escapeHTML);use DB_File;$j=$ENV{QUERY_STRING}||'FrontPage';($f)
=$0=~m|([^/]+)(\.cgi)$|;open(L,'+<&='.($d=tie%D,'DB_File',$f,O_CREAT|O_RDWR or
die)->fd)||die;eval{flock L,2};$_=escapeHTML($m=$D{$j}=param('m')||$D{$j});$d->
sync;$d=untie%D;s/\b(([A-Z][a-z]+){2,})/a{href=>"$f.cgi?$1"},$1/ge;s/\x0d\x0a|
\x0d|\x0a/<br>/gx;put header,title("$f - $j"),startform('post',"$f.cgi?$j"),
submit,b($j),br,textarea('m',$m,6,60),endform,hr,$_
陽に輸入してやらないと上のタイミングで escapeHTML 使えなかったよ。
(FreeBSD 4.7R, Perl 5.005_03, CGI.pm 2.89)
#! perl
use CGI':all';$w='\b(([A-Z][a-z]+){2,})';($p)=($ENV{QUERY_STRING}||'FrontPage')
=~/$w/;$f='7wiki.cgi';$o=-f$p?'<':'>';open F,"+$o$p"or die;eval{flock F,2};read
F,$m,-s$p;$_=escapeHTML($m=param('m')||$m);seek F,0,0;print F $m;close F;$_.=hr
.ul map{li"".localtime time-86400*-M," $_"}sort{-M$a<=>-M$b}grep{/^$w$/}glob"*"
;s/$w/a{href=>"$f?$1"},$1/ge;put header,start_html($p),h1($p),startform('post',
"$f?$p"),textarea('m',$m,6,60),br,submit,endform,hr,pre($_),end_html
一覧を付けてみた・・・(残り:1行と10字
:all tag で全部輸入できなかった?:html2 とかでも無理かな?
< $_=escapeHTML($m=param('m')||$m);seek F,0,0;print F $m;
> $_=escapeHTML $m=param('m')||$m;seek F,0,0;print F$m;
< .ul map{li"".localtime time-86400*-M," $_"}sort{-M$a<=>-M$b}grep{/^$w$/}glob"*"
> .ul map{li"".localtime time-86400*-M,$_}sort{-M$a<=>-M$b}grep{/^$w$/}glob"*"
use CGI':all';$w='\b(([A-Z][a-z]+){2,})';($p)=($ENV{QUERY_STRING}||FrontPage)=~
/$w/;$f=script_name;open(F,'+'.(-f$p?'<':'>').$p)||die;eval{flock F,2};read F,$
m,-s$p;$_=escapeHTML$m=param(z)||$m;seek F,0,0;print F$m;close F;$_.=hr.ul map{
li"".localtime time-86400*-M,$_}sort{-M$a<=>-M$b}grep{/$w$/}glob'*';s/$w/a{href
=>"$f?$1"},$1/ge;put header,start_html($p),h1($p),startform(0,"$f?$p"),textarea
(z,$m,6,60),br,submit,endform,hr,pre($_),end_html
>>78
ごめん、CGI.pm 2.89 置いたパスを use lib し忘れたままテストしてた。
5.005_03 同梱のは 2.46 で、この辺だと escapeHTML はどのタグにも
含まれてない。submit() を呼んだ時点で main に定義されるのかな。
#! perl
use CGI':all';$f=script_name;$w='\b(([A-Z][a-z]+){2,})';($p)=($ENV{QUERY_STRING
}||FrontPage)=~/$w/;open(F,-f$p?"+<$p":"+>$p")||die;eval{flock F,2};$/=();$_=
escapeHTML$m=param(z)||<F>;truncate F,0;seek F,0,0;print F$m;close F;$_=join hr
,endform,pre($_),ul map{li localtime((stat$_)[9])." $_"}sort{-M$a<=>-M$b}grep
/$w$/,<*>;s/$w/a{href=>"$f?$1"},$1/eg;put header,start_html($p),startform(0,
"$f?$p"),h1($p),textarea(z,$m,6,60),br,submit,$_,end_html
1 byte 長くなった。むぅ。 書き忘れたけど、78-82 はWin/ActivePerlで作ってました。
他の環境に移したら CGI.pm 2.56 で同様のエラーが出たので
パッケージ名をつけてCGI::escapeHTMLで対応。
もしくは、モジュールを新しくする。でいいかな>対策
NOTE
QUERY_STRING を PATH_INFO に変更して
url の区切りを ? -> / に。
# 勿論、 s/// のスラッシュも他の記号に変更する。
(stat)[9]
BUG
ページ読むだけでも書き込みしてるので
タイムスタンプが。。
>>84
パッケージ名付けた方が優しいかな。> escapeHTML
タイムスタンプのバグフィクス版。以下の環境で動作。
・Perl 5.005_03, CGI.pm 2.46
・Win98SE, AN-HTTPD 1.41g
・FreeBSD 4.7R, Apache/1.3.27
#!/usr/local/bin/perl
use CGI':all';$w='\b(([A-Z][a-z]+){2,})';($p)=($ENV{PATH_INFO}||FrontPage)=~/$w
/x;if(open F,($m=param z)?">$p":$p){eval{flock F,2};$/=();$_=CGI::escapeHTML($m
||=<F>);truncate F,0;seek F,0,0;print F$m;close F}opendir D,'./';$_=join hr,
endform,pre($_),ul map{li localtime((stat)[9])." $_"}sort{-M$a<=>-M$b}grep/$w$/
,readdir D;$f=script_name;s|$w|a{href=>"$f/$1"},$1|eg;put header,start_html($p)
,startform(0,"$f/$p"),h1($p),textarea(z,$m,6,60),br,submit,$_,end_html
AN-HTTPD だとグロブ効かなかったので readdir に変更。
i-httpd だと PATH_INFO 使えなかったけど、まぁこれは
少数派という事で。あともしかしたら MacPerl が truncate
で引っかかるやも。 CGI.pm 2.752, perl 5.005_03 build for sun4-solaris Apache 1.3.27
#! perl -w
use CGI':all';$w='\b(([A-Z][a-z]+){2,})';$f=script_name;$/=();($p)=(path_info||
FrontPage)=~/$w/;opendir D,'.';if(open F,($m=param z)?">$p":$p){eval{flock F,2}
;$_=CGI::escapeHTML$m||=<F>;eval{truncate F,0};seek F,0,0;print F$m;close F}$_.
=hr.ul((map{li"".localtime((stat)[9]),$_}sort{-M$a<=>-M$b}grep/$w$/,readdir D)[
0..9]);s|$w|a{href=>"$f/$1"},$1|eg;put header,start_html$p),h1($p),startform(0
,"$f/$p"),textarea(z,$m,6,60),br,submit,endform,pre($_),end_html
一覧の表示数制限機能追加。
truncate は eval で対応できるかな?>MacPerl
#! perl -w
use CGI':all';$w='\b(([A-Z][a-z]+){2,})';$/=();($p)=(path_info||FrontPage)=~/$w
/x;$f=script_name."/";opendir D,'.';if(open F,($m=param z)?">$p":$p){eval{flock
F,2};$_=CGI::escapeHTML$m||=<F>;eval{truncate F,0};seek F,0,0;print F$m;close F
}$_.=hr.ul((map{li"".localtime((stat)[9]),$_}sort{-M$a<=>-M$b}grep/$w$/,readdir
D)[0..14]);s|$w|a{href=>$f.$1},$1|eg;put header,start_html($p),h1($p),startform
(0,$f.$p),textarea(z,$m,6,60),br,submit,endform,pre($_),end_html
-1byte
#! perl -w
use CGI':all';@c=qw/white eeeeff/;$d=0;$e=path_info();$f=script_name;*p=*param;
$h=DELETE;$i=RENAME;$j=COPY;$k=FILES;opendir D,"./$e";if(p$h){unlink p$k}put
header,start_html('7files'),startform(0,$t),table(Tr([th({bgcolor=>ddddff},['',
qw/Name Size LastModified/]),(map{td({bgcolor=>$c[$d++%2]},[checkbox($k,0,$_,''
),g($_)." ".a({href=>"$f/$_"},$_),-s,"".localtime((stat)[9])])}sort{$a cmp $b}
grep/^[^.]/,readdir D)])),(map{submit$_}($i,$j,$h)),endform,end_html;sub g{$t=
-d$_[0]?'folder':'text';img{src=>"/icons/$t.gif",alt=>$t}}
ファイル削除 CgI あぱっち用
RENAME と COPY は未実装。もうちょっと痩せないとなぁ・・
WikiName のリンク処理(存在しないページのリンクは?に。
s|$w|(-f$1?'':$1).a{href=>$f.$1},-f$1?$1:'?'|eg;
>>89
Warning: fopen() expects at least 2 parameters, 1 given in ...
7wiki.cgi 、一旦まとめ。(w
#! perl
use CGI':all';$w='\b(([A-Z][a-z]+){2,})';($p)=(path_info||FrontPage)=~/$w/;$/=(
);$f=script_name."/";opendir D,".";if(open F,($m=param z)?">$p":$p){eval{flock
F,2};$_=CGI::escapeHTML($m||=<F>);eval{truncate F,0};seek F,0,0;print F$m;close
F}$_=pre($_).hr.ul map{li"".localtime((stat)[9]),$_}sort{-M$a<=>-M$b}grep/$w$/,
readdir D;s|$w|(!-f$1&&$1).a{href,$f.$1},-f$1?$1:"?"|eg;put header,start_html(
$p),h1($p),startform(0,$f.$p),textarea(z,$m,6,60),br,submit,endform,$_,end_html
・bare word が存在するので perl -w は不可。
・古い CGI.pm は escapeHTML を輸出しないので括弧が必要。
use CGI':all';$w='\b(([A-Z][a-z]+){2,})';$f=script_name."/";opendir D,".";$/=()
;($p)=(path_info||FrontPage)=~/$w/;if(open F,($m=param z)?">$p":$p){eval{flock
F,2};$_=submit.endform.hr.pre CGI::escapeHTML($m||=<F>);eval{truncate F,0};seek
F,0,0;print F$m;close F}$_=br.$_.hr.ul map{li"".localtime((stat)[9]),$_}sort{-M
$a<=>-M$b}grep/$w$/,readdir D;s|$w|(!-f$1&&$1).a{href,$f.$1},-f$1?$1:"?"|eg;put
header,start_html($p),h1($p),startform(0,$f.$p).textarea(z,$m,6,60),$_,end_html
-w は >>86 の環境では付けないとCGIとして動かなかったんだけど・・
どうしてだろう?z maybe crash って warning 出すのはわかっていたけど
ちゃんと動いていたような気がする。(エラーログ今度ちゃんと見て来よう。
TextRule に Pod::Htmlを使おうとしたが、
pod2html はファイルを対象としているため実装を断念。
残り一行じゃ TextRuleは辛いかな・・URLのリンクくらいなら追加出来そう・・? あっ バグ・・・今気付いた。
open が失敗した時困るかな >>92 >>88
アイコンと th 無くして、あと目に付いたトコだけザッと。
#! perl -w
use CGI':all';*p=*param;$d=path_info;$t=opendir D,".$d";$F=F;($c=$f=script_name
)=~s|/[^/]+$||;$R=REN;$C=CP;$D=DEL;p$D&&unlink p$F;put header,start_html(7files
),startform(0,$f),table(Tr[map{$i="$d/$_";($l,$s)=-d".$i"?($f.$i,'DIR'):($c.$i,
-s _);td({bgcolor,(white,eeeeff)[$t++%2]},[checkbox($F,0,$_,''),a({href,$l},$_)
,$s,"".localtime((stat)[9])])}sort grep!/^\./,readdir D]),(map{submit$_}$R,$C,
$D),endform,end_html >>94 修正…。
use CGI':all';($c=$f=script_name)=~s|/[^/]+$||;$d=path_info;$t=opendir D,".$d";
$F=F;$M=MV;$C=CP;$R=RM;*p=*param;p$D&&unlink p$F;put header,start_html('7files'
),startform(0,$f),table(Tr[map{$i="$d/$_";($l,$s)=-d".$i"?($f.$i,'DIR'):($c.$i,
-s _);td({bgcolor,(white,eeeeff)[$t++%2]},[checkbox($F,0,$_,''),a({href,$l},$_)
,$s,"".localtime((stat)[9])])}sort grep!/^\./,readdir D]),(map{submit$_}$M,$C,
$R),endform,end_html
>>92
成る程、そういう環境もありますか。
warning 吐きまくるのはヤだなぁと思っただけなんで、
shebang line は適宜変更でいいですかのぅ。
つか valid な HTML にはあまりこだわってませんか。
URL リンクはこうかな…。
s|(http://[\w!#-;=?-@~]+)|a{href,$1},$1|eg;
>>93
困りました。:)
>困りました。:)
ごめん。パズルに夢中でperl -cしかチェックしてなかったw
書きこみ、 新規ページ作成 テスト、以後気を付けます。テスト書こうっと
HTMLの構文チェックもしてません。出力はCGI.pm任せなので、
少なくともwelformedにはなってるはずだけど・・
7wiki.cgi 6行76桁
use CGI':all';$w='\b(([A-Z][a-z]+){2,})';$/=();$f=script_name;($p)=(path_info||
FrontPage)=~/$w/;opendir D,".";if(open F,($m=param z)?">$p":$p){eval{flock F,2}
;eval{truncate F,0};seek F,0,0;print F$m||=<F>;close F}$_=pre CGI::escapeHTML($
m).hr.ul map{li"".localtime((stat)[9]),$_}sort{-M$a<=>-M$b}grep/$w$/,readdir D;
s|$w|(!-f$1&&$1).a{href,"$f/$1"},-f$1?$1:"?"|eg;put header,start_html($p),h1($p
),startform(0,"$f/$p").textarea(z,$m,6,60),br,submit.endform.hr.$_,end_html
>>97
うん、well-formed ではあるけど、pre に hr や ul が入ってるから
valid じゃないよね。
別にいちゃもん付けてるんじゃ無くて、七行に収まってる状態で更に
数 byte の為に valid な出力を諦めるか否かは好みの問題だから、
何としても縮める方針でやってるのかな、と。挙動が変更されたコード
見たら、何を意図してるか大体分かるでしょ。
で、俺は shebang 込みで七行派だから、7wiki.cgi に関しては >>97 か
下ので完成気分。shebang 無し七行で続けるなら、それはそれで参加
させてもらうけどね。
#! perl -w
use CGI':all';$w='\b(([A-Z][a-z]+){2,})';$/=();$f=script_name;($p)=(path_info||
FrontPage)=~/$w/;opendir D,".";if(open F,($m=param z)?">$p":$p){eval{flock F,2}
;eval{truncate F,0};seek F,0,0;print F$m||=<F>;close F}$_=pre(CGI::escapeHTML($
m)).hr.ul map{li"".localtime((stat)[9]),$_}sort{-M$a<=>-M$b}grep/$w$/,readdir D
;s|$w|(!-f$1&&$1).a{href,"$f/$1"},-f$1?$1:"?"|eg;put header,start_html($p),h1($
p),startform(0,"$f/$p"),textarea(z,$m,6,60),br,submit,endform,hr,$_,end_html 7files.cgi
use CGI':all';*p=*param;($c=$f=script_name)=~s|/[^/]+$||;$d=path_info;opendir D
,$e=".$d/";sub cp{}$F=p(F);$N=$e.p(N);($_=p(S))=~/MV/?rename$F,$N:/CP/?cp$F,$N:
/RM/?unlink$F:0;put header,start_html('7files'),startform(0,"$f$d"),table(Tr[
map{$i="$d/$_";($l,$s)=-d".$i"?($f.$i,DIR):($c.$i,-s _);td({bgcolor,(silver,
white)[$t++%2]},[checkbox(F,0,".$i",''),a({href,$l},$_),$s,"".localtime((stat)[
9])])}sort grep!/^\./,readdir D]),textfield(N),map(submit(S,$_),MV,CP,RM),
endform,end_html
rename 実装。copy が悩み処ですな。
rename の仕方:
変更したいファイルにチェック、textfield に変更後の名前を入れて MV
>>98
お疲れ様 && ありがとう。色々と勉強になりました。
no strict で bare word 使い始めた当たりから
短くすることを優先させてました。use strictなしって時点で
すでに気持ち悪かったwので「汚くても動けばいいや」って感じだった
HTMLもチェックしていなかった位だから、当然拘っていませんでした
(HTMLは、7行って時点で最初から諦めていたかもしれない
ただ、valid な出力にするとなると、
CGI.pm の textarea が rows,colsの属性の値をクオートしない。
br, hr は、p,div,h[1-6] 等の親要素が必要
等々、新たな課題が出てくるんじゃないかな? 動作チェックしてないけど。
use File::Copy;
sub cp{ map{ -f$_&©($_,"copy_of_$_") }p(F) }
>>101
ありゃ。本当に全然拘ってなかったのね。w
なら 3 文字加えてピッタリ 6x79 。
use CGI':all';$w='\b(([A-Z][a-z]+){2,})';$/=();$f=script_name;($p)=(path_info||
FrontPage)=~/$w/;opendir D,".";if(open F,($m=param z)?">$p":$p){eval{flock F,2}
;eval{truncate F,0};seek F,0,0;print F$m||=<F>;close F}$_=pre(CGI::escapeHTML($
m)).hr.ul map{li"".localtime((stat)[9]),$_}sort{-M$a<=>-M$b}grep/$w$/,readdir D
;s|$w|(!-f$1&&$1).a{href,"$f/$1"},-f$1?$1:"?"|eg;put header,start_html($p),h1($
p),startform(0,"$f/$p"),p(textarea(z,$m,6,60),br,submit),endform,hr,$_,end_html
・hr はブロック要素なので無問題。
・form 内の各要素がインライン要素なので p で囲む。
・textarea の属性値クォートは 7wiki.cgi 側でなく CGI.pm 側の
問題だし、最近の CGI.pm なら直ってるので考えない。w
これでかなり valid. >>102
そか…モジュールという手が…。(´Д`;
use CGI':all';use File::Copy;$d=path_info;($c=$f=script_name)=~s|/[^/]+$||;*p=*
param;opendir D,$e=".$d/";$F=p(F);$N=$e.p(N);$w=($_=p(S))=~/MV/?rename$F,$N:/CP
/x?copy$F,$N:/RM/?unlink$F:1;put header,start_html('7files'),startform(0,"$f$d"
),table(Tr[map{$i="$d/$_";($l,$s)=-d".$i"?($f.$i,DIR):($c.$i,-s _);td({bgcolor,
(silver,white)[$t++%2]},[checkbox(F,0,".$i",''),a({href,$l},$_),$s,"".localtime
((stat)[9])])}sort grep!/^\./,readdir D]),textfield(N),map(submit(S,$_),MV,CP,
RM),endform,end_html
copy の仕方も rename と一緒。 > ありゃ。本当に全然拘ってなかったのね。w
えぇ。行末の桁揃えに夢中だったので。。w
use CGI':all';use File::Copy;$d=path_info;*p=*param;opendir D,$e=".$d/";$F=p(F)
;$N=$e.p(N);($_=p(S))=~/MV/?move$F,$N:/CP/?copy$F,$N:/RM/?unlink p(F):1;($c=$f=
script_name)=~s|/[^/]+$||;put header,start_html('7files'),startform(0,$f.$d),
table(Tr[map{$i="$d/$_";($l,$s)=-d".$i"?($f.$i,DIR):($c.$i,-s _);td({bgcolor,(
white,silver)[$t^=1]},[checkbox(F,0,".$i",''),a({href,$l},$_),$s,"".localtime((
stat)[9])])}sort grep!/^\./,readdir D]),textfield(N),map(submit(S,$_),MV,CP,RM)
,endform,end_html
- rename --> File::Copy#move に変更。
ファイルをチェックして、テキストにディレクトリ名を入れてMVで
ファイルをディレクトリに移動します。
= TODO
mkdir, rmdir
mkdir, rmdir 実装。特にヒネりもなく…。
use CGI':all';use File::Copy;$d=path_info;($c=$f=script_name)=~s|/[^/]+$||;*p=*
param;opendir D,$e=".$d/";$F=p(F);$N=$e.p(N);$_=p(S);/MV/?move$F,$N:/CP/?copy$F
,$N:/RM/?unlink$F:/MD/?mkdir$N,511:/RD/?rmdir$F:1;put header,start_html('7files
'),startform(0,$f.$d),table(Tr[map{$i="$d/$_";($l,$s)=-d".$i"?($f.$i,DIR):($c.$
i,-s _);td({bgcolor,(white,silver)[$t^=1]},[checkbox(F,0,".$i",''),a({href,$l},
$_),$s,"".localtime((stat)[9])])}sort grep!/^\./,readdir D]),textfield(N),map(
submit(S,$_),MV,CP,RM,MD,RD),endform,end_html
table を何とかせんと、劇的には縮まらな気。
bgcolorを削って、chdirにしてみた・・
use CGI':all';use File::Copy;$d=path_info;*p=*param;chdir".$d";$N=p N;$F=p F;$_
=p S;/MV/?move$F,$N:/CP/?copy$F,$N:/RM/?unlink$F:/MD/?mkdir$N,511:/RD/?rmdir$F:
1;opendir D,".";($c=$f=script_name)=~s|/[^/]+$||;put header,start_html('7files'
),startform(0,$f.$d),table(Tr[map{td[checkbox(F,0,$_,''),a({href,-d$_?"$f$d/$_"
:"$c$d/$_"},$_),-s||DIR,"".localtime((stat)[9])]}sort grep!/^\./,readdir D]),
textfield(N),map(submit(S,$_),MV,CP,RM,MD,RD),endform,end_html
p(F); を p F; って表記するのも環境/バージョンに依存するのかな?
give up 気味。(´Д`;
use CGI':all';use File::Copy;$d=path_info;*b=*param;chdir".$d";$N=b N;$F=b F;%m
=qw(MV move$F,$N CP copy$F,$N RM unlink$F MD mkdir$N,511 RD rmdir$F);eval$m{b S
};opendir D,".";($c=$f=script_name)=~s|/[^/]+$||;put header,start_html('7files'
),startform(0,$f.$d),table(Tr[map{td[checkbox(F,0,$_,''),a({href,(-d$_?$f:$c).
"$d/$_"},$_),-s||DIR,"".localtime((stat)[9])]}sort grep!/^\./,readdir D]),
textfield(N),(map{submit S,$_}keys%m),endform,end_html
param のエイリアスを b にしたのは、p 要素の p() を
使えるようにする為の布石。
> p(F); を p F; って表記
大丈夫っぽいです。
ディレクトリは別にサイズ取れない訳じゃないので
-s||DIR は駄目ですな…。
>109
Win/ActivePerlだとディレクトリのサイズ0が返ってきていた
これも環境に依存するのか。。 -d _?DIR:-s _ でok ?
use CGI':all';use File::Copy;$_='$d=path_info;*b=*param;chz".$d";$N=b N;$F=b F;
%m=qw(MV move$F,$N CP copy$F,$N RM unlink$F MD mkz$N,511 RD rmz$F);eval$m{b S}
;openz D,".";($c=$f=script_name)=~s|/[^/]+$||;put header,start_html("7files")
,startform(0,$f.$d),table(Tr[map{td[checkbox(F,0,$_,""),a({href,(-d$_?$f:$c)
."$d/$_"},$_),-d _?DIR:-s _,"".localtime((stat)[9])]}sort grep/^[^.]/,readz
D]),textfield(N),(map{submit S,$_}keys%m),endform,end_html';s/z/dir/g;eval
置換してスクリプト長くなってるし。。。そろそろ give up
>108 のファイルサイズを直して、完成かな
せっかくだから空ファイル作成 (MF) など付けてみる。
use CGI':all';use File::Copy;$d=path_info;*b=*param;chdir".$d";$N=b N;$F=b F;%m
=(qw(MV move$F,$N CP copy$F,$N RM unlink$F MD mkdir$N,511 RD rmdir$F MF),'open
F,">$N"');eval$m{b S};opendir D,".";($c=$f=script_name)=~s|/[^/]+$||;put header
,start_html("7files"),startform(0,$f.$d),table(Tr[map{td[checkbox(F,0,$_,""),a(
{href,(-d$_?$f:$c)."$d/$_"},$_),-d$_?DIR:-s,"".localtime((stat)[9])]}sort grep!
/^\./,readdir D]),p(textfield(N),map{submit S,$_}keys%m),endform,end_html
Rss出力と検索機能 4 7wiki.cgi
---- 7search.cgi
use CGI':all';$f=script_name;$s=param S;opendir D,".";if($s){map{$t=$_;if(open
F,$t){eval{flock F,2};while(<F>){chomp;if(/\Q$s\E/io){push(@r,li(a{href,$t},$t)
," - $_");last}}close F}}sort grep/^[^.]+$/,readdir D}put header,start_html(
'7search'),startform(0,$f),p(textfield(S),submit),endform,hr,ul(@r),end_html
---- 7rss.cgi
use CGI qw/:all channel item textinput link name/;($p)=script_name=~m|(.+)/[^/]
+$|x;$s=server_name.$p;opendir D,".";$w='7wiki';put"Content-type:text/xml\n\n",
qq|<?xml version="1.0"?>\n<rdf:RDF xmlns:rdf="http://www.w3c.org/1999/02/22-r|,
q|df-syntax-ns#" xmlns="http://my.netscape.com/rdf/simple/0.9/">|,channel(title
($w),link"$s/$w.cgi"),(map{item(title($_),link"$s.$_")."\n"}sort grep/^[^.]+$/,
readdir D),textinput(title($w),link("$s/7search.cgi"),name(S)),"\n</rdf:RDF>";
# CGI.pm v2.69 以降 or c2.67 wiz xhtml tag
- link() の動作がちょっと不安。 7rss.cgi
> item(title($_),link"$s.$_")."
< item(title($_),link"$s.cgi/$_")."
#7search.cgi - v0.02 fixed some bugs
use CGI':all';($c=$f=script_name)=~s|/[^/]+$||;$s=param S;if($s){opendir D,".";
map{$t=$_;if(open F,$t){eval{flock F,2};while(<F>){chomp;if(/\Q$s\E/io){push@r,
li(a({href,"$c/7wiki.cgi/$t"},$t)," $_");last}}close F}}sort grep/^[^.]+$/,
readdir D}put header,start_html('7search'),startform(0,$f),p(textfield(S),
submit),endform,hr,ul(@r),end_html
#7rss.cgi - v0.02 show latest 15 articles
use CGI qw/:all channel item textinput link name/;($p)=script_name=~m|(.+)/[^/]
+$|x;$s=server_name.$p;opendir D,".";$w='7wiki';put"Content-type:text/xml\n\n",
qq|<?xml version="1.0"?>\n<rdf:RDF xmlns:rdf="http://www.w3c.org/1999/02/22-r|,
q|df-syntax-ns#" xmlns="http://my.netscape.com/rdf/simple/0.9/">|,channel(title
($w),link"$s/$w.cgi"),(map{item title($_),link"$s.cgi/$_"}sort{-M$a<=>-M$b}grep
/^[^.]+$/,readdir D)[0..14],textinput(title($w),link("$s/7search.cgi"),name S),
"\n</rdf:RDF>";
# 7rss.cgi v0.03
use CGI qw/:all channel item textinput link name/;opendir D,".";$w='7wiki';($p)
=url=~m|^(.+)/[^/]+$|;put header('text/xml'),qq|<?xml version="1.0"?>\n<rdf:RD|
,'F xmlns:rdf="http://www.w3c.org/1999/02/22-rdf-syntax-ns#" xmlns="http://my.'
,'netscape.com/rdf/simple/0.9/">',channel(title($w),link"$p/$w.cgi"),(map{item
title($_),link"$p/$w.cgi/$_"}sort{-M$a<=>-M$b}grep/^[^.]+$/,readdir D)[0..14],
textinput(title($w),link("$p/7search.cgi"),name S),"\n</rdf:RDF>"; >>117
Take It free.
<一応、ベースとなるものを書いたモノです
自分が代表してレスしていいのかわかんないけど &&
このスレッド的にはどうなのか知らないけど・・・、
このまま過去ログに埋もれて日の目を見ないよりも、
公開して保守して貰えるのなら、そっちの方がいいよな
て事でお願いします。
ついでに、7rss, 7search も載せてもらえるとうれしいな。
package Year;sub new{bless{},shift} 忘れた頃に。(w
--- 7search.cgi
use CGI':all';put header,start_html('7search'),startform(0,$_=script_name),p(
textfield(S),submit),endform,hr;if($s=param S){m|/[^/]+$|;$c=$`;opendir D,".";
for(sort grep/^\w+$/&-f,readdir D){if(open F,$t=$_){eval{flock F,2};/\Q$s\E/io
&&push(@r,li(a({href,"$c/7wiki.cgi/$t"},$t)," $_"))&&next while<F>;}}@r&&put ul
@r}put end_html
--- 7rss.cgi
use CGI qw/:all channel item textinput link name/;opendir D,".";$w='7wiki';url
=~m|[^/]+$|;$p=$`;put header('text/xml'),join"\n",'<?xml version="1.0"?>',
'<rdf:RDF xmlns:rdf="http://www.w3c.org/1999/02/22-rdf-syntax-ns#" xmlns="http'
.'://my.netscape.com/rdf/simple/0.9/">',channel(title($w),link"$p$w.cgi"),(map{
item title($_),link"$p$w.cgi/$_"}sort{-M$a<=>-M$b}grep/^\w+$/&-f,readdir D)[0..
14],textinput(title($w),link($p.'7search.cgi'),name S),'</rdf:RDF>'
つー事で載せときました。 2ch の dat ファイル (かちゅ〜しゃのログ) を XHTML ファイルに変換。
http://cm.xrea.cc/kat2xhtml.shtml
$s="kat2xhtml.tmpl";sub a{'<a href="'.pop().'</a>'}sub p{'<span class="'.pop().
'</span>'}while(<>){($n,$m,$d,$_,$t,$")=split/,/;$.-1||($T=$t)=~s/\s+$//;$n=$n
=~m|^<b>([^<]*)</b>(?:([^<]*)<b></b>)?$|?p"n\">$1":'';$n.=p"m\">$2"if$2;$n=$m=~
/\@/?a"mailto:$m\">$n":$m=~/./?p qq|k" title="$m">$n|:$n;s/\x81\x97\x81\x4D/,/g
;s/\s+(?:target="_blank"|$)//g;s|\s*<br>|<br />|g;s/&(?![a-z]+;)/&/g;for(@r
=split/(<a href="[^"]+">[^<]+<\/a>)/){(($u,$a)=m|^<a href="([^"]+)">([^<]+)</a>
$|x)?($u=~s/~/%7E/g&&($_=a"$u\">$a"),$a=~/^>>(\d+)/&&($_=a"#R$1\">$a")):
s/"/"/g}$A.="<dt>$. :<a id=\"R$.\">$n :$d</a></dt><dd>@r</dd>\n"}if(open
T,$s){$/='';$_=<T>;s/\%(.)/${$1}/g;print}
機能減らさないと七行に収まらないかなぁ。 使い方わからなかったけど…(かちゅーしゃのログ持っていないので。
'<a href="'.pop().'</a>
↓
"a href=\"$_[0]</a>"
このスレの dat 上げといたんでテストする人はどぞ。
http://cm.xrea.cc/thread/1036141603.dat
>>122
@_ でもいいですね。
$s="kat2xhtml.tmpl";sub a{"<a href=\"@_</a>"}sub p{"<span class=\"@_</span>"}
while(<>){($n,$m,$d,$_,$t,$")=split/,/;$.-1||chomp($T=$t);$n=~m|<b>([^<]*)(?:
</b>([^<]*))?|x;$n=($1&&p"n\">$1").($2&&p"m\">$2");$n=p qq|k" title="$m">$n|if
$m.0;s/\x81\x97\x81\x4D/,/g;s/\s+(?:target="\w*"|$)//g;s|\s*<br>|<br />|g;s/&
(?![a-z]+;)/&/gx;for(@r=split/(<a href="[^"]+">[^<]+<\/a>)/){(($u,$a)=
/^<a href="([^"]+)">([^<]+)/)?($_=$u=~s/~/%7E/g?a"$u\">$a":$a=~/^(?:>){1,2}
(\d+)/x?a"#R$1\">$a":$_):s/"/"/g}$A.="<dt>$. :<a id=\"R$.\">$n :$d</a>".
"</dt><dd>@r</dd>\n"}if(open T,$s){$/='';$_=<T>;s/\%(.)/${$1}/g;print}
mailto: やめてあと一行。 俺も作ってみた。
2chモドキの掲示板です。ログファイル F が必要。
URLと、発言番号への自動リンクがありますが、使い物になるかどうか・・・。
Win98のPWSとLinuxのApacheで動作を確認しました。。。
------------ 7ch.cgi -----------------
#!/usr/bin/perl
use CGI':all';*i=*param;$n=i N;$m=i M;$t=i T;open F,'+<F';eval{flock F,2};1 for
<F>;$.++;if($t){$_=$t;s/</</g;$h='<a href=';s!(https?://.+?)$!$h$1>$1</a>!mg
;s!>>(\d+)!$h#$1>>>$1</a>!g;s/\n/br/eg;seek F,0,2;print F dt("$. :".b(a{href=>
$m?"mailto:$m":undef,name=>$.},$n||='名無しさん'),':'.localtime),(dd $_.br.br)
."\n"}seek F,0,0;*x=*textfield;print header(-charset=>''),start_html(-style=>'
body{background:#eee}b{color:green}').startform,dl(<F>),hr,submit('書き込む'),'
名前:',x(N),' E-mail:',x(M),br,textarea(T,'',5,70,1),endform.end_html;
--------------------
結構つかれた・・・。
>>128
日本語まともに表示できるようにしたら、URL リンク外してもはみだしちゃった。
#!/usr/bin/perl
use CGI':all';open F,'+<F';eval{flock F,2};[<F>];$.++;*i=*param;if($_=i T){s/<
/&lt;/gx;$h='<a href="';s!(&gt;&gt;\d+)!$h#R$1">$1</a>!g;s/\n/br/eg;$m=i M;seek
F,0,2;print F dt("$. :".b(a{name=>"R$.",$m&&(href=>"mailto:$m")},i(N)||
'名無しさん'),':'.localtime),dd($_.br.br),"\n"}*x=*textfield;$c='Shift_JIS';
seek F,0,0;put header(-charset=>$c),start_html(-encoding=>$c,-lang=>'ja',
-style=>'body{background:#eee}b{color:green}'),dl(<F>),hr,startform,p(submit(
'書き込む'),' 名前:',x(N),' E-mail:',x(M),br,textarea(T,'',5,70,1)),endform,
end_html
CGI.pm は 2.91 と 2.46 で確認。&を戻して使って下され。 収まった。
#!/usr/bin/perl
use CGI':all';open F,'+<F';[<F>];$.++;*i=*param;s!(&gt;&gt;)(\d+)!'<a href="#R'
."$2\">$1$2</a>"!eg,s/\n/br/eg,seek(F,0,2),eval{flock F,2},print F dt("$. :".b
(a{name,"R$.",($m=i M)&&(href,"mailto:$m")},i(N)||'nobodyさん'),':'.localtime)
,dd($_.br.br),"\n"if$_=escapeHTML i T;*x=*textfield;$c='Shift_JIS';seek F,0,0;
put header(-charset=>$c),start_html(-encoding=>$c,-lang=>'ja',-style=>'b{color:
green}body{background:#eee}'),dl(<F>),hr,startform,p(submit('書き込む'),' 名前'
.':',x(N),' E-mail:',x(M),br,textarea(T,'',5,70,1)),endform,end_html
escapeHTML 使ったから、CGI.pm v2.46 だと不可。
>>131
修正ありがとう!勉強になります。
httpへの自動リンクも入れてみたけど、p抜かしたりズルしてます。
【今後の課題】
・キャップもどき追加(s/#.*/crypt$&,'◆'/e)
・全角小文字のkが文字化けするバグ
use CGI':all';open F,'+<F';[<F>];$.++;*i=*param;s!>>(\d+)!a{href,"#R$1"},
$&!eg,s!https?://.+?$!a{href,$&},$&!emg,s/\n/br/eg,seek(F,0,2),eval{flock F,2},
print F dt("$. :".b(a{name,"R$.",($m=i M)&&(href,"mailto:$m")},i(N)||'nobody'.
'さん'),':'.localtime),dd($_.p),"\n"if$_=escapeHTML i T;*x=*textfield;seek F,0
,0;put header(-charset=>$c='Shift_JIS'),start_html({lang,'ja',encoding,$c,Style
,'b{color:#080}body{background:#eee}'}),dl(<F>),hr,startform,submit('書き込む')
,' 名前:',x(N),' E-mail:',x(M),br,textarea(T,'',6,70,1),endform,end_html すまそ。&置換するの忘れました。
use CGI':all';open F,'+<F';[<F>];$.++;*i=*param;s!&gt;&gt;(\d+)!a{href,"#R$1"},
$&!eg,s!https?://.+?$!a{href,$&},$&!emg,s/\n/br/eg,seek(F,0,2),eval{flock F,2},
print F dt("$. :".b(a{name,"R$.",($m=i M)&&(href,"mailto:$m")},i(N)||'nobody'.
'さん'),':'.localtime),dd($_.p),"\n"if$_=escapeHTML i T;*x=*textfield;seek F,0
,0;put header(-charset=>$c='Shift_JIS'),start_html({lang,'ja',encoding,$c,Style
,'b{color:#080}body{background:#eee}'}),dl(<F>),hr,startform,submit('書き込む')
,' 名前:',x(N),' E-mail:',x(M),br,textarea(T,'',6,70,1),endform,end_html
ライブラリをつかってよいのなら、主要な処理はライブラリに書けば数文字でかけますね。
>>135
個人的にはモジュール不可派だけど、WebProg だし
標準モジュールだけ使用可にした方が面白いものが
出てきそうな気がするのでそういう縛りで考えてるよ。 encoding をハズしてなんとかイけたよ。疲れた。
まとめ&使い方
・番号自動リンク( >>100 とか入力する)
・URL自動リンク(http://... 行末までリンク)
・キャップ(名前欄の # 以降をcryptします)
・EUC-JP で保存する(じゃないと文字化けする)
・&を&に置換する
・カレントに空ファイル F を作ること
------------------------------- 7ch.cgi
use CGI':all';open F,'+<F';[<F>];$.++;*i=*param;s!&gt;&gt;(\d+)!a{href,"#R$1"},
$&!eg,s!https?://.+?$!a{href,$&},$&!emg,s/\n/br/eg,seek(F,0,2),eval{flock F,2},
($n=i(N)||'nobodyさん')=~s/#.*/crypt$&,'◆'/e,print F dt("$. :".b(a{name,"R$."
,i(M)&&(href,'mailto:'.i M)},font{color,'green'},$n),':'.localtime),dd($_.p),"
"if$_=escapeHTML i T;seek F,0,0;*x=*textfield;put header(-charset=>'EUC-JP'),
start_html({lang,'ja',bgcolor,'#efefef'}).dl(<F>),startform,p(submit('書き込む'
),' 名前:',x(N),' E-mail:',x(M),br,textarea(T,'',6,70,1)),endform,end_html; >>137
・改行しないとレス番が2以上に増えない。
・Mozilla 1.3 だと font では色変わらんかったんで、CSS に戻し。
・> 一個でリンク。
use CGI':all';open F,'+<F';[<F>];seek F,0,2;*i=*param;s!&gt;(\d+)!a{href,"#R$1"
},$&!eg,s!https?://.+$!a{href,$&},$&!emg,s/\n/br/eg,eval{flock F,2},($n=i(N)||
'nobodyさん')=~s/#.+/crypt$&,'◆'/e,print F dt(++$.,':'.b(a{name,"R$.",i(M)&&(
href,'mailto:'.i M)},$n),':'.localtime),dd($_.p),"\n"if$_=escapeHTML i T;seek
F,0,0;*x=*textfield;put header(-charset=>'EUC-JP'),start_html({lang,ja,Style,
'b{color:#080}body{background:#eee}'}),dl(<F>),hr,startform,p(submit('書き込む'
),' 名前:',x(N),' E-mail:',x(M),br,textarea(T,'',6,70,1)),endform,end_html
>>130 での変更は HTML 的に正しくする為のものなんだけど
(文字コードや言語を指定するから化けずに済む)、そーゆーの
より「似せる」方を重視してるのかな? えぇと、みんななんか面白そうなコトやってるね。
俺も参加しよう思ったけど…読めない所が多いや。
>>142
過疎スレだから、分からんトコは*自分で調べた上で*
適宜質問してくれれば良いかと。 ━―━―━―━―━―━―━―━―━[JR山崎駅(^^)]━―━―━―━―━―━―━―━―━―
ポートスキャナー。
# portscan.pl
use Socket;$h=$ARGV[0];$p=--$ARGV[1];$e=$ARGV[2];$i=inet_aton($h)||die;print"ho
st $h\n\n";while($p++<$e){$f=1;for(1..2){$t=$f?"tcp":"udp";socket(S,PF_INET,
SOCK_STREAM,getprotobyname($t));print"$p $t\n"if connect(S,pack_sockaddr_in($p,
$i));close(S);$f=0}}
usage >peal portscan.pl [host] [start_port] [end_port]
ちなみに、エラーチェックもしてないし、socketらへんもかなり適当なので動かないかもしれますん。
そんときは自分で手を加えるなりして動くようにしてください。
縮まった。
# portscan.pl
use Socket;$h=$ARGV[0];$p=--$ARGV[1];$i=inet_aton $h||die;print"host $h\n\n";
while(++$p<$ARGV[2]){$f=1;for(1..2){socket S,PF_INET,SOCK_STREAM,getprotobyname
($f?"tcp":"udp");print"$p $t\n"if connect S,pack_sockaddr_in($p,$i);close S;$f=
0}}
>>145と同じ理由で動かないかもしれますん。
これ以上縮まらないヨカソ…。 言ってるそばから縮まった。
# portscan.pl
use Socket;@t=@ARGV;$p=--$t[1];$i=inet_aton $t[0]||die;print"host $t[0]\n\n";
while(++$p<$t[2]){$f=1;for(1..2){socket S,PF_INET,SOCK_STREAM,getprotobyname($f
?"tcp":"udp");print"$p $t\n"if connect S,pack_sockaddr_in($p,$i);close S;$f=0}}
use Socket;($h,$s,$e)=@ARGV;$i=inet_aton($h)||die;print"host $h\n\n";for$p($s..
$e){for('tcp','udp'){socket S,PF_INET,SOCK_STREAM,getprotobyname$_;print"$p $_
"if connect S,pack_sockaddr_in$p,$i;close S}}
#!/usr/local/bin/perl
print "Hello World!";
print "Hello World!";
print "Hello World!";
print "Hello World!";
print "Hello World!";
print "Hello World!";
__∧_∧_
|( ^^ )| <寝るぽ(^^)
|\⌒⌒⌒\
\ |⌒⌒⌒~| 山崎渉
~ ̄ ̄ ̄ ̄
∧_∧ ∧_∧
ピュ.ー ( ・3・) ( ^^ ) <これからも僕たちを応援して下さいね(^^)。
=〔~∪ ̄ ̄ ̄∪ ̄ ̄〕
= ◎――――――◎ 山崎渉&ぼるじょあ
(⌒V⌒)
│ ^ ^ │<これからも僕を応援して下さいね(^^)。
⊂| |つ
(_)(_) 山崎パン
山崎ばかりなのもナニなので kat2xhtml 更新。あと 10 byte ほどなんだが…。
$l='<a href="';sub a{"$l@_\">$a</a>"}sub p{"<span class=\"@_</span>"}while(<>){
($n,$m,$d,$_,$t,$")=split/[,\n]/;$.-1or$T=$t;$n=~m|<b>([^<]*)(</b>([^<]*))?|;$n
=($1&&p"n\">$1").($3&&p"m\">$3");$n=p qq|k" title="$m">$n|if$m.0;s/\x81\x97\x81
M/,/gx;s/\s+(target="\w*"|$)//g;s|\s*<br>|<br />|g;s/&(?!\w+;|\#\d+;)/&/g;(
($u,$a)=/^$l([^"]+)">([^<]+)/)?($_=$u=~s/~/%7E/g?a$u:$a=~/^(>){1,2}(\d+)/?a
"#R$2":$_):s/"/"/g for@r=split/($l[^"]+">[^<]+<\/a>)/;$A.="<dt>$. :<a id"
."=\"R$.\">$n :$d</a></dt><dd>@r</dd>\n"}open T,$/="$0.tmpl";$_=<T>;s/%(.)/${
$1}/g;print
・?xHHHH 形式の数値実体参照を諦め。
・テンプレートのファイル名を "$0.tmpl" に。
・説明やら入れたアーカイヴは http://cm.xrea.cc/ に。 ちょっと長くなったけど、初心者質問スレを荒らしている彼に捧げよう。(w
#--- br.p ---
package P;sub c{bless pop,pop}sub s{$_[0]->{s}}sub n{$_[0]->{n}}sub h{my($s,$c)
=@_;$c||return$s->{h};($s->{h}+=$c)>0or$s->{h}=0}sub b{my($s,$e)=@_;my@w=keys%{
$s->{w}};my$w=$w[int rand@w];print$s->n,' は ',$w," で攻撃!\n";my($d,$a)=@{$s->
{w}{$w}}{d,a};$d=(my$n=int rand 101)>$a?0:$n>$a/2?int($d/2)-$e->s:$n>$a/20?$d-
$e->s:$d;print$d<=0?"ミス!\n":($e->n,' に ',$d," ポイントのダメージ!\n");$e->h(
-$d)||print$e->n," を倒した!\n"}package main;sub p{splice@p,int rand@p,1}@p=map
P->c($_),@{do'./p.dat'};while(@p>1){my$o=p;my$d=p;print"\n",$o->n,':',$o->h,' '
,$d->n,':',$d->h,"\n";$o->b($d);push@p,$o;$d->h>0&&push@p,$d}print(shift(@p)->n
, " の 勝利!\n")
#--- p.dat ---
[{n=>'煽り',h=>400,s=>10,w=>{'キック'=>{d=>60,a=>60},'パンチ'=>{d=>20,a=>70},}}
,{n=>'荒らし',h=>300,s=>0,w=>{'キック'=>{d=>100,a=>60},'パンチ'=>{d=>40,a=>70}}
},{n=>'夏厨',h=>200,s=>20,w=>{'キック'=>{d=>80,a=>90},'パンチ'=>{d=>10,a=>100}}
}];
縮めて CGI プログラムにした。これで彼も満足だろう。
#--- br.cgi ---
#!/usr/local/bin/perl
use CGI':all';put header(-charset=>($c='EUC-JP')),start_html(-lang=>ja,-title=>
'B.R.',-encoding=>$c);@p=@{do'br.dat'};sub e{splice@p,int rand@p,1}while(@p>1){
*o=e;*d=e;put p"$o{N}:$o{H} $d{N}:$d{H}";@w=keys%{$o{W}};$w=$w[int rand@w];($p,
$a)=@{$o{W}{$w}}{D,A};put p("$o{N}は$wで攻撃!",(($p=($n=int rand 101)>$a?0:$n>
$a/2?int($p/2)-$d{S}:$n>$a/20?$p-$d{S}:$p)>0or$p=0)?"$d{N}に$pポイントのダメー"
.'ジ!':'ミス!');($d{H}-=$p)>0or put p"$d{N}を倒した!";push@p,\%o;$d{H}>0&&push
@p,\%d}put p(pop(@p)->{N}, 'の勝利!'),end_html
#--- br.dat ---
[
{N=>'煽り', H=>400,S=>10,W=>{'キック'=>{D=>60, A=>60},'パンチ'=>{D=>20,A=>70 }}},
{N=>'荒らし',H=>300,S=>0, W=>{'キック'=>{D=>100,A=>60},'パンチ'=>{D=>40,A=>70 }}},
{N=>'夏厨', H=>200,S=>20,W=>{'キック'=>{D=>80, A=>90},'パンチ'=>{D=>10,A=>100}}},
];
メッセージを削るという安直な方法で七行達成。
#!/usr/local/bin/perl
use CGI':all';put header(-charset=>($c='EUC-JP')),start_html -lang=>ja,-title=>
BR,-encoding=>$c;@p=@{do'br.dat'};while(@p>1){put p map"$_->{N}:$_->{H}",@p;*d=
splice@p,int rand@p,1;*o=$p[int rand@p];@w=keys%{$o{W}};($p,$a)=@{$o{W}{$w=$w[
int rand@w]}}{D,A};put p"$o{N}は$d{N}に$wで攻撃!",(($p=($n=int rand 100)>$a?0:
$n>$a/2?int($p/2)-$d{S}:$n>$a/20?$p-$d{S}:$p)>0or$p=0)?"$pダメージ!":'ミス!';(
$d{H}-=$p)>0?push@p,\%d:put p b"$d{N}を倒した!"}put p"$p[0]{N}の勝利!",end_html
「素早さ」を実装したいけど、どうも巧くない。
#--- br.dat ---
# 名前, 防御力, 体力, 素早さ(1〜99), [ [ 武器名, 攻撃力, 命中率(1〜99) ] ... ]
[
[ '煽り', 10, 300, 99, [['キック',60,50], ['パンチ',30,70]] ],
[ '荒らし', 0, 400, 50, [['キック',90,70], ['パンチ',40,80]] ],
[ '夏厨', 20, 200, 25, [['キック',80,90], ['パンチ',20,90]] ],
];
#--- br.cgi (素早さ実装版) ---
#!/usr/local/bin/perl
use CGI':all';put header(-charset=>($C='EUC-JP')),start_html -encoding=>$C,lang
,ja,title=>BR;@p=@{do'br.dat'};while($#p){put p map"[$_->[0]:$_->[2]]",@p;$N=0;
{for(0..$#p){int$c%(99/$p[$_][3])&&next;($N,*W)=@{*O=splice@p,$_,1}[0,4];($W,$D
,$A)=@{$W[rand@W]};last}$c=0if++$c>99;$N||redo}($n,$s)=@{*d=splice@p,rand@p,1};
put p"$Nは$nに$W!",(($D-=($i=rand 100)>$A?$D:$i>$A/2?int($D/2)+$s:$i>$A/20?$s:0
)>0or$D=0)?"$Dダメージ!":'ミス!';@p=sort{$b->[3]<=>$a->[3]}@p,\@O;($d[2]-=$D)>0
?@p=(\@d,@p):put p b"$nを倒した!"}put p"$Nの勝利!",end_html
#--- br.cgi (素早さ未実装版) ---
#!/usr/local/bin/perl
use CGI':all';put header(-charset=>($C='EUC-JP')),start_html -encoding=>$C,lang
,ja,title=>BR;@p=@{do'br.dat'};while($#p){put p map"[$_->[0]:$_->[2]]",@p;($N,
*W)=@{$p[-1]}[0,4];($W,$D,$A)=@{$W[rand@W]};($n,$s)=@{*d=splice@p,rand$#p,1};
put p"$Nは$nに$W!",(($D-=($i=rand 100)>$A?$D:$i>$A/2?int($D/2)+$s:$i>$A/20?$s:0
)>0or$D=0)?"$Dダメージ!":'ミス!';($d[2]-=$D)>0?push@p,\@d:put p b"$nを倒した!"}
put p"$Nの勝利!",end_html
$$_=1for"@ARGV"=~/\w/g;for('0019'..9999){my%c;$n=$_;next if$h{"@{[sort@v=/./g]}
"}++&&$o||$z&&/0/||$d&&(grep$c{$_}++,@v);O:for(map[@{[qw(+ - * /)]}[$_&3,$_>>2&
3,$_>>4&3]],0..63){@x=(@$_,@v);eval==10&&do{print"$n:$_\n";$c&&last O}for grep
s/(\d)/$x[$1]/g,qw/(304)1(526) ((304)15)26 30(41(526)) 30((415)26) (30(415))26/
}} 本家スレで出てた切符問題の CGI プログラム版。
選択された4つの数字のみを調べる。
#!/usr/local/bin/perl
use CGI':all';@n=param n;for(map[@{[qw(+ - * /)]}[$_&3,$_>>2&3,$_>>4&3]],0..63)
{@x=(@$_,@n);for$t(qw/(304)1(526) ((304)15)26 30(41(526)) 30((415)26)/,'(30(41'
.'5))26'){$_=$t;s/(\d)/$x[$1]/g;eval==10&&push@e,$_.br}}put header,start_html(
-title=>7410),startform(0,script_name),p(scrolling_list(qw(-name n -size 10),
-values=>[0..9])x4,submit),endform,p(@e),end_html
>>166 は 5.005_03 なら動いたけど 5.8.0 だと不可。 コマンドライン・CGI 両対応版。
#--- 7410.cgi ---
#!/usr/local/bin/perl
use CGI':all';sub e{for(map[@{[qw(+ - * /)]}[$_&3,$_>>2&3,$_>>4&3]],0..63){@x=(
@$_,@n);for$t(qw/(304)1(526) ((304)15)26 30(41(526)) 30((415)26) (30(415))26/){
$_=$t;s/(\d)/$x[$1]/g;eval==10&&do{$r?push@e,$_.br:print"$n:$_\n";$c&&return}}}
@e}if($r=$ENV{'REMOTE_ADDR'}){@n=param n;put header,start_html(-title=>7410),
startform(0,script_name),p(scrolling_list(qw(-name n -size 10 -values),[0..9])x
4,submit),endform,p(e),end_html}else{$$_=1for"@ARGV"=~/\w/g;$n=$_,$h{"@{[sort@n
=/./g]}"}++&&$o||$z&&/0/||$d&&do{my%c;grep$c{$_}++,@n}or e for'0019'..9999}
__END__
usage: ./7410.cgi [ -cdoz ]
-c : 1組の数字に対し1つの計算式のみ出力
-d : 同じ数字を使わない
-o : 1組の数字に対し1つの出現順序のみ出力
-z : 0を含めない 5.005_03 と 5.8.0 の両方でマジメにチェック & 縮め。
#!/usr/local/bin/perl
use CGI':all';sub e{my@e;for(0..63){@x=(@{[qw(+ - * /)]}[$_&3,$_>>2&3,$_>>4&3],
@n,param n);for$t(qw/(304)1(526) ((304)15)26 30(41(526)) 30((415)26)
(30(415))26/){$_=$t;s/(\d)/$x[$1]/g;10-eval or$r?push@e,$_.br:put("$n:$_\n"),$c
&&return}}@e}($r=$ENV{REMOTE_ADDR})?put(header,start_html(-title=>7410),
startform(0,script_name),p(scrolling_list(-values=>[0..9],name,n,size,10)x4,
submit),endform,p(e),end_html):do{$$_=1for"@ARGV"=~/\w/g;$n=$_,$h{"@{[sort@n=
/./g]}"}++&&$o||$z&&/0/||$d&&4>keys%{{map{$_,1}@n}}or e for'0019'..'9999'} #!/usr/bin/perl
use CGI':all';use File::Find;$n=param('n')||0;@i=split'/',path_info;shift@i;($y,
$m,$d)=grep{/^\d+$/}@i;$p=join'/',grep{/^\D+$/}@i;find sub{($f=$File::Find::name
)=~/\.txt$/and$e{$f}=-M},"./$p";put header,start_html;for((sort{$e{$a}<=>$e{$b}}
keys%e)[$n..$n+40]){($z,$x,$c)=(localtime(time-60*60*24*$e{$_}))[5,4,3];next if(
($y&&$y!=$z+1900)or($m&&$m!=$x+1)or($d&&$d!=$c)or!-f);s/^\.\///;open(F,$_)&&{
chomp($t=<F>),put(a({-href=>url."/$_"},h2 $t),<F>,hr,"\n"),close F}}put end_html
久しぶりに7行プログラミング。
PATH_INFOで指定できるのは、日付とカテゴリのみ。
月の指定は数字のみ可能。Decとかには未対応。
indexや他のFlavourは未実装。
リクエストの例
./7blosxom.cgi
./7blosxom.cgi/2003
./7blosxom.cgi/2003/11
./7blosxom.cgi/2003/11/30
./7blosxom.cgi/2003/11/foo
./7blosxom.cgi/2003/foo/bar
./7blosxom.cgi/foo/hoge.txt
PAGING 機能。意味なくつけてみたけど、いらないよぉな気がする。(TODO remove)
./7blosxom.cgi?n=10
./7blosxom.cgi?n=10/foo/2000
リクエスト例。例外
./7blosxom.cgi///// ... 何も指定しないのと同じ。
./7blosxom.cgi/2003/11/30/1/ ... 4つめ以降の数字は無視される。
./7blosxom.cgi/foo2/ ... 正規表現が手抜きな為、数字+文字の組合せは無視される。
訂正。HTML&&桁数間違えてた。
#!/usr/bin/perl
use CGI':all';use File::Find;@i=split'/',path_info;shift@i;($y,$m,$d)=grep/^\d+
$/x,@i;$p=join'/',grep{/^\D+$/}@i;find sub{($f=$File::Find::name)=~/\.txt$/and$
e{$f}=-M},"./$p";put header,start_html;for(sort{$e{$a}<=>$e{$b}}keys%e){($z,$x,
$c)=(localtime(time-86400*$e{$_}))[5,4,3];if(!(($y&&$y!=$z+1900)or($m&&$m!=$x+1
)or($d&&$d!=$c))&&-f&&open F,$_){s/^\.\///;chomp($t=<F>);put hr,h2 a({href,url.
"/$_"},$t),pre<F>,"\n";close F}}put end_html
- データ用のディレクトリをカレントディレクトリ以外に指定したい場合。
ln -s /home/your/data/path home とリンクを作り。
7blosxom.cgi/home とアクセスする。
それじゃ漏れも久々に投稿。
スレッド式掲示板です。
データ用ディレクトリ G が必要です。
---------------------- 7thread.cgi -----------------------
use CGI":all";charset"x-sjis";*i=*param;*e=*escapeHTML;chdir G;i B,$b,open F,">
$b"if($b=e(i S))&&!-e$b;$b||=i(B);*x=*textfield;open F,"+<$b";[<F>];seekF,0,2;s
!http://.+$!a{href,$&},$&!emg,s/\n/br/eg,$n=e(i N)||'七氏',print F dt(++$.,':'.
b(a{i(M)&&(href,'mailto:'.e(i M))},$n),':'.localtime),dd($_.p),"\n"if$_=e(i T);
seek F,0,0;put header,start_html($b),h1($b),startform,(i B)?dl(<F>).a{href,'?'}
,'一覧':ol(li[map{a{href,"?B=$_"},$_}sort{-A$a<=>-A$b}<*>]).hr.'スレ'.x(S),hidden
(B),br,submit,'名前',x(N),'MAIL',x(M),br,textarea(T,'',6,80,1),endform,end_html
------------------------------------------------------
モジュールありだったらいくらでも短くできるのでは?
#!/usr/bin/perl
#7blosxom.cgi
use CGI':all';use File::Find;($p,$y,$m,$d)=grep/^\D+$/,(@i=split'/',path_info),
grep/^\d+$/,@i;find sub{($f=$File::Find::name)=~/\.txt$/and $e{$f}=-M},"./$p";
put header,start_html;for(sort{$e{$a}<=>$e{$b}}keys%e){($c,$x,$z)=(localtime(
time-86400*$e{$_}))[3..5];if(!($y&&$y!=$z+1900||$m&&$m!=$x+1||$d&&$d!=$c)&&-f&&
open F,$_){s/^\.\///;chomp($t=<F>);put h2 a({href=>url."/$_"},$t),pre<F>,hr;
close F}}put end_html
__END__
変更点
< shift@i はいらなかった。
< [5,4,3] をスライスに変更。
< 変数をまとめて宣言。
>174
そうだね。過去ログを読めばわかる通り、それは人によって意見がわかれる所。標準モジュールはokとか。
自分は、モジュールを使っても既存のリソースの有り合わせでおもしろいものが出来ればいいなと思ってる。
wikiもCPANのWiki::関連のモジュールを使えば制限内でも、もっと機能追加出来そうだし。
ただし、短くするためにわざわざモジュールを作る気はなし。
>>175
h2タグの中にpreタグ(と本文)が入るのですが・・・
>>175
Blosxom 知らんかったので和訳サイト読みながらゴニョゴニョ中。
動作確認用の txt ファイルセット用意してくれたら嬉しい。日付と
中身が違うファイルを沢山作るのは結構ダルい。;) >>173
足したり引いたりしてみた。
use CGI":all";*i=*param;*x=*textfield;sub e{escapeHTML i(pop)}chdir G;-e($b=i(B
)||e S)or open F,">$b";open F,"+<$b";eval{flock F,2};[<F>];s!http://.+$!a{href,
$&},$&!eg,s/\n/br/eg,print F dt($.+1,':',b(a{href,'mailto:'.e M},e(N)||nobody),
':'.localtime),dd($_),"\n"if$_=e T;seek F,0,0;put header,start_html($b),
startform,$b?h1($b).dl(<F>).hidden(B,$b).a{href,'?'},list:ol(li[map{a{href,
"?B=$_"},$_}sort{-M$a<=>-M$b}<*>]).thread.x(S),br,submit,NAME,x(N),MAIL,x(M),br
,textarea(T,'',6,80,1),endform,end_html >>177
#!/usr/bin/perl
@c=('a'..'z','A'..'F');$t=time;sub j{join'',@c[$_[0]..$_[0]+2]}for(0..23){open(
T,'>'.($f=j($_).'.txt'))||die$!;print T j($_),"\n",j($_+3),"\n",j($_+6);utime(
$t,$t,$f)||die$!;$t-=25000}opendir(D,'.')||die$!;@f=grep!/^\./,sort readdir D;
$t=(stat$f[0])[9]-32000000;for(@f){open(S,$_)||die$!;s/^(\w+)/++$i.uc$1/e;open(
D,">$_")||die$!;print D map uc,<S>;utime$t,$t,$_;$t-=50000} 5.005_03 と 5.8.2 で確認。元より長くなったけど…。
#!/usr/bin/perl
use CGI':all';use File::Find;/^\d+$/?$y?$m?($d||=$_):($m=$_-1):($y=$_-1900):/\.
txt$/x?($f||=$_):length&&($c.="/$_")for split'/',path_info;find sub{($D,$M,$Y)=
(localtime($t=(stat)[9]))[3..5];$e{$File::Find::name}=$t if!($y&&$y-$Y)&&!($m&&
$m-$M)&&!($d&&$d-$D)&&(!$f||/^$f$/)&&/\.txt$/},".$c";put header,start_html;for(
sort{$e{$b}<=>$e{$a}}keys%e){open F,$_;s|\.||;chomp($h=<F>);put h2(a{href,url.
$_},$h),pre<F>,hr}put end_html
・数字は年・月・日としてこの順に拾われ、4つ目以降は無視
・数字のみのカテゴリ名は許されないが、含む事は可
・カテゴリは出現順に階層化されているものとして処理する
・".txt" が末尾に付くものはファイルとし、最初に現れたもののみ有効
例
./7blosxom.cgi
./7blosxom.cgi/2003
./7blosxom.cgi/2003/11
./7blosxom.cgi/2003/11/30
./7blosxom.cgi/foo
./7blosxom.cgi/hoge.txt
./7blosxom.cgi/foo/hoge.txt
./7blosxom.cgi/2003/foo/bar
./7blosxom.cgi/2003/foo/11/bar/30/fuga.txt
./7blosxom.cgi/fuga.txt/2003/////foo1/11////bar2/30
>>180
1月ダメじゃん…。
:($m=$_-1): => :($m=$_):
!($m&&$m-$M) => !($m&&$m-$M-1) >175 $p の指定に不具合あり。join忘れてた。
use CGI':all';use File::Find;$P=join'/',grep/^\D\w*$/,(@i=split'/',path_info);(
$Y,$M,$D)=grep/^\d+$/,@i;find sub{($d,$m,$y)=(localtime($t=(stat)[9]))[3..5];!(
!($Y&&$Y-$y-1900)&&!($M&&$M-$m-1)&&!($D&&$D-$d)&&/\.txt/&&(!$i[-1]||/^$i[-1]$/)
)or$e{$File::Find::name}=$t},"./$P";put header,start_html;for(sort{$e{$b}<=>$e{
$a}}keys%e){open F,$_;s/^\.//;chomp($h=<F>);put h2(a{href,url.$_},$h),pre<F>,hr
;close F}put end_html;
若干仕様変更。
- カテゴリ名は /^\D\w*$/
- ファイルの指定は、PATH_INFO の末尾のみ有効。
- findの対象はカレントディレクトリ以下のみ。(絶対パス指定できるのは、流石にちょっと
BTW,ファイルハンドルってスコープ抜けたら勝手にcloseされるんだっけ?perlって。
>182
テスト不十分だった。訂正
> $i[-1]!~/\.txt$/||/^$i[-1]$/
use CGI":all";*i=*param;*x=*textfield;sub e{escapeHTML i pop}sub l{a{href,pop},
pop}chdir G;-e($b=i(B)||e S)||open F,">$b";open F,"+<$b";eval{flock F,2};[<F>];
s!\w+://.+$!l$&,$&!eg,s/\n/br/eg,print F dt($.+1,':'.b(l e(N)||nobody,'mailto:'
.e M),':'.localtime),dd($_),"\n"if$_=e T;seek F,0,0;put header,start_html($b),
startform,$b?h1($b).dl(<F>).hidden(B,$b).l list,'?':ol(li[map{l$_,"?B=$_"}sort{
-M$a<=>-M$b}<*>]).thread.x(S),br,submit,NAME,x(N),MAIL,x(M),br,textarea(T,'',6,
80,1),endform,end_html
7thread.cgi l10n for Japanese :)
#!/usr/local/bin/perl
use CGI":all";*i=*param;*x=*textfield;sub e{escapeHTML i pop}sub l{a{href,pop},
pop}chdir G;-e($b=i(B)||e S)||open F,">$b";open F,"+<$b";eval{flock F,2};[<F>];
s!\w+://.+$!l$&,$&!eg,s/\n/br/eg,print F dt($.+1,':'.b(l e(N)||'ナナシ','mailto:'.
e M),':'.localtime),dd($_),"\n"if$_=e T;seek F,0,0;put header(-charset=>$c=
Shift_JIS),start_html(-title=>$b||$0,encoding,$c,lang,ja),startform,$b?h1($b).
dl(<F>).hidden(B,$b).l 'スレ','?':ol(li[map{l$_,"?B=$_"}sort{-M$a<=>-M$b}<*>]).'ス
レ'.x(S),br,submit,Name,x(N),Mail,x(M),br,textarea(T,'',6,80,1),endform,end_html
>>182
検証方法が思いつかず…。>スコープ抜けで close 7blosxom.cgi l10n for Japanese
start_html に -title=>$0 入れると7行に収まらなかった(苦)。
#!/usr/bin/perl
use CGI':all';use File::Find;($Y,$M,$D)=grep/^\d+$/,@i=path_info=~m|/([^/]+)|g;
$R=$i[-1]=~/\.txt$/?pop@i:'\.txt';find sub{($d,$m,$y)=(localtime($t=(stat)[9]))
[3..5];$e{$File::Find::name}=$t if!($Y&&$Y-$y-1900)&!($M&&$M-$m-1)&!($D&&$D-$d)
&/$R$/},$P=join('/','.',grep!/\.\.|^\d+$/,@i);put header(-charset=>$c='EUC-JP')
,start_html(-encoding=>$c,lang,ja);for(sort{$e{$b}<=>$e{$a}}keys%e){open F,$_;
s/^\.//;chomp($h=<F>);put h2(a{href,url.$_},$h),pre<F>,hr}put end_html
>>182
'..' さえ防いだら大丈夫な気も…
既に開かれてるファイルハンドルを open し直すと、開いていたファイルは
close されてから新しいファイルを open するので、close は明示しなくても
可な筈。
http://perldoc.com/perl5.8.0/pod/func/close.html >>186
ちと修正。
#!/usr/bin/perl
use CGI':all';use File::Find;($Y,$M,$D)=grep/^\d+$/,@i=path_info=~m|/([^/]+)|g;
$R=$i[-1]=~/\.txt$/?pop@i:'.txt';find sub{($d,$m,$y)=(localtime($t=(stat)[9]))[
3..5];$e{$File::Find::name}=$t if!($Y&&$Y-$y-1900)&!($M&&$M-$m-1)&!($D&&$D-$d)&
/\Q$R\E$/},join'/','.',grep!/\.\.|^\d+$/,@i;put header(-charset=>$c='EUC-JP'),
start_html(-encoding=>$c,lang,ja);for(sort{$e{$b}<=>$e{$a}}keys%e){open F,$_;
s/^\.//;chomp($h=<F>);put h2(a{href,url.$_},$h),pre<F>,hr}put end_html 皆、お疲れ〜。
元気っぽいですな。
>>185
7thread 修正どうもです。かなりいけてました。
charset()を使わないと、escapeHTMLで文字化けが起こりますね。(「機能」とか)
EUCにしようかとも思ったんだけど。
#!/usr/local/bin/perl
use CGI":all";charset$c=Shift_JIS;*i=*param;*x=*textfield;sub l{a{href,pop},pop
}sub e{escapeHTML i pop}chdir G;$b=e(B)||e S;open F,"+>>$b";flock F,2;[<F>];$t=
'スレッド';s!\w+://.+$!l$&,$&!emg,s/\n/br/eg,print F dt($.+1,':'.b(l e(N)||'七氏',
'mailto:'.e M),':'.gmtime),dd($_),"\n"if$_=e T;seek F,0,0;put header,start_html
(-title=>$b||$t,encoding,$c,lang,ja,style,[<DATA>]),startform,h1($b||$t),$b?dl(
<F>).hidden(B,$b).l $t,'?':ol(li[map{l$_,"?B=$_"}sort{-M$a<=>-M$b}<*>]).$t.x(S)
,br,submit,Name,x(N),Mail,x(M),br,textarea(T,'',7,80,1),endform,end_html
オオボケでした。
開発中のを送ってしまった。
こっちです。
use CGI":all";charset$c=Shift_JIS;*i=*param;*x=*textfield;sub l{a{href,pop},pop
}sub e{escapeHTML i pop}chdir G;$b=e(B)||e S;open F,"+>>$b";flock F,2;[<F>];$t=
'スレッド';s!\w+://.+$!l$&,$&!emg,s/\n/br/eg,print F dt($.+1,':'.b(l e(N)||'七氏',
'mailto:'.e M),':'.gmtime),dd($_),"\n"if$_=e T;seek F,0,0;put header,start_html
(-title=>$b||$t,encoding,$c,lang,ja),startform,h1($b||$t),$b?dl(<F>).hidden(B,
$b).l $t,'?':ol(li[map{l$_,"?B=$_"}sort{-M$a<=>-M$b}<*>]).$t.x(S),br,submit,
Name,x(N),Mail,x(M),br,textarea(T,'',7,80,1),endform,end_html
>>189
> charset()を使わないと、escapeHTMLで文字化け
あぁ、確かに ad hoc な事やってますな…。相変わらず CGI.pm はダサい。:<
#!/usr/bin/perl
use CGI":all";charset$c=Shift_JIS;*i=*param;*x=*textfield;sub l{a{href,pop},pop
}sub e{escapeHTML i pop}sub r{seek F,0,0}chdir G;($b=e(B)||e S)=~m![./]!&¨
open F,"+>>$b";flock F,2;r;[<F>];s!\w+://.+!l$&,$&!eg,s/\n/br/eg,print F dt($.+
1,':'.b(l e(N)||'七氏','mailto:'.e M),':'.localtime),dd($_),"\n"if$_=e T;r;$t=
'スレ';put header,start_html(-title=>$b||$t,encoding,$c,lang,ja),startform,$b?h1(
$b).dl(<F>).hidden(B,$b).l $t,'?':ol(li[map{l$_,"?B=$_"}sort{-M$a<=>-M$b}<*>]).
$t.x(S),br,submit,Name,x(N),Mail,x(M),br,textarea(T,'',7,80,1),endform,end_html
・レス番号が増えないのを fix 。
・スレタイに [./] は使用不可 (「../7thread.cgi」なんてスレ立てられると…) 。
・gmtime は流石にどうかと思う。
・上記改造のしわ寄せを h1 周りに。 7thread 差分
< *i=*param
< sub e{escape i pop}
> sub e{escape param pop}
> -title=>$b=($t='スレ')
>186 thx URL
なるほど、close省略出来たんだ。
FileHandle にはスコープは関係なかったね。IO::Fileと勘違いしてた。
blosxom ... 残り1行じゃFlavourは無理かなぁ
乙カレーっす。
7thread ログの形式を変えてみました。
今までのログは利用できません。
あと__DATA__以降にスタイルシートを指定できるようにしました。
#!/usr/bin/perl
use CGI":all";charset$c=Shift_JIS;*i=*param;*x=*textfield;sub l{a{href,pop},pop
}sub e($){escapeHTML i pop}chdir G;($F=e B||e S)=~m![./]!?die:open F,">>$F";$t=
'スレ';$d=e N||'七氏';flock F,2;s!\w+://.+!l$&,$&!eg,s/\n/br/eg,print F li(b(e M?
l$d,'mailto:'.e M:$d),localtime.p$_)if$_=e T;open F;$/='';put header,start_html
(-title=>$F||$t,-style=><DATA>,encoding,$c,lang,ja),startform,h1($F||$t),$F?ol(
<F>).hidden(B,$F).l $t,'?':ol(li[map{l$_,"?B=$_"}sort{-M$a<=>-M$b}<*>]).$t.x(S)
,br,submit,Name,x(N),Mail,x(M),br,textarea(T,'',7,80,1),endform,end_html
__DATA__
h1{color:red; font-size:140%;}
p {margin:0; padding:0.5em; background:#EEF;}
sage機能実装。大幅に機能削ってしまったのでbranch.
marge よろしく;-]
use CGI":all";charset$c='EUC-JP';sub l{a{href,pop},pop}chdir G;sub e{escapeHTML
param pop}$d=e(N)||'七氏';($F=e B)=~/[.\/]/?die:($u=($m=e M)=~/sage/?(stat($F))
[9]:0),open F,">>$F";flock F,2;s!\w+://.+!l$&,$&!eg,s/\n/br/eg,print F li(b($m?
l$d,'mailto:'.$m:$d),localtime.p$_)if$_=e T;$t='スレ';open F;$/='';*x=*textfield;
put header,start_html($F||$t),startform,h1($F||$t),$F?ol(<F>).hidden(B,$F).l$t,
'?':ol(li[map{l$_,"?B=$_"}sort{-M$a<=>-M$b}<*>]).$t.x(B),br,submit,Name,x(N),
Mail,x(M),br,textarea(T,'',7,80,1),endform,end_html;$u&&utime time,$u,$F
>>193
一引数の open で開き直すのはナイスですな。
start_html に -style を指定すると、外部 CSS への link 要素を吐く
(少なくとも CGI.pm 3.00 では) 。ので、style 要素に変更。
#!/usr/bin/perl
use CGI":all";sub l{a{href,pop},pop}sub e($){escapeHTML param pop}($C,$B,$S,$D)
=<DATA>;charset$C;chdir G;($F=e B||e S)=~m![./]!?die:open F,">>$F";flock F,2;s!
\w+://.+!l$&,$&!egx,s/\n/br/eg,print F li(b(e M?l e N||$D,'mailto:'.e M:e N||$D
),localtime.p$_)if$_=e T;*x=*textfield;open F;put header,start_html(-title=>$F
||$B,encoding,$C,lang,ja),style($S),startform,h1($F||$B),$F?ol(<F>).hidden(B,$F
).l Threads,'?':ol(li[map{l$_,"?B=$_"}sort{-M$a<=>-M$b}<*>]).NewThread.x(S),br,
submit,Name,x(N),Mail,x(M),br,textarea(T,'',7,80,1),endform,end_html
__DATA__
Shift_JIS
7ch
h1{color:red; font-size:140%;} p {margin:0; padding:0.5em; background:#EEF;}
七氏 >193
お疲れ様。取り急ぎ、動作報告します。
Perl5.8.2/CGI.pm3.00, Perl5.6.1/CGI.pm2.752で確認しました。
-style=<DATA> は、CGIpm/3.00ではlinkのhref属性に入ってしまう。
引数の型によってlink, styleの出力を区別してるらしい。see _style method in CGI.pm
古いバージョンのCGI.pmではxmlのencoding属性の指定は出来ない。
<body encoding="..." となるので特に影響はないけど。
>>194
*本当に下がる* sage 機能、無理矢理 merge 。:p
URL auto link が犠牲に。
#!/usr/bin/perl
use CGI":all";sub l{a{href,pop},pop}sub e($){escapeHTML param pop}($C,$B,$D,@S)
=<DATA>;charset$C;chdir G;($F=e B||e S)=~m![./]!?die:open F,">>$F";flock F,2;$s
=($m=e M)=~/sage/;*x=*textfield;s/\n/br/eg,print F li(b($m?l e N||$D,'mailto:'.
$m:e N||$D),localtime.p$_)if$_=e T;close F;$s&&utime 1,1,$F;open F;put header,
start_html(-title=>$F||$B,encoding,$C,lang,ja),style(@S),startform,h1($F||$B),
$F?ol(<F>).hidden(B,$F).l Top,'?':ol(li[map{l$_,"?B=$_"}sort{-M$a<=>-M$b}<*>]).
New.x(S),br,submit,Name,x(N),Mail,x(M),textarea(T,'',7,80,1),endform,end_html
__DATA__
Shift_JIS
7ch
七氏
h1 {color:red; font-size:140%;}
p {margin:0em; padding:0.5em; background:#EEF;}
utime は FreeBSD だとファイル閉じないと効かなかったです。
Win98SE だと開いたままいぢれたけど。 皆様。乙!
sage 機能いいですねぇ。
>>197
チェックありがとっす!
-style ってバージョンによって違ったんですね。
2.98でも確認できました。
修正版です。$/の定義はズルしてます。(w
#!/usr/bin/perl
use CGI":all";charset$c=Shift_JIS;*x=*textfield;sub l{a{href,pop},pop}sub e($){
escapeHTML param pop}chdir G;($F=e B||e S)=~m![./]!?die:open F,">>$F";$t=Thread
;$d=e N||NoName;flock F,2;s!.+://.+!l$&,$&!eg,s/\n/br/eg,print F li(b(e M?l$d,'
mailto:'.e M:$d),localtime.p$_)if$_=e T;open F;put$/=header,start_html(-style=>
{code=><DATA>},title=>$f=$F||"7$t",lang,ja,encoding,$c),startform,h1($f),$F?ol(
<F>).hidden(B,$F).l$t.List,'?':ol(li[map{l$_,"?B=$_"}sort{-M$a<=>-M$b}<*>]).New
.$t.x(S),div(submit,Name,x(N),Mail,x(M)),textarea(T,'',7,80,1),endform,end_html
__DATA__
h1{color:red; font-size:140%;}
p {margin:0; padding:0.5em; background:#EEF;}
b {color:green;}
a:hover{background:#FCC;}
input,textarea{margin:0 10px 0 2px;} マ板から誘導されました。
既出と承知しつつ、1行掲示板です。
一応、名前と本文両方がないとはじく機能と、投稿日付つき。
(4行目の $t[4]/$t[3] を $t[2]:$t[1] にすれば、手動リロードの
簡易チャットにもなります。名前毎回入れるの面倒だけど。笑)
ファイル名は lb.cgi、パーミッション755で置けばいきなり稼動可能です。
#!/usr/bin/perl
$l='log.dat';@t=localtime();$t[4]++;use CGI;$q=new CGI;$d=$q->param('n');
$e=$q->param('h');($d&&$e)and &g;&p;exit;sub g{&i;open F,">$l";flock(F,2);print
F "$t[4]/$t[3]:$d<BR>$e<HR>\n",@b;close F;}sub p{&i;print"Content-Type:text/h"
,"tml\n\n一行掲示板<FORM METHOD=POST ACTION=\"lb.cgi\" NAME=1>名前<INPUT TYPE="
,"TEXT SIZE=20 NAME=n><BR>本文<INPUT TYPE=TEXT SIZE=60 NAME=h><BR><INPUT TYPE="
,"SUBMIT VALUE=\"送信\"></FORM><HR>",@b;}sub i{open F,"$l";@b=<F>;close F;}
>>200
特にヒネりもなく縮め。
#!/usr/bin/perl
use CGI":all";*P=*param;-e($F='log.dat')||open F,">$F";if(P(n)&&P(h)){open F,
"+<$F";flock F,2;@b=<F>;@t=localtime;seek F,0,0;print F++$t[4],"/$t[3]:",P(n),
'<BR>',P(h),"<HR>\n",@b}open F;$I='<INPUT TYPE';print"Content-Type: text/html\n
一行掲示板<FORM METHOD=POST ACTION=\"$0\">名前$I=TEXT SIZE=20 NAME=n><BR>本文",
"$I=TEXT SIZE=60 NAME=h><BR>$I=SUBMIT VALUE=\"送信\"></FORM><HR>",<F>
過去の作品に出てくるテクや Perl の言語仕様をしっかり研究してから
次回作を作って見せて欲しいな。
ところで 7blosxom と 7thread と 7ch (>>128〜) 、参加作という事で
http://cm.xrea.cc/ に載せていいですか? >オリジナル作者各位
と言っても実際に載せるのは年越してからになると思いますが(苦)。 スレ汚し失礼。簡易telneted。ポート1029を使います。
use Socket;socket(SERVER,2,1,getprotobyname('tcp'));setsockopt(SERVER,
SOL_SOCKET,4,1);bind(SERVER,pack_sockaddr_in(1029,INADDR_ANY));listen(
SERVER,1);select(SERVER);$|=1;for(;;){accept(CLIENT,SERVER)
;select(CLIENT);$|=1;$cmd;print '$ ';while($c=getc(CLIENT)){if($c=~/\n$/){
print `$cmd`,"\n",'$ ';$cmd = '';}else{print $c;$cmd .= $c;}}close CLIENT}
>>201
7ch と 7thread のオリジナル作者です。
どうぞ載せてくださいませ。 >201
参加してたんだw。どぉも。一年ぶりです。
<- 7blosxomのプロトタイプ提供者(===7wiki)です。
> http://cm.xrea.cc/ に載せていいですか?
他にも幾つかストックあるので、公開時には掲載よろしくお願いします。m(_ _)m もっと詰めてからにしようと思ったけど、とりあえず公開します。後はよろしく:)
#!/usr/bin/perl
use CGI':all';$CGI::POST_MAX=1024*1000;chdir D;if($u=upload u){open F,">./$u"or
die;binmode F;while(read$u,$b,1024){print F$b}close F}@f=sort{-M$a<=>-M$b}<*>;(
($_=param d)&&grep/^$_$/,@f)?do{open F,$_;put header(-Content_length=>-s,
attachment=>$_,-type=>"application/octet-stream"),<F>}:do{put header,start_html
,start_multipart_form,filefield(u),submit,endform,hr,table({-border=>1},Tr[th([
qw/name size date/]),map{td([a({href,"?d=$_"},$_),-s,''.localtime((stat)[9])])}
@f]),end_html}
__END__
TODO
[ ] 保存するファイル名のチェック。 uploadされたphpやshtmlが実行されるのを防止,や../等の対策。
[*] 出力するファイル名のチェック。
[ ] binary ファイルの取扱。(for windows)
[ ] 他のブラウザへの対応。
>>202
term 関係はシステム依存度高くて鬼門でごわす。
#!/usr/bin/perl
use Socket;socket S,2,1,getprotobyname"tcp";setsockopt S,SOL_SOCKET,4,1;bind S,
sockaddr_in 1029,INADDR_ANY;listen S,1;{accept C,S;binmode C;select C;$|=1;$n=
"\r\n";print$p='$ ';while($_.=$c=getc C){if(s/[$n]+\x00//){/^exit$/&&last;s/\s+
\z//x for@o=`$_`;print join$n,'',@o,$p;$_=''}else{$c=~/[$n]/||print$c}}close C;
redo}
TeraTermPro → Win98SE (command.com) と
TeraTermPro → FreeBSD 4.x (tcsh) で動作する事を確認。
FreeBSD 上で telnet localhost 1029 は動作不能。
誰か残りの行で UNIX 系 OS 用のコード組み込んで下さい。:o) Socket関連も、環境に依存する定数があったと思う。
後、ls コマンドの実装。
環境
Linux NetKit0.17 telnet で動作確認。(line mode)
> env | grep TERMCAP
TERMCAP=SC|screen|VT 100/ANSI X3.64 virtual terminal:\
use Socket;socket S,PF_INET,SOCK_STREAM,getprotobyname'tcp';setsockopt S,
SOL_SOCKET,SO_REUSEADDR,1;bind S,sockaddr_in 1029,INADDR_ANY;listen S,1;{accept
C,S;binmode C;select C;$|=1;$n="\r\n";print$p='$ ';while($_.=getc C){if(length
==1){s/^[$n\x00]//}elsif(s/[$n]$//){/^exit$/&&last;(/^cd\s*(.*)/)?chdir$1:print
join$n,(map{s/[$n\z]//g;$_}`$_`),$p;$_=''}}close C;redo}
character mode では、local echoが返らなかった。
端末への対応、悪化してたりしたらゴメン(焦
PerlHoo(http://www.webreference.com/perl/xhoo/)です。
ディレクトリ型のリンク集。後1行がなかなか縮まらない >_<。
use CGI":all";$_='($p)=path_info=~m|^/*(.+?)/*$|;chdir("./$p")||die;@f=grep-d,
<*>;%F=(Url,U,Title,T);$F=".7hoo";if(@P=Ms/[\r\n]/ /g;$_}Mparam$_}(U,T,D)){open
F,">>$F";print F join"\t",@P,"\n"}put header,start_html,p(join" / ",(A},Home),M
A.($i.="/$_")},$_}split"/",$p),hr,(param 1)?(h2($p),startform(POST,url."/$p"),(
Mtextfield($F{$_},"",40),b$_,br}keys%F),textarea(D,"",3,40,1),br,submit,endform
):(table(Tr Mtd{valign,top},ul li[MA.($p?"/$p":"")."/$_"},$_}grep-d,@f[$_*15..$
_*15+14]]}(0..@f/15)),hr,(open(F,$F)&&M@N=split/\t/;h3(a{href,$N[0]},$N[1]),p$N
[2]}<F>)),hr,p(A."/$p?1=1"},Edit),end_html';s/M/map\{/g;s/A/a\{href,url/g;eval
__END__
リンクを登録すると、登録したカテゴリのディレクトリ内に .7hoo ファイルを生成します。
例: Home / foo / bar だと、./foo/bar/.7hoo に記録される。
データ・ファイルが各ディレクトリ毎に散らばるのでテスト利用の場合は注意してください。
データファイルの掃除にはシェル等から > find ./target_dir -name ".7hoo" -exec rm {} \;
# rules >1 >48
# モジュール/ライブラリに関して >46, >135 >136, >174 >175
# カウンター >8, >9, >10, >11
# SWFファイルからJPEGを取り出す >17
# 掲示板(1) >24 >43 >52
# 掲示板(2) >41 >42
# 2ch型掲示板 >55
# スレッド型掲示板 >53
# cgi-lib.po >40
# アクセス解析 >58 >62
# 7wiki.cgi >65 >66 >67 >68 >69 >70 >71 >74 >75 >76 >77 >78 >79 >80 >82 >83 >84 >85 >86 >87 >91 >92 >93 >96 >97 >98 >101 >103
# files.cgi ファイル・マネージャ >88 >94 >95 >99 >100 >102 >104 >105 >106 >107 >108 >109 >110 >111
# 7wiki.cgi 用 RSS出力 >112 >113 >114 >115 >119
# 7wiki.cgi 用 検索 >112 >114 >119
# kat2xhtml 2ch の dat ファイル (かちゅ〜しゃのログ) を XHTML ファイルに変換 >121 >122 >124 >158 >159
# 7ch >128 >130 >131 >132 >134 >137 >139
# portscan.pl >145 >147 >149 >150
# br.cgi >160 >161 >162 >163 >164
# 切符問題 >166 >167 >168 >169
# 7blosxom >170 >171 >172 >175 >180 >181 >182 >183 >186 >187
# 7thread >173 >178 >184 >185 >189 >190 >191 >193 >194 >195 >197 >198 >199
# 動作確認用ファイル生成 4 7blosxom >177 >179
# 掲示板(3) >200 >201
# telnetd >202 >206 >207
# 7uploader.cgi >205
# 7hoo (PerlHoo) >208
連投でうざかったらすみません。200で作った1行掲示板を
普通の掲示板に変更してみました。
#!/usr/bin/perl
$F='log.dat';$n='board.cgi';use CGI":all";*Q=*param;*f=*textfield;open F;@b[0..
18]=<F>;close F;if(Q(1)&&Q(2)){@t=localtime;$_=Q(2);s/\r\n/\n/g;s/\r|\n/<br>/g;
$a=(Q(3))?a({-href=>'mailto:'.Q(3)},Q(1)):Q(1);$_="[".++$t[4]."/$t[3] $t[2]:".
sprintf("%02d",$t[1])."] $a".br.$_.hr.$/;open F,">$F";flock F,2;print F $_,@b;}
print header(-charset=>Shift_JIS),"*けいじばん*",start_form(post,$n),"おなまえ"
,f(1),br,textarea(2,'',4,26),br,"めーる",f(3),submit('送信'),end_form,hr,$_,@b;
とりあえず、おまじない程度にShift_JIS(NN4対策)、本文が改行可能(Macの
改行コードも対応)、メール欄追加、日付+時間表示などの機能を付加して
ぴったり7行です。
//項目が全部ひらがななのは自サイトで使う用なので。苦笑
それと、2行目の$Fでログファイル名、$nで自ファイル名を変更可能。
3行目の先頭にある18を「最大ログ数にしたい数-2」に変更すれば
最大ログを設定できます。
● 最低限押さえるべきポイント for Perl
・識別子は全て一文字にする
・演算子の優先順位を把握して冗長な括弧を全て省く
・サブルーチンは頭の方で宣言して routine(); から括弧を省く
・ブロックの最後の文はセミコロンを省略できる ("main" ブロック然り)
● 基本縮めテクニック for Perl
・使用する関数に関してマニュアルを精読する :)
・bare word ([A-Za-z]\w*) を使ってクォートを省く
・長い名前の関数を複数回使うなら別名を作る (*P=*param;)
・特殊変数や暗黙の代入を積極的に使う
・(スカラー|リスト|ブール)コンテキストでの各挙動を意識する
● Tips for Perl
・同名のファイルハンドルを open し直すなら close は要らない (>>186 参照)
・最も短くかける無限ループは "{ ... ;redo}"
● 「使える」Web プログラムを目指す人に
・XSS 脆弱性に配慮する
・文字コードに依存する定数は外部へ追い出す
・「想定外の入力」でどのように誤作動するか確認する
・多機能より堅牢を
Tips を充実させたいところ。 Gj and thankU>213
僕もTipsをまとめようかなと思ってました。
7行スクリプト向けのTipsと実用的なTipsを混同すると、誤解する人が出てこないかな?
との杞憂もあり。パターン言語で、このTipsはどういった時に使えるとか、
Tipsが使える場合の背景や制約等を細かく書こうと思ってたんだけど。(現在作業中断中
indexだけでも書き出してみるかな。
paddingテクニック for perl
- ファイルハンドルの直前で改行すると 1 byte diet 出来る。(open後等)
- 正規表現内で改行する場合は x を付ける。
- 変数名はprefix($@%)と名前の間にスペース/改行を含んでも良い。
基本縮めテクニック for perl
- and or && || の使い分け。場合によっては前後の()を省略できる。
- コード全体を圧縮 $_='...';s/xxx/zzz/g;eval # 事例: DeCSS, 7Hoo
- There'sMoreThanOneWayToDoIt
既に書かかれたコードに捕らわれず、異なるアプローチで書き起こす事も忘れずに。
Common Tips for perl
- $foo ||= 10; # foo が 空もしくは0 なら 10 を代入。
縮めTips for CGI.pm
- use CGI":all"; で main:: にインポート。
- 別名が付けられている関数は短い方を利用。
-- start_form -> startform, end_form -> endform
- 環境変数を所得する関数が準備されている。
-- $ENV{'PATH_INFO'} -> path_info, referer 等。
- 独自tagを出力する関数を作る。 事例 >>122 7rss.cgi
- 自分自身のURL -> url, self_url
- 他。
大抵の機能はモジュールで提供してくれてるが、VERSIONの違いには注意。 ご自由に編集して下さい。(´ω`
http://cm.xrea.cc/techinfo.cgi
#--- 7memo.cgi ---
#!/usr/local/bin/perl
chdir"D";use CGI":all";charset$c='EUC-JP';($_)=path_info=~m|[^/]+|g;s/^\s+|[<>|
]|\s+$//g;tr/\x00-\x1F.\x7F/./;$F=length>2?escape CGI$_:Top;open F,($m=param w)
?">$F":$F;flock F,2;$/='';print F$m||=<F>;sub U($){unescape CGI@_}opendir D,'.'
;put header,start_html(-title=>U$F,lang,ja,encoding,$c),ul(map{li"".localtime((
stat)[9]),a{href,url."/$_"},U$_}sort grep!/^\./,readdir D),h1(U$F),startform(0,
url."/$F"),p(textarea(w,$m,25,70),submit),endform,end_html
__END__
7wiki を参考に色々いぢってみました。 >>215
/foo%5C..%5C..%5Cbar なんてのをそのまま Win 鯖で食うとヤバいかと。 ちょぼちょぼいぢり。
#!/usr/local/bin/perl
use CGI":all";sub d{chomp($_=<DATA>);$_}sub U($){unescape CGI@_}chdir d;charset
$c=d;$s=d;$_=path_info=~m|[^/]+|?$&:d;s/^\s+|\.+|\s+$/./g;$_=escape CGI$_;-d&&
die;open F,($m=param w)?">$_":$_;eval{flock F,2};$/='';print F$m||=<F>;opendir
D,'.';put header,start_html(-title=>U$F,lang,ja,encoding,$c),h1(U$F),startform(
0,url."/$F"),p(textarea(w,$m,20,70),submit$s),endform,ul(map{li"".localtime((
stat)[9]),a{href,url."/$_"},U$_}sort grep!/^\./,readdir D),end_html
__DATA__
data_dir
EUC-JP
save memo
Top Page Title
#!/usr/bin/perl
package Unit7;sub new{bless{},pop}*set_up=*tear_down=sub{};sub p{printf@_}sub
assert{my($s,$f,$m)=@_;++$s->{n};$f?++$s->{o}:p"%s:%d\t$m\n",(caller)[1,2]}sub
run{$s=shift;$N=$O=0;for(grep/^test/,keys%{ref($s)."::"}){$s->{n}=$s->{o}=0;$N
++;set_up$s;$s->$_;tear_down$s;p"$N ) $s->{o}/$s->{n}\t$_\n";$s->{n}-$s->{o}
or $O++}p"\nRun $N Tests. $O success.\n"}7
__END__
$s ... $self
$N ... test* メソッドの数
$o ... 成功したテストの数
$n ... サブテストの数
$o ... 成功したサブテストの数
Test::Unit::TestCase 相当のモジュールです。
メソッド名 set_up, tear_down, assert は、オリジナルのTest-Unitを意識してそのままにしています。
名前を併せたらTestRunner.pl で実行できるかな?と互換性を期待したけど、無理だった。
>>220 の使い方です。
- assert(bool, [message])
- set_up, tear_down は、他のTestUnit framework と同等。
- test runner は付いてないので、自分で実行しないといけない。->run;
new MyTest->run;
{package MyTest;
use base qw/Unit7/;
sub new { shift()->SUPER::new(@_) }
sub set_up { my($self)=@_; $self->{val} = 0 }
sub tear_down { my($self)=@_; undef $self->{val} }
sub test_foo {
my($self)=@_;
$self->assert(defined $self->{val}, "defined val");
$self->assert(!$self->{val}, "! val");
$self->assert(0==$self->{val}, "0 == val");
$self->assert('0' eq $self->{val}, "'0' eq val");
}
sub test_bar {
my($self)=@_;
$self->{val} = 1000;
$self->assert(1000 < $self->{val}, "1000 < val"); # failure
$self->assert(1000 <= $self->{val}, "1000 <= val");
$self->assert(1000 == $self->{val}, "1000 == val");
$self->assert(1000 > $self->{val}, "1000 > val"); # failure
$self->assert(1000 <= $self->{val}, "1000 >= val");
}
} >>220.diff
- $o ... 成功したテストの数
+ $O ... 成功したテストの数
>>221 の捕捉。
基底クラスを Test::Unit::TestCase に変更するとTestRunner.pl でも実行できます。
でも、Test::Unit::TestCase => Unit7の互換はなし。
>>216
ありがとう。早速使わせてもらってます。
>>218
()や{}の末尾では、引数の型宣言なしに弧省略出来たと思う。
nice tricky closure.
FP的なアプローチってコードの短縮に貢献出来るテクニック多いよね。
>>217
Windows 環境の事すっかり忘れてた。
でも、エンコードしなきゃ大丈夫じゃない? %5C >>222
PATH_INFO の挙動調べてみました。確認ブラウザは
IE 6.0.2800.1106 、Mozilla 1.5 、Opera 7.23
・AN HTTPD 1.42k
ピリオド直後の \ は / に変換され、パスとして最適化される。
より上位のディレクトリを指す事はできない。
/foo/bar../baz は 404 。/foo/bar.../baz は 403 。
環境変数 PATH_INFO には URI-unescape 済みの値が入っている。
・Apache 1.3.29 on FreeBSD
\ はそのまま渡され、パスとして最適化される。
より上位のディレクトリを指す事はできない。
/foo/bar../baz はそのまま渡される。
環境変数 PATH_INFO には URI-unescape 済みの値が入っている。
IIS は周りに無いので未調査。 これで一旦完成。
#!/usr/local/bin/perl
use CGI":all";sub U{unescape CGI@_}chomp(($d,$c,$s,$q,$_,@w)=<DATA>);chdir$d;$_
=$&if path_info=~m|[^/]+|;tr/\x00- \x7F/ /s;$_=escape CGI$_;-d&¨$/='';open
F,($w=param w)?">$_":$_;eval{flock F,2};print F$w||=<F>;opendir D,'.';charset$c
;put header,start_html(-title=>U($_),style=>$s,lang,ja,encoding,$c),ul(map{li""
.localtime((stat)[9]),a{href,url."/$_"},U$_}sort grep!/^\./,readdir D),h1(U$_),
startform(0,url."/$_"),p(textarea(w,$w,@w),submit$q),'</form>',end_html
__DATA__
data_dir
EUC-JP
http://example.com/path/to/your.css
save
Default Page Title
20
70 >>224
お疲れ様です。
使いやすいしいい感じ。 テクニックメモを基に既存プログラムのメンテ中。
・CGI.pm は最新版縛りで。
・日本語が通るように。
・改めて調べたら Win32 でもグロブ使えたのでそのように。
・XSS 脆弱性や open に渡す値の再確認。
7rss を RSS 0.91 仕様にしてみるテスト。
#!perl -w
use CGI qw/:all channel link language description item textinput name/;charset
$C='EUC-JP';$w='7wiki';url=~m|[^/]+$|;$p=$`;sub e{title($d=pop),description($d)
,link pop}put header('text/xml'),join"\n",'<?xml version="1.0" encoding="'.$C.
'"?>','<!DOCTYPE rss SYSTEM "http://my.netscape.com/publish/formats/rss-0.91.'.
'dtd">','<rss version="0.91">',channel(e("$p$w.cgi",$w),language(ja),(map{item
e"$p$w.cgi/$_",$_}sort{-M$a<=>-M$b}grep/^([A-Z][a-z]+){2,}$/&-f,<*>)[0..9],
textinput(title($w),link($p.'7search.cgi'),name S)),'</rss>' #!/usr/bin/perl
use CGI":all";charset$C=Shift_JIS;open F,'+<F';[<F>];seek F,0,2;*i=*param;s!>
;(\d+)!a{href,"#R$1"},$&!egx,s!https?://.+!a{href,$&},$&!eg,s/\n/br/eg,($n=i(N)
||'nobodyさん')=~s/#.+/crypt$1,'◆'/e,eval{flock F,2},print F dt(++$.,':'.b(a{
name,"R$.",i(M)&&(href,'mailto:'.i M)},$n),':'.localtime),dd($_.p),"\n"if$_=
escapeHTML i T;seek F,0,0;*x=*textfield;put$/=header,start_html(-style=>{code=>
<DATA>},Title=>'7ch',encoding,$C,lang,ja),dl(<F>),hr,startform,p(submit('書き'.
'込む'),' 名前:',x(N),' E-mail:',x(M),br,textarea T,'',6,70),endform,end_html
__DATA__
b { color:#080 }
body { background:#fff }
http://cm.xrea.cc/prog/7blosxom.shtml
仕様は >>182 辺りに。
テストファイル生成スクリプトも更新。
@c=('a'..'z','A'..'F');$t=time;$i=24;sub u{$t-=9**5;utime$t,$t,pop}sub j{join""
,@c[$_[0]..$_[0]+2]}while($i){open(T,'>'.($f=j(--$i).'.txt'))||die$!;print T j(
$i),"\n",j($i+3),"\n",j($i+6);close T;$t-=8**7if$i==13;u($f)||die$!}@f=sort
<*.txt>;$t=(stat$f[0])[9]-9**7;for(@f){open(S,$_)||die$!;s/(\w+)/uc($1).++$i/e;
open(D,">$_")||die$!;print D map uc,<S>;close D;u($_)||die$!} 激しく板違いなんですけど
for(@LOG){
my($no,$dammy)=split(/<>/,$_);
for(@LOG){
my($no2,$dammy)=split(/<>/,$_);
if($no eq "$no2"){
print "LOG";
for(@LOG){
my($no3,$dammy)=split(/<>/,$_);
if($no2 eq "$no3"){
print "LOG";
}
}
}
}
}
を一回のforルーチンで済ますことってできますか?
for(@LOG){
my($dammy,$no)=split(/<>/,$_);
for(@LOG){
my($dammy,$no2,$no3)=split(/<>/,$_);
if($no eq "$no3"){
print "LOG";
for(@LOG){
my($dammy,$no4,$no5)=split(/<>/,$_);
if($no2 eq "$no5"){
print "LOG";
}
}
}
}
}
間違えました。訂正しまつでつ。
>>234
コードを短くしたいという意図はわかるけど、
実用的なプログラムでは、ここに挙がっている様なテクニックは、
なるべく使わない方が良いよ。 #!/usr/bin/perl
require 'bbs.pl';
bbsmain();
3行で掲示板作ったぞ
転載
#!/usr/bin/perl -w
# 526-byte qrpff, Keith Winstein and Marc Horowitz <[email protected]>
# MPEG 2 PS VOB file on stdin -> descrambled output on stdout
# arguments: title key bytes in least to most-significant order
$_='while(read+STDIN,$_,2048){$a=29;$c=142;if((@a=unx"C*",$_)[20]&48){$h=5;
$_=unxb24,join"",@b=map{xB8,unxb8,chr($_^$a[--$h+84])}@ARGV;s/...$/1$&/;$d=
unxV,xb25,$_;$b=73;$e=256|(ord$b[4])<<9|ord$b[3];$d=$d>>8^($f=($t=255)&($d
>>12^$d>>4^$d^$d/8))<<17,$e=$e>>8^($t&($g=($q=$e>>14&7^$e)^$q*8^$q<<6))<<9
,$_=(map{$_%16or$t^=$c^=($m=(11,10,116,100,11,122,20,100)[$_/16%8])&110;$t
^=(72,@z=(64,72,$a^=12*($_%16-2?0:$m&17)),$b^=$_%64?12:0,@z)[$_%8]}(16..271))
[$_]^(($h>>=8)+=$f+(~$g&$t))for@a[128..$#a]}print+x"C*",@a}';s/x/pack+/g;eval 保守age。ついでに、あまり役に立ちそうにないTip
配列と配列サイズを同時に宣言
my $length_of_array = my @array = (1, 2, 3, 4, 5);
* Added 空投稿でPage削除
* Diet evalの{}外してみた。-1 byte
#!/usr/bin/perl -w
use CGI":all";charset$c='EUC-JP';$w='\b(([A-Z][a-z]+){2,})';$f=script_name;$/=(
);($p)=(path_info||FrontPage)=~/$w/;($m=param z)||unlink$p;if(open F,$m?">$p":$
p){eval flock F,2;print F$m||=<F>}$_=pre(escapeHTML$m).hr.ul map{li"".localtime
((stat)[9]),$_}sort{-M$a<=>-M$b}grep/^$w$/&-f,<*>;s|$w|(!-f$1&&$1).a{href,"$f/$
1"},-f$1?$1:"?"|eg;put header,start_html(-title=>$p,encoding,$c,lang,ja),h1($p)
,startform(0,"$f/$p"),p(textarea(z,$m,6,60),br,submit),endform,hr,$_,end_html
>>243
eval の {} は外せないですよ。
eval flock F,2; だと flock() の戻り値から成る文字列を eval する事に。
unlink の問題はあっちでも指摘されてますが。:o) 順番的には先に telnetd を何とかしたいけど、検証が大変なので後回し。
#!/usr/bin/perl
use CGI":all";sub v{open(F,pop)||die;binmode F}$CGI::POST_MAX=1024000;$/=\4096;
chdir D;%f=map{$_,[a({href,"?d=$_"},$_),-s,''.localtime((stat)[9])]}@f=sort{-M$
a<=>-M$b}<*>;$f{$f=upload f}or$f&&do{v">$f";print F$_ while<$f>;close F};$f{$F=
param d}?(v($F),put header(-type=>'application/octet-stream',Content_length,-s
$F,attachment,$F),<F>):put(header,start_html,start_multipart_form,filefield(f),
submit,endform,hr,table({border,1},Tr[th([qw/name size date/]),map{td$f{$_}}@f]
),end_html)
・windows 対応。
・既存ファイルへの上書きを防止。但し upload 後自力 reload が必要に。
ファイル名は連番や時刻等にする方が安心且つ楽かな。
>>244
あ、なるほど。それではevalの意味がなくなってしまう。
一応、事前に実験したんですが、検証方法が間違ってました。m(_ _)
フォローありがとうございます。
> unlink の問題はあっちでも指摘されてますが。:o)
あぁ、やってしまったぁ。試してくれた方ありがとう&&すみません。
ひとまず >>243は無効って事で、代案考えます。
ところで、ライセンスや掲載許可みたいな事を尋ねられたのだけど、
wiki, や blosxom, はオリジナルと同じ GPL って事でいいかな?
実際、7wikiはYukiWiki, 7blosxomは初期のblosxomを参考にしたので。
>>246
ライセンスやら何やらは原作者に尋ねるのがスジですが、初出が
2ch だけに連絡取り辛いですな。各スレで直接呼びかけるしか無いかも。
SevenLines で保守している作品については、各原作者と配布形態等を
逐一取り決めてはいないので、建前上あのような断り書きの縛りにして
います。拙作のは全部修正 BSD ライセンスで、アーカイヴにライセンス
文書も同梱してます。
ニーズがあるなら専用ドメイン取って、転送メールアドレスの提供ぐらいは
しますよん。:) >各原作者殿 # 重要な事を書き忘れました。
246==7wiki, 7files, 7search, 7rss, 7blosxom, 7Unit, 7uploader, 7hoo 原作です。
(当然だけど、オリジナルではなくこのスレの7行版の方の、です)
掲載許可に関しては、手間のかからない方法で「連絡不要」って事でいいかな?
連絡先作って貰っても、どれほど需要があるかは自分にもわからないので。
ライセンスについては、
#!/usr/bin/perl -w -- "License: http://www.gnu.org/licenses/gpl.txt"
で、どぉでしょう?GPL以外でもいいけど >ライセンスの件 ...
自分が叩き台を出したとは言え、成果物はこのスレで参加者皆のものなので
出来れば他の方の意見も伺っておきたいのですが。特に異論がなければ、
>>248通り連絡不要/GPLという事にしたいと思います。
# もしくは、保守して下さってるサイトの管理者さんにお任せ。m(_ _
# 7vote
use CGI':all';$p=POST;*P=*param;charset$c='EUC-JP';chdir V;($F)=P(f)=~/^(\d+)$/
;if(open F,"+<$F"){eval{flock F,2};$t=<F>;while(<F>){if(/^(.+)\t(\d+)$/){$D{$1}
=$2}}if(request_method==$p){($n=P(n))?$D{$n}||=1:($v=P(v))?$D{$v}++:0;seek F,0,
0;print F join("\n",$t,map{"$_\t$D{$_}"}keys%D)}}for(radio_group(v,[@K=sort{$D{
$b}<=>$D{$a}}keys%D])){$L{$K[$i++]}=$_}put header,start_html(title=>$t,encoding
,$c,lang,ja),h1($t),startform($p),table({},Tr[map{td["$L{$_}($D{$_})",hr{width
=>$D{$_}}]}@K]),hr,textfield(n),hidden(f,$F,force=>1),submit,endform,end_html
設定方法
1) ディレクトリV を作る。 mkdir V;chdir V
2) 題名を書いたファイルを作る。echo "What is your native language" > 00001 # ファイル名は番号で。
3) chmod 0666 00001 # 必要に応じてパーミッションの設定
./7vote.cgi?f=00001 # ブラウザからアクセス とりあえず 7wiki, 7files, 7search, 7rss, 7blosxom を GPL で
パッケージングしときました。README やライセンス文書の
和訳同梱までは手が回らなかったので、その辺はご希望が
あれば追々。
あー、ココに載せるにゃデカ目のファイルのやり取り用に
7uploader 改良して設置しますかのぅ(笑)。
7Unit, 7uploader, 7hoo もその内転載させてもらいますね。
7wiki と 7uploader 。どちらも shebang 無し七行ルールじゃないと辛いですな。
use CGI":all";charset$c='EUC-JP';$w='\b(([A-Z][a-z]+){2,})';$f=script_name;$/=(
);($p)=(path_info||FrontPage)=~/$w/;if(open F,($m=param z)?">$p":$p){eval{flock
F,2};print F$m||=<F>;close F}param(d)eq"D"&&unlink$p;$_=pre(escapeHTML$m).hr.ul
map{li"".localtime((stat)[9]),$_}sort{-M$a<=>-M$b}grep/^$w$/&-f,<*>;s|$w|(!-f$1
&&$1).a{href,"$f/$1"},-f$1?$1:"?"|eg;put header,start_html(-title=>$p,encoding,
$c,lang,ja),h1($p),startform(0,"$f/$p"),p(textarea(z,$m,6,60),br,map{submit d,$
_}Write,Delete),endform,hr,$_,end_html
・削除機能の実装案。
use CGI":all";$CGI::POST_MAX=1024000;$/=\4096;sub v{open(F,pop)||die;binmode F}
chdir D;if($f=upload f){$f=~/\.\w+$/;v">".time.$&;print F$_ while<$f>;close F}$
i++<20?push@f,$_:unlink for sort{-M$a<=>-M$b}<*>;($_=param d)?(v($_),put header
(-Content_length=>-s,attachment,$_,Type,'application/octet-stream'),<F>):put(
header,start_html,start_multipart_form,filefield(f),submit,endform,hr,table({
border,1},Tr[th([qw/name date size/]),map{td([a({href,"?d=$_"},$_),''.localtime
((stat)[9]),-s])}@f]),end_html)
・ファイル名を time に。
・最大保存数を設定可能に。
7wikiがすこし結城さんとかにとりあげられて話題になってるんですね。
>>251
7wiki 修正。
s/param(d)eq"D"/param(d)=~D/;
s/Delete/Del/; >>250
ありがとうございます。7voteもついでによろしく。
7hooがまだ8行なのを先に何とかしたいけど、他のドキュメント類も暇みて整理してみます。
# 7wiki 削除機能案 B ... POSTで空投稿のときページ削除
use CGI":all";charset$c='EUC-JP';$w='\b(([A-Z][a-z]+){2,})';$f=script_name;$/=(
);($p)=(path_info||FrontPage)=~$w;unlink$p if!($m=param z)&&request_method=~/PO
ST/x;(open F,$m?">$p":$p)&&eval{flock F,2},print F$m||=<F>;$_=pre(escapeHTML$m)
.hr.ul map{li"".localtime((stat)[9]),$_}sort{-M$a<=>-M$b}grep/^$w$/&-f,<*>;s
|$w|(!-f$1&&$1).a{href,"$f/$1"},-f$1?$1:"?"|eg;put header,start_html(-title=>$p
,encoding,$c,lang,ja),h1($p),startform(POST,"$f/$p"),p(textarea(z,$m,6,60),br,
submit),endform,hr,$_,end_html
後、削れそうなとこといったら、charset'utf-8'にしてencodingはデフォルトにする
位かな。不便になるけど。それでもShebang込7行はちょっと難しそぉ。 >>254
こっちの方がシンプルですな。微妙に縮め。
use CGI":all";charset$c="EUC-JP";$w='\b(([A-Z][a-z]+){2,})';$f=script_name;$/=(
);($p)=(path_info||FrontPage)=~/$w/;request_method=~PO&!($m=param z)&&unlink$p;
open(F,$m?">$p":$p),eval{flock F,2},print F$m||=<F>;$_=pre(escapeHTML$m).hr.ul
map{li"".localtime((stat)[9]),$_}sort{-M$a<=>-M$b}grep/^$w$/&-f,<*>;s|$w|(!-f$1
&&$1).a{href,"$f/$1"},-f$1?$1:"?"|eg;put header,start_html(-title=>$p,lang,ja,
encoding,$c),h1($p),startform(0,"$f/$p"),p(textarea(z,$m,6,60),br,submit),
endform,hr,$_,end_html charset "utf-8"; にしても XML 宣言の encoding は iso-8859-1 のままなので、
start_html の encoding は外せませんな…。(CGI.pm v3.04)
iso-8859-1 && en-US なら楽勝。
use CGI":all";$w='\b(([A-Z][a-z]+){2,})';$f=script_name;$/=();($p)=(path_info||
FrontPage)=~/$w/;request_method=~PO&!($m=param z)&&unlink$p;open(F,$m?">$p":$p)
,eval{flockF,2},print F$m||=<F>;$_=pre(escapeHTML$m).hr.ul map{li"".localtime((
stat)[9]),$_}sort{-M$a<=>-M$b}grep/^$w$/&-f,<*>;s|$w|(!-f$1&&$1).a{href,"$f/$1"
},-f$1?$1:"?"|eg;put header,start_html(-title=>$p),h1($p),startform(0,"$f/$p"),
p(textarea(z,$m,6,60),br,submit),endform,hr,$_,end_html
use CGI":all";charset$c="EUC-JP";($p=path_info||Home)=~s!^/+|/+$!!g;chdir("./".
$p)||die;$F='.7hoo';if(@p=map{param$_}U,T,D){s/\s/ /g for@p;open F,">>$F";eval{
flock F,2};$"="\t";print F"@p\n"}put header,start_html(-encoding=>$c,lang,ja,
Title,"7Hoo"),p(join" / ",map{a{href,url.($i.="/$_")},$_}split"/",$p),hr,ul(li[
map{a{href,url."/$p/$_"},$_}grep-d,<*>]),open(F)&&hr.dl(map{@N=split/\t/;dt(a{
href,$N[0]},b$N[1]),dd$N[2]}<F>),hr,startform(0,url."/$p"),p((map{textfield(
/(.)/,$_,40),br}Url,Title),textarea(D,"",3,40,1),br,submit,),endform,end_html
・l10n 。
・Home ディレクトリをスクリプトと同階層に用意。
・カテゴリの table をやめて ul 一つに。
・リンクリストを dl に。
・登録フォームを常に表示。
package Store7;sub E{$_=shift;s/\\/\\\\/g;s/'/\\'/g;$_}@ISA='Exporter';@EXPORT=
@EXPORT_OK=qw/store retrieve/;sub store{open my$o,">$_[1]";print$o ''.d($_[0]);
}sub retrieve{do$_[0]}sub d{my$f=shift;my$e=ref$f;$e eq'SCALAR'?"'".E($$f)."'":
$e eq'ARRAY'?'['.join(',',map{d($_)}@$f).']':$e eq'HASH'?'{'.join(',',map{my$k=
$_;$_="'".E($k)."'=>".d($f->{$k})}keys%$f).'}':"'".E($f)."'"};use Exporter;1
なんとか5行でStorable.pmと同じ使い方です(storeとretrieveだけ)。
store( \%hashとか\@array, 'data.txt' );
$hash_ref = retrieve('data.txt');
無造作に縮めてみる。
package Store7;@ISA=Exporter;@EXPORT=@EXPORT_OK=qw/store retrieve/;use Exporter
;sub E{$_=pop;s/(\\|')/\\$1/g;$_}sub d{my$e=ref(my$f=pop);$e eq 'SCALAR'?"'".E$
$f."'":$e eq 'ARRAY'?'['.join(',',map{d$_}@$f).']':$e eq 'HASH'?'{'.join(',',
map{"'".E($_)."'=>".d($f->{$_})}keys%$f).'}':"'".E($f)."'"}sub store{open my$o,
">$_[1]";print$o d($_[0])}sub retrieve{do$_[0]}
>>259
\->\\したあと、'->\'しなければいけないので、s/(\\|')/\\$1/g;はマズイっぽいです。 package Store7;use base Exporter;@EXPORT=qw/store retrieve/;sub retrieve{do$_[0
]}sub E{$_=pop;s/\\/\\\\/g;s/'/\\'/g;"'$_'"}sub d{my$e=ref(my$f=pop);"SCALAR"eq
$e?E$$f:"ARRAY"eq$e?"[".join(',',map{d($_)}@$f)."]":"HASH"eq$e?"{".join(',',map
{E($_),d($f->{$_})}keys%$f)."}":E$f}local*F;sub store{open F,">".pop;print F d
pop;close F}1
・明示的に close しないとバッファに溜まったデータが print されない為、
store 直後に retrieve できない。
・Perl 5.005_03 では do pop が出来なかったので、do $_[0] のままに。
>>262
>>1
一応こういうルールでやってます。
横79文字ってのは80文字-改行1文字ね。 新しいお題目なんだけど
七行ハーボット
ってどう?
最低限、カウンタ・人工無能・ミニゲームつきって事で。
accesslog.cgi - 7行アクセス解析。
SSIで埋め込むことで記録。例:<!--#exec cgi="accesslog.cgi"-->
データを見るときは http://○○/accesslog.cgi?20040304&MSIE 6
みたいにパラメータ’日付 & 検索文字列(省略可))を渡して呼び出します。
正直perl歴はまだ半年で、テクニック的なものは使えないのでこの程度です。
#! /usr/bin/perl
sub z{local(*z)=$_[0];$z=~s/^(\d)$/0$1/;}print"Content-Type:text/plain\n\n";%e=
%ENV;$q=$e{'QUERY_STRING'};($s,$n,$h,$d,$m,$y)=localtime;$y+=1900;$m++;z(*m);z(
*d);z(*h);z(*n);z(*s);if(!$q){open(F,">>$y$m$d.txt");print F
"$h$n$s<>$e{'REMOTE_ADDR'}<>$e{'HTTP_USER_AGENT'}<>$e{'HTTP_REFERER'}\n";}else{
($p,$k)=split(/&/,$q);open(F,"$p.txt");while(<F>){$c++;if($_=~/$k/){print;$t++;
}}print"\n全$c件/ヒット$t件\n";}close(F); >>266
初級者お断りとは言わないし、むしろどんどんコードを書き込んでほしい
けれど、http://cm.xrea.cc/techinfo.cgi は一通り読んでほしいな。
ハッシュキーのクォート、ブロック末のセミコロン、関数の括弧、暗黙の
代入が行われる変数 etc etc... 文法的に省略可能な部分が沢山残って
いるのはちょっとねぇ。
print"Content-Type: text/plain\n\n";if(($_,$k)=split/&/,$ENV{QUERY_STRING}){/^
\d{8}$/x&&open F,"$_.txt";($k?/\Q$k/:1)&&($t++,print)while<F>;print"\n全$.件/".
"ヒット$t件"}else{s/^\d$/0$&/for($s,$n,$h,$d,$m,$y)=localtime;$y+=1900;$m++;$m
=~s/^\d$/0$&/;open F,">>$y$m$d.txt";print F join('<>',"$h$n$s",@ENV{REMOTE_ADDR
,HTTP_USER_AGENT,HTTP_REFERER}),"\n"}
Perl の習熟度に自信がないなら、自力で何とか10行、ぐらいのサイズ
から載せてくれたら、スレの住人がよってたかって縮めるんじゃないかな。 しっかりと読みました。
>>267さんが短くしてくれたおかげで、妥協した機能がつけれました。
日付の範囲指定を可能にして、データをtab区切りで記録して
ファイルを表示するのではなくCSV(TSV)としてDLするようにしてみました。
#! /usr/bin/perl
print"Content-Disposition: attachment;filename=log.csv;\nContent-Type: text/t".
"ab-separated-values\n\n";if(($f,$t,$k)=split/&/,$ENV{QUERY_STRING}){for($f...$
t){/^\d{8}$/x&&open F,"$_.txt";($k?/\Q$k/:1)&&(print)while<F>}}else{s/^\d$/0$&/
for($s,$n,$h,$d,$m,$y)=localtime;$y+=1900;$m++;$m=~s/^\d$/0$&/;open F,">>$y$m".
"$d.txt";print F join("\t",$h,$n,$s,@ENV{REMOTE_ADDR,HTTP_USER_AGENT,
HTTP_REFERER}),"\n"}
>>267さんのにただ付け足した感じです。
それでも、たった一日でものすごい勉強になりました。 息抜きにテキストカウンタ。お題がお題なので、今日/昨日/総計のカウントと、
ランダムワード表示機能付けてまだ一行余ってるけど。
--- 7rwcntr.cgi ---
#!/usr/bin/perl
sub P{seek local*F=pop,0,0;print F@_}sub o{open(local*F,"+<@_")||die;eval{flock
F,2};*F}sub j{(localtime((stat pop)[9]))[3]}$l=@l=<$_>,chomp($r.=$l[rand$l])for
map{o$_}sort<?.dat>;$A=o"all.dat";$a=<$A>+1;j($T=o"tday.dat")==j($Y=o"yday.dat"
)?do{P$t=<$T>+1,$T;$y=<$Y>}:do{P$y=<$T>,$Y;P$t=1,$T};P$a,$A;$s=@ARGV?javascript
:plain;printf"Content-Type: text/$s\n\n".join('',<DATA>),$r,$a,$t,$y
__END__
空ファイル all.dat, tday.dat, yday.dat を予め用意。
?.dat というファイルがあると、そのファイルから一行ランダムに選んで表示。
?.dat が複数あった場合は、各ファイルからランダムに取り出して繋げて表示。
例えば 0.dat に人名、1.dat に場所、2.dat に行動のリストをそれぞれ用意
しておけば、「誰々が何処で何々」のようなランダム文を表示します。
● SSI での使用
__END__ トークン以下に
%s<br />all:%06d today:%03d yesterday:%03d
HTML ファイルの body 要素内に
<!--#include virtual="/cgi-bin/7rwcntr.cgi"-->
● JavaScript 経由で CGI プログラムとして使用
__END__ トークン以下に
function writeCount() {
document.write("%s<br />all:%06d today:%03d yesterday:%03d");
}
HTML ファイルの header 要素内に
<script src="/cgi-bin/7rwcntr.cgi?1" type="text/javascript"></script>
body 要素内に
<script type="text/javascript"><!--
writeCount();
//-->
</script>
日付切替部分修正。
sub P{seek local*F=pop,0,0;print F@_}sub o{open(local*F,"+<@_")||die;eval{flock
F,2};*F}$l=@l=<$_>,chomp($r.=$l[rand$l])for map{o$_}sort<?.dat>;$T=o"tday.dat";
$Y=o"yday.dat";$A=o"all.dat";$a=<$A>+1;(localtime)[3]-(localtime((stat$Y)[9]))[
3]?do{P$y=<$T>,$Y;P$t=1,$T}:do{P$t=<$T>+1,$T;$y=<$Y>};P$a,$A;$s=@ARGV?
javascript:plain;printf"Content-Type: text/$s\n\n".join('',<DATA>),$r,$a,$t,$y
sub o{open(F,"+<@_")?eval{flock F,2}:die;<F>}($a,$t,$y,$l)=split/\t/,o"cnt.dat"
;dbmopen%r,remote,420or die;if(time-$r{$r="@ENV{REMOTE_ADDR,HTTP_USER_AGENT}"}>
3600&&$r ne$l){$y=$t,$t=0if(localtime)[3]-(localtime((stat F)[9]))[3];seek F,0,
0;print F join"\t",++$a,++$t,$y,$r;eval{truncate F,tell F}}$r{$r}=time;chomp($w
.=$l[rand(@l=o$_)])for sort<?.dat>;$/=@ARGV?javascript:plain;printf
"Content-Type: text/$/\n\n".<DATA>,$w,$a,$t,$y
・カウンタファイル三つを cnt.dat 一つに統合。
・重複カウント防止。(一時間以内と直前)
use CGI":all";charset$c="EUC-JP";$w='\b(([A-Z][a-z]+){2,})';$f=script_name;$/=(
);($p)=path_info=~/$w/;$p||=FrontPage;request_method=~PO&!($m=param z)&&unlink$
p;open F,$m?">$p":$p;eval{flock F,2};print F$m||=<F>;$_=pre(escapeHTML$m).hr.ul
map{li"".localtime((stat)[9]),$_}sort{-M$a<=>-M$b}grep/^$w$/&-f,<*>;s|$w|(!-f$1
&&$1).a{href,"$f/$1"},-f _?$1:"?"|eg;put header,start_html(-title=>$p,encoding,
$c,lang,ja),h1($p),startform(0,"$f/$p"),p(textarea(z,$m,6,60),br,submit),
endform,hr,$_,end_html
・「〜/7wiki.cgi/」に対応。
use CGI":all";$CGI::POST_MAX=1024000;$/=\4096;chdir D;sub v{open(F,pop)?binmode
F:die}if($f=upload f){$f=~/\.\w+$/;v">".time.$&;print F$_ while<$f>;close F}++$
i<51?push@f,$_:unlink for sort{$b<=>$a}<*>;($_=param d)?(v($_),put header(-type
=>'application/octet-stream',Content_length,-s,attachment,$_),<F>):put(header,
start_html,start_multipart_form,filefield(f),submit,endform,table({border,1},Tr
[th([Name,Date,Size]),map{td[a({href,"?d=$_"},$_),''.localtime((stat)[9]),-s]}
@f]),end_html)
・縮め。
use CGI":all";charset$c="EUC-JP";($p=path_info||Home)=~s!^/+|/+$!!g;chdir"./$p"
||die;$F='.7hoo';s/\s/ /g for@p=map{param$_}U,T,D;open(F,">>$F"),eval{flock F,2
},$"="\t",print F"@p\n"if@p;sub A{a{href,url.pop},$_}sub e{escapeHTML@N[@_]}put
header,start_html(-title=>"7Hoo",encoding,$c,lang,ja),p(join" / ",map{A$i.="/".
$_}split"/",$p),ul(li[map{A"/$p/$_"}grep-d,<*>]),open(F)&&hr.dl(map{@N=split/\t
/x;dt(a{href,$N[0]},b e 1),dd e 2}<F>),hr,startform(0,url."/$p"),p(join br,(map
{textfield/(.)/,$_,40}Url,Title),textarea(D,"",3,40,1),submit),endform,end_html
・XSS 脆弱性の fix
>>274-276 の三つ、問題無いようでしたらサイトに載せます。
7uploader と 7Hoo は仕様や出力を随分いぢってしまったので、
軌道修正もお願いします。(w >原作者殿
作業用のアップローダ用意しましたので、ファイルの受け渡しに
ご利用下さい。 http://cm.xrea.cc/upload.cgi
TODO: 7rwcntr > telnetd > Unit7 > Store7 > 7vote
telnetd と accesslog.cgi は 202 さんと 266 さんに掲載許可を
頂け次第サイトに載せようと思ってますので、適用ライセンス等
ご連絡下されば幸いです。 #! /usr/bin/perl
sub r{$r=$_[0]?"tab-separated-values\nContent-Disposition: attachment;filenam".
"e=log.csv":"plain";print"Content-Type: text/$r\n\n"}if(($a,$f,$t,$k)=split/&/,
$ENV{QUERY_STRING}){r $a;for($f...$t){/^\d{8}$/x&&open F,"$_.txt";($k?/\Q$k/:1)
&&(print)while<F>}}else{r;s/^\d$/0$&/for($s,$n,$h,$d,$m,$y)=localtime;$y+=1900;
$m++;$m=~s/^\d$/0$&/;open F,">>$y$m$d.txt";print F join("\t",$h,$n,$s,@ENV{
REQUEST_URI,REMOTE_ADDR,HTTP_USER_AGENT,HTTP_REFERER}),"\n"}
>>266です。
>>268はアクセスログ記録モードで呼び出したときもCSVのダウンロードダイアログが出る
という致命的なバグがありました。すみません。
バグ修正と、さらにパラメータで画面に表示/ダウンロードを選択できるようにしました。
また、REQUEST_URIも記録するようにしたので、サイト全体の解析にも使えるようになったと思います。
スクリプト名は他にあわせて、7accesslog.cgi と変更しようと思います。
こんなので掲載していただけるのであれば是非お願いします。
このスレのおかげで完成したと思っているので、私としては権利等の主張をする
つもりはありませんのでGPLあたりの他のスクリプト同様のライセンスにしてください。
■使用法
・記録時はSSI等で呼び出します。>>271さんみたいにJavaScriptでも呼び出せそうな気はします。
・表示およびダウンロード時はパラメータをつけて普通に呼び出します。
パラメータなし アクセスログを記録。
日付.txt に 時,分,秒,REQUEST_URI,REMOTE_ADDR,HTTP_USER_AGENT,HTTP_REFERER を記録します。
パラメータあり アクセスログを表示/ダウンロード
第1パラメータ ・・・ 0:表示 1:ダウンロード
第2パラメータ ・・・ ログの取得開始日(yyyymmdd)
第3パラメータ ・・・ ログの取得終了日(yyyymmdd)
第4パラメータ ・・・ ログ取得時の絞込みキーワード(省略すると全件取得)
(例) http://hoge.com/7accesslog.cgi?1&20040301&20040331&MSIE
この例では、2004年3月1日〜2004年3月31日までの「MSIE」を含むログがダウンロードされます。 ($a,$f,$t,$k)=@ARGV;print"Content-Type: text/",!$a?plain:"tab-separated-values
Content-Disposition: attachment;filename=log.csv","\n\n";$k=~s/%([\da-f]{2})/
pack"H2",$1/egi;$f?do{/^\d{8}$/&&(open(F,"$_.txt"),print grep$k?/\Q$k/o:1,<F>)
for$f..$t||$f}:do{s/^\d$/0$&/for($s,$n,$h,$d,$m,$y)=localtime;$y+=1900;$m++;$m
=~s/^\d$/0$&/;open F,">>$y$m$d.txt";print F join("\t",$h,$n,$s,
@ENV{REQUEST_URI,REMOTE_ADDR,HTTP_USER_AGENT,HTTP_REFERER}),"\n"}
・検索ワードを URI-unescape
・第 3 引数を省略可能に
・パラメータをクエリ渡しから引数渡しへ
(例)
http://hoge.com/7accesslog.cgi?1+20040301+20040331+MSIE%205
http://hoge.com/7accesslog.cgi?1+20040301 >7accesslog
for で $f..$t ってやると、月や年をまたいだ時、
無駄なファイルオープン(できないやつ)が多発するので
そこをなんとかしたいです・・・。
ヘタレな私にはいい方法が思いつきませんが。
>>280
・効率的な生成アルゴリズムを Web や本から探す。
・思いつくまま色々書いて試す。
・文字数を食っている機能を捨てる。
・緩めのルール (shebang 無し 7 行 & モジュール可) で挑戦する。
とにかく足掻いて形にするのが大事。 >>277
202です。 ライセンスとかようわからないですが、telnetdとStore7はほかのと同じようにして置いていただければ結構です。 ($a,$f,$t,$k)=@ARGV;$k=~s/%([\da-f]{2})/pack"H2",$1/egi;$l=$f.($t?"-$t":"").($k
?"-$k":"");print"Content-Type: text/",$a?"tab-separated-values\nContent-Dispo".
"sition: attachment;filename=log$l.csv":plain,"\n\n";$f?do{/^\d{4}(\d\d)(\d\d)$
/x&&$1*$2&&$1<13&&$2<32&&(open(F,"$_.txt"),print grep$k?/\Q$k/o:1,<F>)for$f..$t
||$f}:do{s/^\d$/0$&/for($s,$n,$h,$d,$m,$y)=localtime;$y+=1900;$m++;$m=~s/^\d$/0
$&/x;open F,">>$y$m$d.txt";print F join("\t",$y,$m,$d,$h,$n,$s,@ENV{REQUEST_URI
,REMOTE_ADDR,HTTP_USER_AGENT,HTTP_REFERER}),"\n"}
■記録時
・ログファイルに日付も記録するよう変更。
(日付範囲を指定してログ表示した際に日付が無いとわけわからないため)
■閲覧時
・ダウンロード時のファイル名に抽出条件を盛り込むよう変更。
・1〜12月の1〜31日の間だけファイルオープンを試みるよう変更。
いろいろ増やしたらshebang無し七行になっちゃいました。
トイレに行かせただけで動作未確認。
($k=$ARGV[3])=~s/%([\da-f]{2})/pack"H2",$1/egi;/\D/&&die for($a,$f,$t)=@ARGV;
print"Content-Type: text/",$a?"tab-separated-values\nContent-Disposition: atta"
."achment;filename=log$f".($t&&"-$t").($k&&"-$k").'.csv':plain,"\n\n";$f?do{/^.
...(..)(..)$/x&&$1*$2&&$1<13&&$2<32&&(open(F,"$_.txt"),print grep$k?/\Q$k/o:1,
<F>)for$f..$t||$f}:do{($d,$m,$y)=(localtime)[3,4,5];open F,sprintf">>%d%02d%02"
."d.txt",$y+1900,$m+1,$d;print F join("\t",''.localtime,@ENV{REQUEST_URI,
REMOTE_ADDR,HTTP_USER_AGENT,HTTP_REFERER}),"\n"}
ログの日付を scalar localtime に変更。
($a,$f,$t,$k)=@ARGV;$k=~s/%([\da-f]{2})/pack"H2",$1/egi;print"Content-Type: ".
"text/",$a?"tab-separated-values\nContent-Disposition: attachment;filename=l".
"og$f".($t&&"-$t").($k&&"-$k").'.csv':plain,"\n\n";$f?do{/^....(..)(..)$/&&$1*
$2&&$1<13&&$2<32&&(open(F,"$_.txt"),print grep$k?/\Q$k/o:1,<F>)for$f..$t||$f}:
do{($d,$m,$y)=(localtime)[3,4,5];open F,sprintf">>%d%02d%02d.txt",$y+1900,$m+1
,$d;print F join("\t",''.localtime,@ENV{REQUEST_URI,REMOTE_ADDR,
HTTP_USER_AGENT,HTTP_REFERER}),"\n"}
>>284
1行目ってなんで変えたの?>>283の1行目で動くようなので戻すことで若干縮め。
あとattachmentのつづり直した。もう少しでshebang含7行。 >>285
コードそのまま。$a, $f, $t に数字以外の文字が
含まれない事を保障する為。
まぁここはチェック飛ばしても穴にはならんかな。 >>285
78文字+改行になってるよw
さらに強引に短くしてみた。
変更点
pack"H2"→pack H2 DLファイル名→$f-$t-$k.log $1*$2→$1のみ判定 [3,4,5]→[3..5]
#! perl
($a,$f,$t,$k)=@ARGV;$k=~s/%([\da-f]{2})/pack H2,$1/egi;print"Content-Type: te".
"xt/",$a?"tab-separated-values\nContent-Disposition: attachment;filename=$f".($
t&&"-$t").($k&&"-$k").'.log':plain,"\n\n";$f?do{/^....(..)(..)$/&&$1&&$1<13&&$2
<32&&(open(F,"$_.txt"),print grep$k?/\Q$k/o:1,<F>)for$f..$t||$f}:do{($d,$m,$y)=
(localtime)[3..5];open F,sprintf">>%d%02d%02d.txt",$y+1900,$m+1,$d;print F join
("\t",''.localtime,@ENV{REQUEST_URI,REMOTE_ADDR,HTTP_USER_AGENT,HTTP_REFERER}),
"\n"}
あと5バイト 汎用 TSV ヴューア
#!/usr/local/bin/perl
use CGI":all";charset$C='EUC-JP';*P=*param;($f=P(f))=~/[^\w*\-.?\[\\\]]/&¨$
w=P(w)||"\t";chomp(@l=map{open(_)?grep(/\Q$w/,<_>):()}grep/$f/o&&-f,<*>)if$f;%l
=(f,"target file regex",w,"search word",o,"output file name");put(($o=P(o))?(
"Content-Type: text/tab-separated-values\nContent-Disposition: attachment;file"
."name=$o\n\n",@l):(header,start_html(-title=>'7tsview',encoding,$C,lang,ja),
table({border,1},Tr[map{td[split/\t/]}@l]),startform(0,url),p(map{$l{$_},
textfield($_,'',40).br}f,w,o),endform,end_html))
use CGI":all";charset$C='EUC-JP';*P=*param;($f=P(f))=~/[^\w*\-.?\[\\\]]/&¨$
w=P(w)||"\t";chomp(@l=map{open(_)?grep(/\Q$w/,<_>):()}grep/$f/o&&-f,<*>)if$f;%l
=(f,"target file regex",w,"search word",o,"output file name");put(($o=P(o))?(
"Content-Type: text/tab-separated-values\nContent-Disposition: attachment;file"
."name=$o\n\n",@l):(header,start_html(-title=>'7tsview',encoding,$C,lang,ja),
table({border,1},Tr[map{td[split/\t/]}@l]),startform(0,url),p(map{$l{$_},
textfield($_,'',40).br}f,w,o),submit(0,go),endform,end_html))
submitを追加
動作未確認。末尾に空フィールドができるけどゴメンして。
($a,$f,$t,$k)=@ARGV;$k=~s/%([\da-f]{2})/pack H2,$1/egi;print"Content-Type: te".
"xt/",$a?"tab-separated-values\nContent-Disposition: attachment;filename=$f".($
t&&"-$t").($k&&"-$k").'.log':plain,"\n\n";sub l{localtime}$f?do{/^....(..)(..)$
/x&$1<13&$2<32&&(open(F,"$_.txt"),print grep$k?/\Q$k/o:1,<F>)for$f..$t||$f}:do{
($d,$m,$y)=(l)[3..5];open F,sprintf">>%d%02d%02d.txt",$y+1900,$m+1,$d;print F
join"\t",''.l,@ENV{REQUEST_URI,REMOTE_ADDR,HTTP_USER_AGENT,HTTP_REFERER},"\n"}
#! /usr/bin/perl
($a,$f,$t,$k)=@ARGV;$k=~s/%([\da-f]{2})/pack H2,$1/egi;print"Content-Type: te".
"xt/",$a?"tab-separated-values\nContent-Disposition: attachment;filename=$f".($
t&&"-$t").($k&&"-$k").'.log':plain,"\n\n";sub l{localtime}$f?do{/^....(..)(..)$
/x&$1*$2&$1<13&$2<32&&(open(F,"$_.txt"),print grep$k?/\Q$k/o:1,<F>)for$f..$t||$
f}:do{open F,sprintf">>%d%02d%02d.txt",(l)[5]+1900,(l)[4]+1,(l)[3];print F join
("\t",''.l,@ENV{REQUEST_URI,REMOTE_ADDR,HTTP_USER_AGENT,HTTP_REFERER}),"\n"}
・書き込み時のファイル名構築の際に関数lを使用するよう変更
・0月も0日も除外するようあらためて変更
・>>290さんの末尾の空フィールドができないよう変更
皆さんのおかげで再びshebang入り七行達成しました。
しかし、>>288-289のツールがあるなら、閲覧モードは不要だったりして・・・。
7wiki (>>274) 、7Hoo (>>276) 、7accesslog (>>291) を載せました。
README の変更等ありましたらココかアップローダにお願いします。 #! /usr/bin/perl
use CGI":all";charset$c='EUC-JP';opendir(H,"./");$s='7editor';while($i=readdir
H){$l.=li a {href,"$s.cgi?$i"},$i}if(request_method eq'POST'){$p=param(f);open(
H,">$p");print H param(t);print"Location: $s.cgi?$p\n\n"}else{$q=$ARGV[0];if($q
){open H,$q;$f.=$_ while(<H>)}put header,start_html(-title=>$s,encoding,$c,lang
,ja),h1($s),ul($l),startform(post,"$s.cgi"),p(textfield f,$q),p(textarea t,$f,9
,82),p(submit regist),endform,end_html}
●7editor.cgi
サーバ上のファイルを直接編集できます。ファイル名欄を変えれば新規作成も可能です。
textareaのサイズは、一応七行プログラミングを組みやすいかと思われる82x9にしてみました。
ToDo:
・セキュリティ対策
・ディレクトリ移動
・ファイル削除くらいはできた方がいいかも
とりあえずたたき台ってことで。
縮め&書き込み確認ダイアログ
#! /usr/bin/perl
use CGI":all";charset$c='EUC-JP';opendir H,"./";$s='7editor';while($i=readdir H
){$l.=li a{href,"$s.cgi?$i"},$i}if(request_method eq'POST'){$p=param(f);open H,
">$p";print H param(t);put"Location: $s.cgi?$p\n\n"}else{if(open H,$q=$ARGV[0])
{$f.=$_ while(<H>)}put header,start_html(-title=>$s,encoding,$c,lang,ja),h1($s)
,ul($l),startform(-onSubmit=>"return confirm('OK?')",post,"$s.cgi"),p(textfield
f,$q),p(textarea t,$f,9,82),p(submit regist),endform,end_html}
#! /usr/bin/perl
use CGI":all";charset$c='EUC-JP';*b=*param;opendir H,"./";while($i=readdir H){$
l.=li a{href,($s='7editor').".cgi?$i"},$i}if(request_method=~/POST/){open H,">"
.($n=b F);$_=b T;s/[\r\n|\r[^\n]]/\n/g;print H;put redirect"$s.cgi?$n"}else{if(
open H,$q=$ARGV[0]){$f.=$_ while<H>}put header,start_html(-title=>$s,encoding,$
c,lang,ja),h1($s),ul($l),startform(-onSubmit=>"return confirm('OK?')",,"$s.cgi"
),p(textfield F,$q),p(textarea T,$f,9,82),p(submit regist),endform,end_html}
環境によって改行コードが変わってしまうバグを修正。結構ギリギリ。
#! perl
use CGI":all";charset$c='EUC-JP';opendir H,".".($d=path_info);while($_=readdir
H){if(!/^\.+$/){$l.=li a{href,script_name."$d".(-d".$d/$_"?"/":"?").$_},$_}}if(
request_method=~/P/){open H,">.$d/".($n=param F);$_=param T;s/\r\n|\r[^\n]/\n/g
;print H}if(open H,".$d/".($q=$ARGV[0])){$f.=$_ while<H>}put header,start_html(
-title=>"7editor",encoding,$c,lang,ja),h1($d||"/"),ul($l),startform(-onSubmit=>
"return confirm('OK?')"),p(textfield(F,$q),br,textarea(T,$f,9,82),br,submit),endform,end_html
ディレクトリを移動できるように
「.」「..」は非表示
h1要素は現在位置を表示
スクリプト名は自由(7editorじゃなくても可)に
でも14文字ほどハミ出た。
use CGI":all";charset$c='EUC-JP';($d=path_info)=~s|/*$|/|;if(request_method=~PO
){open H,">.$d".($n=param F);$_=param T;s/\x0D\x0A/\n/g;tr/\r/\n/;print H}$/=()
,$f=<H>if open H,".$d".($q=pop);opendir H,".$d";$l.=li a{href,url.$d.(-d".$d$_"
?$_:"?$_")},$_ for grep!/^\.+$/,readdir H;put header,start_html(-encoding=>$c,
lang,ja,Title,"7editor"),h1($d),ul($l),startform(-onSubmit=>"return confirm(
'OK?')"),p(textfield(F,$q),br,textarea(T,$f,9,82),br,submit),endform,end_html
・.で画面リロード、..で親DIRへ移動
・ディレクトリはお尻に「/」
use CGI":all";charset$c='EUC-JP';($d=path_info)=~s|/*$|/|;if(request_method=~PO
){open H,">.$d".($n=param F);$_=param T;s/\x0D\x0A/\n/g;tr/\r/\n/;print H}$/=()
,$f=<H>if open H,".$d".($q=pop);opendir H,".$d";$l.=li a{href,url.$d.(($h=-d".$
d$_")?$_:"?$_")},($_.($h&&"/"))for readdir H;put header,start_html(-encoding=>$
c,lang,ja,Title,"7editor"),h1($d),ul($l),startform(-onSubmit=>"return confirm(
'OK?')"),p(textfield(F,$q),br,textarea(T,$f,9,82),br,submit),endform,end_html
#!/usr/bin/perl
use IO::Socket;$S=new IO::Socket::INET(Listen,1,LocalPort,1029,Reuse,1);sub p{
print@_}sub g($){($_=getc$C)eq pop}$n="\x0D\x0A";sub o{$c=pop;g"\x01"?($e=$c&2)
:/\x22/?($c&1or$e=0):($c=1);p pack(C2,255,250+(4,2,2,4,3,2,1,4)[$c&1?$c:$c+4]),
$_}{binmode($C=$S->accept);select$C;$e=1;$b='';p$p='$ ';{g"\xFF"?g"\xF7"?chop$b
:/\xF8/?($b=''):/\xFB/?o 0:/\xFC/?o 1:/\xFD/?o 2:/\xFE/?o 3:0:/\x00/?do{$b=~s/[
$n]+\z//x;"exit"eq$b&&last;s/\s+\z/$n/for@o=`$b`;p$n,@o,$p;$b=''}:(/\x08/?chop$
b:($b.=$_),/[$n]/||$e&&p$_);redo}close$C;redo}
http://www5e.biglobe.ne.jp/~aji/3min/53.html を読みながら色々
実装してみるも、>>207 に負けてる telnetd 。;)
動作確認:
TeraTermPro → Win98SE (command.com + KI-Shell)
TeraTermPro → FreeBSD 4-STABLE (tcsh)
telnet(1) (line mode) → Win98SE (command.com + KI-Shell)
telnet(1) (line mode) → FreeBSD 4-STABLE (tcsh)
TODO: cd cd 実装。
#!/usr/bin/perl
use IO::Socket;$S=new IO::Socket::INET(Listen,1,LocalPort,1029,Reuse,1);sub p{
print$C @_}sub g($){($_=getc$C)eq pop}$n="\x0D\x0A";{binmode($C=$S->accept);$e=
1;$b='';p$p='$ ';{g"\xFF"?g"\xF7"?chop$b:/\xF8/?($b=''):/[\xFB-\xFE]/?do{$c=ord
()-251;g"\x01"?($e=$c&2):/\x22/?($c&1or$e=0):($c=1);p pack(C2,255,250+(4,2,2,4,
3,2,1,4)[$c&1?$c:$c+4]),$_}:0:/\x00/?(($_,$b)=$b,s/[$n]+\z//,/^exit$/&&last,p$n
,(/^cd\s+/?chdir$':map{s/\s+\z/$n/;$_}`$_`),$p):(/\x08/?chop$b:($b.=$_),/[$n]/
||$e&&p$_);redo}close$C;redo}
■ 7jump.cgi(ime.nuクローン)
http://hoge.com/7jump.cgi/http://www.2ch.net/ スキーマ指定可能
http://hoge.com/7jump.cgi/www.2ch.net/ 省略時はhttp://
#! perl
use CGI":all";charset$c='EUC-JP';$_=path_info;s|^/||;s/\"/"/g;s/\'/?/g
;s/</</g;s/>/>/g;s/&(?![\#0-9a-zA-Z]+;?)/&/g;$_="http://$_"if!/:/;($m
,$a)=<DATA>;put header,start_html(-title=>"7jump",encoding,$c,lang,ja),p(strong
(a{href,$_},$_).br.$m),hr,address($a),end_html;
__DATA__
別のサイトにジャンプしようとしています。宜しければ上記のリンクをクリックしてください
Powered by WebProg
#! perl
use CGI":all";charset$c='EUC-JP';$_=path_info;s|^/||;s/\"/"/g;s/\'/'/g
;s/</</g;s/>/>/g;s/&(?![\#0-9a-zA-Z]+;?)/&/g;$_="http://$_"if!/:/;($m
,$a)=<DATA>;put header,start_html(-title=>"7jump",encoding,$c,lang,ja),p(strong
(a{href,$_},$_).br.$m),hr,address($a),end_html;
__DATA__
別のサイトにジャンプしようとしています。宜しければ上記のリンクをクリックしてください
Powered by WebProg
use CGI":all";charset$c='EUC-JP';$_=path_info;/:/?s|^/||:($_="http:/$_");put
header,start_html(-Title,"7jump",encoding,$c,lang,ja),p(strong(a{href,$_},
escapeHTML$_).br.<DATA>),hr,address(<DATA>),end_html
巻き戻り分。
304 :7uploader :04/03/25 21:16 ID:???
use CGI":all";$CGI::POST_MAX=1<<20;$/=\4096;chdir D;sub v{open(F,pop)?binmode F
:die}if(($f=upload f)=~/\.\w+$/){v">".time.$&;print F while<$f>;close F}++$i<51
?push@f,$_:unlink for sort{$b<=>$a}<*>;($_=param d)?(v($_),put header(-type,
'application/octet-stream',Content_length,-s,attachment,$_),<F>):put(header,
start_html,start_multipart_form,filefield(f),submit,endform,table({border,1},Tr
[map{td[a({href,"?d=$_"},$_),''.localtime+(stat)[9],(-s>>10).KB]}@f]),end_html)
・ファイルサイズを KB で表示。 #!perl
if(!caller){my$p=pop;eval"use $p;1"?new$p->run:die$@}package Unit7;sub p{print"
@_\n"}sub new{bless{},shift}sub run{$N=$O=0;for(grep/^test/,keys%{ref($s=shift)
."::"}){$T=$n=$o=0;$N++;set_up$s;$s->$_();tear_down$s;$n-$o||$O++;$T||p"$N) $S"
;print"$o/$n ok\n"}p$N-$O?("Run: $N, Failures:",$N-$O):"OK ($N tests)"}*set_up=
*tear_down=sub{};sub assert{($s,$f,$m)=@_;($S)=(caller 1)[3]=~/\w+$/g;$n++;$o++
,return if$f;$T++||p"$N) $S";print"\t$m\n"}$VERSION=1.00
・出力フォーマットの変更
・簡易 TestRunner.pl を内包 (> perl ./Unit7.pm My::TestCase::Class)
package Store7;use Symbol;sub E{$_=pop;s/['\\]/\\$&/g;"'$_'"}sub D{local$_=ref(
my$f=pop);/SCALAR/?E$$f:/ARRAY/?"[".join(',',map{D($_)}@$f)."]":/HASH/?"{".join
(',',map{E($_),D($f->{$_})}keys%$f)."}":E$f}$O='{open($f=gensym,$m.pop)||die if
$m="';$E='local$/;(eval<$f>';$P='print$f D pop;1';$F='eval{flock$f';$L='lock_';
use base Exporter;$C=',close$f';$G='{$f=pop;';$M='}sub ';@EXPORT=($S='store',$R
='retrieve');@EXPORT_OK=($S.'_fd',"fd_$R",$L.$S,$L.$R);eval qq/sub $R$O<";$E$C
)[0]$M$L$R$O<";$F,1};$E$C)[0]$M\fd_$R$G$E)[0]$M$S$O>";$P$C$M$L$S$O>";$F,2};$P$C
$M$S\_fd$G$P}/;$VERSION=1.00
・store_fd 、lock_store 、fd_retrieve 、lock_retrieve 実装
>>260
s/['\\]/\\$&/g でマズい例ってどんなのでしょう? >>209 までに出たものの追加分
# 7wiki.cgi >243 >244 >251 >253 >254 >255 >256 >274
# 7wiki.cgi 用 RSS出力 >230
# 7ch >231
# 動作確認用ファイル生成 4 7blosxom >233
# telnetd >299 >300
# 7uploader.cgi >245 >251 >275 >304
# 7hoo (PerlHoo) >257 >276
>>209 以降に出た分
# 掲示板(4) >211 >212
# 7memo >216 >218 >219 >224
# Unit7 >220 >221 >222 >305
# ライセンスについて >246 >247 >248
# 7vote >249
# Store7 >258 >259 >260 >261 >306
# 7accesslog >266 >267 >268 >278 >279 >280 >283 >284 >285 >286 >287 >290 >291
# 7rwcntr >270 >271 >272 >273
# 7tsview >288 >289
# 7editor >293 >294 >295 >296 >297 >298
# 7jump >301 >302 >303 ダメ出しが無いようなので 7telnetd (>>300) と Unit7 (>>305) を載せました。
(個人的な)TODO: 7ch と 7thread の転載体裁整え > Store7 > 7vote
128 氏もライセンス GPL にしちゃっていいんでしょか?
ご自身のサイトをお持ちでそちらで公開されるなら、SevenLines から
リンクさせてもらいますよと言ってみるテスト。 縮め。
package Store7;use base Exporter;use Symbol;sub E{$_=pop;s/['\\]/\\$&/g;"'$_'"}
@EXPORT=($S=store,$R=retrieve);$L=lock_;@EXPORT_OK=($S.'_fd',"fd_$R",$L.$S,$L.$
R);sub D{local($_,$")=(ref(my$f=pop),',');/^S/?E$$f:/^A/?"[@{[map{D($_)}@$f]}]"
:/^H/?"{@{[map{E($_),D($f->{$_})}keys%$f]}}":E$f}$M='}sub ';$P='print$f D pop;1
';($E,$C,$F,$G)=qw|local$/;(eval<$f> ,close$f eval{flock$f {$f=pop;|;$O='{open(
$f=gensym,$m.pop)||die if$m="';eval qq/sub $R$O<";$E$C)[0]$M$L$R$O<";$F,1};$E$C
)[0]$M fd_$R$G$E)[0]$M$S$O>";$P$C$M$L$S$O>";$F,2};$P$C$M$S\_fd$G$P}/;$VERSION=1
7ch と 7thread を GPL でパッケージング & Store7 を載せました。
README の変更等ありましたら作業用 uploader の方へお願いします。
リファーを残さずにリダイレクト。JavaScript Off でも動作可能なコード
#! /bin/ksh
# リダイレクト
if [ "$QUERY_STRING" ]; then echo "Pragma: no-cache
Refresh: 0; URL=QUERY_STRING\n"; exit; fi
# エラー出力
echo "Content-Type: text/html\nPragma: no-cache\n\n<html><head>
</head><body>\nリンク先を指定して下さい\n</body></html>"
リファーについて参考にしたページ
http://www.teria.com/~koseki/memo/referrer/ うぐぅ。上のコード URL=QUERY_STIRNG に $ が抜けてました。
URL=$QUERY_STRING と見て下さい。
仕様変更無しでザッと縮め。
use CGI":all";*P=*param;charset$c='EUC-JP';chdir V;($F)=P(f)=~/^(\d+)$/;if(open
F,"+<$F"){eval{flock F,2};$t=<F>;/\t/and$D{$`}=$'+0while<F>;($n=P(n))?$D{$n}||=
1:($v=P(v))&&$D{$v}++,seek(F,0,0),print F"$t\n",map"$_\t$D{$_}\n",keys%D if
request_method=~PO}$L{$K[$i++]}=$_ for radio_group(v,[@K=sort{$D{$b}<=>$D{$a}}
keys%D]);put header,start_html(-Title,$t,encoding,$c,lang,ja),h1($t),startform,
table({},Tr[map{td["$L{$_}($D{$_})",hr{width,$D{$_}}]}@K]),hr,p(textfield(n),
hidden(f,$F),submit),endform,end_html
・hr のグラフは微妙。
・既に存在する選択肢への投票は、選択肢自体をクリックできた方がより直感的か?
open(IN, $ARGV[0].".txt");@lines = <IN>;close(IN);
foreach $line (@lines)
{if( $line =~ / [a-z0-9]{32}/ ){$hash .= $line;}}
open(OUT, ">hash".$ARGV[0].".txt");
print OUT $hash;close(OUT);
WinnyBBS の内容を全部コピペ。テキストファイルに保存。
↓
その中からハッシュを摘出。テキストファイルに出力。
>>314
perl -ne "/ [0-9a-z]{32}/ && print" in.txt > out.txt
grep " [0-9a-z]\{32\}" in.txt > out.txt # 最近、下がり気味なので保守ついでに
package BEncode7;use base Exporter;@EXPORT=qw/bencode bdecode/;sub bencode($){
my$i=pop;ref$i eq'HASH'?"d@{[join('',map{bencode($_).bencode($i->{$_})}keys%$i)
]}e":ref$i eq'ARRAY'?"l@{[join('',map{bencode($_)}@$i)]}e":$i=~/^([+-]?\d+)$/?
"i${i}e":length($i).":$i"}sub bdecode{local$_=pop;(/^d(.+)e$/s)?{bdecode($1)}:(
/^l(.+)e$/s)?[bdecode("$1")]:(s/^i?([+-]?\d+)e//)?(int("$1"),bdecode($_)):(
/^(\d+)/&&s/\d+\:(.{$1})//s)?("$1",bdecode($_)):undef}7
Convert::BEncodeの7行版。bittorrent等で使われているフォーマット。
>>316
それだとテスト (001_basic.t) 通らないから、
オリジナルからザックリ縮め直してみたよ。
package Bencode7;use strict;use bytes;use base"Exporter";*bencode=*E=sub{no
locale;my$i=pop;ref$i eq"HASH"?join("","d",map(E($_).E($i->{$_}),sort keys%$i),
"e"):ref$i eq"ARRAY"?join("","l",map(E($_),@$i),"e"):$i=~/^\d+$/?"i${i}e":
length($i).":$i"};sub D{my$c=pop;my$i=shift@{$c};$i=~/d/?do{my%h;while(($i=
shift@{$c})ne"e"){unshift@{$c},$i;my$k=D($c);$h{$k}=D($c)}\%h}:$i=~/l/?do{my@l;
while(($i=shift@{$c})ne"e"){unshift@{$c},$i;push@l,D($c)}\@l}:$i=~/i/?do{my$n;
$n.=$i while($i=shift@{$c})ne"e";$n}:$i=~/\d/?do{my$n="";do{$n.=$i}while($i=
shift@{$c})=~/\d/;my$l="";$l.=shift@{$c}for 1..$n;$l}:$c}sub bdecode{D[pop=~
/./gs]}our($VERSION,@EXPORT_OK)=qw(0.01 bencode bdecode) while($act ne "ガッ"){
print "ぬるぽ\n";
$act = <STDIN>;
chomp($act);
}
print "撃退\n";
sleep(1);
>>321
個人的には WebPlog らしいお題なら言語は何でも
いいと思うけど。てかこんなんはやった者勝ちかと。 とりあえずPHP5+SQLiteな一行掲示板。フォーム部分は分離させた。
<form action=bbs.php method=post>名前:<input type=text name=n>一言:<input type=t
ext name=t size=60><input type=submit value=送信></form>
<? $d=sqlite_open('l');$n=$_POST['n'];if(!@sqlite_query($d,'SELECT * FROM b;')){
sqlite_query($d,'CREATE TABLE b(n,t,d);');}$t=$_POST['t'];$z=date("Y/m/d H:i:s")
;if($n!=''&&$t!=''){$s="INSERT INTO b(n,t,d) VALUES(\"$n\",\"$t\",\"$z\");";sqli
te_query($d,$s);}print "<hr>";$r=sqlite_query($d,"SELECT * FROM b ORDER BY d DES
C");$c=0;while(($a=sqlite_fetch_array($r))&&$c<50){print htmlspecialchars($a['n'
]).":".htmlspecialchars($a['t'])."[".$a['d']."]<br><hr>\n";$c++;}sqlite_close($
d); ?>
DBファイルとテーブル勝手に作る方式。新着順、50件まで(ただしDBからは消してない)。
読みにくいけどSQLiteの使い方の勉強に…ならんか。
>>318
ちなみにそれ、アクセス解析機能もつけるのか? 人ほとんどいないなここ(´・ω・`)
Web拍手PHP版(記録側)。例によってフォームは分離。
<form method="post" action="webclap.php" target="clap">
<input type="hidden" name="m" value="c">ついでに一言。
<input type="text" name="t" size=40>
<input type="submit" value="拍手を送る"></form>
<? if($_POST['m']=='c'){$n=file("l");$d=date("Ymd");$h=date("H");$b=split(",",$n
[0]);$a=file("t");echo $a[array_rand($a)];if($b[0]!=$d){$i=0;$x="$d,1,";while($i
++<24){if($i==$h+1)$x.="1,";else$x.="0,";}array_unshift($n,"$x\n");}else{$b[1]++
;$b[$h+2]++;$x="";$i=-1;while($i++<count($b)-2)$x.="$b[$i],";$n[0]="$x\n";if(cou
nt($n)>14)array_pop($n);}$f=fopen("l","w");while(count($n)>0)fputs($f,array_shif
t($n));fclose($f);$t=$_POST['t'];if($t!=""){$m=file("m");$f=fopen("m","w");array
_unshift($m,"$d,$t\n");if(count($m)>200)array_pop($m);while(count($m)>0)fputs($f
,array_shift($m));fclose($f);}} ?>
ごめん、8行になってしまた。取得ログは14日分で1時間単位ごとの記録アリ、
一言メッセージは200件まで保存。動かす前にl,m,tとそれぞれ空ファイル作ってくだされ。
tには拍手ボタン押した後に表示するHTMLを一行で叩き込んで。
複数行にするとランダムでどの行か選んで表示します。一行の長さの制限はわからん。
だれか7行に縮めてくれ。俺はもうだめだ(´Д⊂
ためしにkaiseki.php作ったら12行になったΛ||Λダメポ
活気ないのでage
オリジナルから仕様を極力変えない方向で10行。
#!/usr/local/bin/perl
use CGI":all";charset$c=Shift_JIS;param(k,$k=1+param k);($w=escapeHTML(param w)
)=~s/\x0D\x0A|[\x0A\x0D]/br/eg;sub d{($h,$d,$m,$y)=(localtime(time-86400*pop))[
2..5];$g=($y+1900).sprintf"%02d"x2,$m+1,$d}($C,$M,$L,$T,$I,$S,$E,@M)=<DATA>;
open L,">$L";eval{flock L,2};open C;d>(@c=<C>)[-1]?(@c<14||shift@c,@l=((0)x25,
"\n")):(($g,@l)=split/<>/,pop@c);$l[$h+1]++;$l[0]++;open C,">$C";print C@c,join
"<>",$g,@l;d(14);open M;@m=grep$g<=$_,<M>;open M,">$M";print M@m,""ne$w&&d."<>$
h<>$w<>\n";put header,start_html(-Title,$T,lang,ja,encoding,$c),($k<10?(p($M[
rand@M]),startform,p(hidden(k),submit$S),p($I,br,textfield w,'',50,50),endform)
:p$E),end_html;__END__
./log.dat
./mes.dat
./lock.dat
web拍手送信完了
ついでに一言あればどうぞ (拍手だけでも送れます)
もっと送る
沢山の拍手を有り難うございました!
拍手が送信されました。ありがとうございました!
拍手が送信されました。ありがとうございますた!
拍手が送信されました。ありがとさ〜ん!
>>329
行末改行は79文字で切ったものなんで、動かす場合は繋げて。 あぁ、「そのまま動く」ってのが明文化されてないわけね…。
>>330
「560byte」プログラミングじゃなくて「7行」なので、79文字
一杯々々使いたかったら、コードの順番入れ替えたりして
調整してね。 あと2chの仕様だが、コード中に半角スペースが2コ以上連続する時は
半角スペースを に置換する
行の最後に半角スペースが付くので、実行する時には注意する
あと一行半。
#!/usr/local/bin/perl
use CGI":all";charset$c=Shift_JIS;param(k,$k=1+param k);($w=escapeHTML(param w)
)=~tr/\x0A\x0D//d;($C,$M,$L,$E,@M)=<DATA>;open L;eval{flock L,2};@l=((0)x26,"
");sub d{($s,$m,$h,$d,$m,$y)=localtime(time-pop);$l[0]=($y+1900).sprintf"%02d"x
2,$m+1,$d}open C;d>(@c=<C>)[-1]?@c<14||shift@c:(@l=split/<>/,pop@c);$l[$_]++for
$h+2,1;open C,">$C";print C@c,join"<>",@l;d 1209600;open M;@m=grep$l[0]<=$_,<M>
;open M,">$M";print M@m,""ne$w&&d."<>$h<>$w<>\n";put header,start_html(lang,ja,
encoding,$c),$k<10?(p($M[rand@M]),startform,p(hidden(k),submit Clap),p(Comment,
textfield w),endform):p$E,end_html;__END__
./log.dat
./mes.dat
>./lock.dat
沢山の拍手を有り難うございました!
拍手が送信されました。ありがとうございました!
拍手が送信されました。ありがとうございますた!
拍手が送信されました。ありがとさ〜ん!
>319
全然要求満たしてないけど、叩き台に。
C/C++用、inputは余計なコード書いてないヘッダファイルのみ
#!/usr/bin/perl -Pn
/^namespace\s*(\w+)/ && ($ns=$1);
/\#include\s*[<"](.+)[">]/ && push(@inc, $1);
/^class\s+(\w+)\s*\:?/ && push(@cls, $1);
/(([\w\s\*]+)(\w+)\s*\((.+)\))/ && push(@memf, $1); # メンバ関数
/(([\w\s\*]+)(\w+));/ && push(@memv, $1); # メンバ変数
END{ print join("\n", $., $ns, "@inc","@cls","@memf", "@memv"),"\n" }
JAVAはリフレクションがあるし、classファイルのフォーマットも公開されてるので
別のアプローチでやってみると面白いかも知れない。(javapやClassBrowserが既にあるけど)
スクリプト -> 335.pl
/* C++のヘッダファイル foo.h */
#include <iostream>
#include <stdlib.h>
#include "common.h"
using namespace std;
namespace test{
class FooTest: public Test {
int total;
public:
Test();
~Test();
int foo(void);
int bar(int n, int m);
}; // End of class FooTest
}; // End of namespace test
実行方法
$ perl -Pn 335.pl < foo.h または、
$ ./335.pl < foo.h
18
test
iostream stdlib.h common.h
FooTest
int foo(void) int bar(int n, int m)
using namespace std int total
行数, namespace, includeファイル, メンバ関数, 変数の順に出力
何故わざわざ WebProg 板で? と思いつつ縮め。
#!/usr/bin/perl -n
$n=$1if/^namespace\s*(\w+)/;/#include\s*[<"](.+)[">]/&&push@i,$1;/^class\s+(\w+
)\s*\:?/x&&push@c,$1;/\s*([\w\s\*]+\w\s*\(.+\))/&&push@f,$1;/\s*([\w\s\*]+\w);/
&&push@v,$1;END{print join"\n",$.,$n,"@i","@c","@f","@v",''}
<html>
<head>
<title>あ</title>
</head>
<body>
</body>
</html>
Store7の圧縮してない奴ないですか? > 作者
>>344
ありがとう
いや,実は>>258なんだけど機能強化されてるのでこっちを使おうかと思ってね >>348
定数をハードコーディングして可搬性を激しく落としてでも
Socket.pm を使わない選択は漢だなぁ。(w
80桁ギリギリまで詰めるよう整形したら既にシェバング無し
七行達成してるし、あと 40 byte ほど縮めたらいい感じかな。
$/=$_;$,=shift;$w=$a=shift;sub g{open(F,$4)&&t($2,$a,"e$4",<F>);close F}socket
S,2,1,6;$k{+shift}=1;bind S,&a;sub e{open F,">$4";print F$';close F}sub h{t($2,
$_,id)for keys%k}sub i{$k{$2}=1}sub f{t($_,$2,$4)for keys%k}sub a{$w=~/:/;pack
'CxnC4x8',2,$',split'\.',$`}sub t{socket X,2,1,6;$w=shift;$k{$w}=(connect X,&a)
?print X"$, $_[0] $_[1]/".pop:$/;close X}for(listen S,5;$SIG{ALRM}=sub{};
m!^(.*?) (.*?) ([e-i])([^/]*)/!s&&$,eq$1&&&$3){alarm 9;(accept(C,S),alarm 0)?
read C,$_,1e6:($_="$, $a f".shift);close C} >>352
「どう?」じゃなくて、作って晒せば? こういうのはやったもん勝ち。
面白いと思わせる事ができれば挑戦者も出てくるんじゃない?
ただスレのルール的に、「560 byte」でなく、1 行は 79 byte + 改行、
7 行以内でそのまま使える、って条件を満たしてないと個人的には
受け入れ難いなぁ。 じゃぁ、phpで7行wiki
<? require("Text/Wiki.php");require("Cache/Lite.php");$c=&new Cache_Lite();
$s=$_SERVER[PHP_SELF];$g=$_GET;$b=&$_POST[b];$n=$g[n]?$g[n]:"FrontPage";$b&&
$c->save($b,$n)&&header("Location: $s?n=$n");($b=$c->get($n))||$g[c]=e;
$h="<h1>$n</h1>";if($g[c]==e)$h.="<form method=post action='?n=$n'>".
"<textarea name=b rows=30 cols=80>$b</textarea><input type=submit>";
else{$w=&new Text_Wiki;$w->setRenderConf(xhtml,wikilink,new_url,"?n=%s");
$h.=$w->transform($b,xhtml)."<hr><a href='?c=e&n=$n'>e";}?><html><body><?=$h?>
PEAR::Text_Wikiが必要。Cache_LiteはPEARにデフォルトで入ってる気がする。
あとshort_open_tag=Onでよろしく。
整形ルールは http://wiki.ciaweb.net/yawiki/index.php?area=Text_Wiki&page=SamplePage
日本語のwikinameは使えなかったりする。これはText_Wikiが対応していないせい。 >>358
ライブラリ使い過ぎると面白さ半減ってことだろ。 >>355
まぁでも、7行で基本機能を備えたwikiが使えるなら実世界でも結構有用じゃないか。
Text_Wikiの機能のデモにはなるでしょ。
むしろwiki技術関連スレ向きとは思うが。
向こうにも一応アンカー張ってあるね。 流れを無視して、7vote が 7 行に収まったのでパッケージング。
#!perl
use CGI":all";charset$c='UTF-8';${$_}=param$_ for f,n,v;$f=~s/\W//g;open F,"+<$
f"if chdir V;eval{flock F,2};$t=<F>;/\t/and$D{$`}+=$' for<F>;seek F,0,0;$n?$D{$
n}||=1:$v&&$D{$v}++,print F$t,map"$_\t$D{$_}\n",keys%D if$n||$v;$L{$K[$i++]}=$_
for radio_group(v,[@K=sort{$D{$b}<=>$D{$a}}keys%D]);put header,start_html(-lang
,ja,encoding,$c,-Title,$t),h1($t),startform,table({},Tr[map{td["$L{$_}($D{$_})"
,hr{width,$D{$_}}]}@K]),hr,p(textfield(n),hidden(f,$F),submit),endform,end_html
UTF-8 になったのがちょっと悔しい。
ファイル名は \w+ にしました。
半年ぶりフォーーーーーーーーーーーーーーーーーーーーーー
#!/usr/bin/perl
my@d=([qw/@ A B C D E F G H I J K L M/],[qw/☆ △ ■/]);
my$c='Shift_JIS';my$l='ja';use CGI':standard';my@r=(0)x@d;
print header(-charset=>$c),start_html(-encoding=>$c,-lang=>$l),start_form,
(map{my$i=$_;ul li[(map{$r[$i]+=param($_);$_.textfield -name=>$_}@{$d[$i]}),
"計 $r[$i]"]}0..$#d),ul(li"$r[1]÷$r[0]=".eval{$r[1]/$r[0]}),submit,end_form,
end_html;
なぜ丸付き数字と図形なのかわからんけど面白いですね。
どういうときに使えるだろう・・・。と考えてしまう
http://tool-6.net/?0001
イメージ的には、こんな感じなんですが…。【1】,「@〜Mまで入力した数値を総計。」
【2】,「A+B+Cに入力した数値を総計。」
【3】,「【2】÷【1】×100」っていう演算プログラムなんですが…。 >>367
仕様変更は34,000円からになっておりますw
話の流れがわからない人はhttp://pc8.2ch.net/test/read.cgi/tech/1134327348/756-
>>365はかなりゆとりがあったので7Excelにしてみた。
スタイルシートを別ファイルにしてもいいならまだまだいけそうだ。
#!/usr/bin/perl
@x='A'..'G';@y=1..10;$c='Shift_JIS';use CGI':all';@r=(0)x(@x+1);print header(
-charset=>$c),start_html(-encoding=>$c,-lang=>'ja',-head=>style({-type=>
'text/css'},'table{border-collapse:collapse}input,th{width:50px}td{text-align:
right}td,th{border:1px solid gray}')),start_form,table(Tr(map th($_),'',@x,''),
(map{$i=$_;$s=0;Tr td[$_,(map{$p=param"$i$x[$_]";$s+=$p;$r[$_]+=$p;textfield
"$i$x[$_]"}0..$#x),($r[-1]+=$s,$s)[1]]}@y),Tr td['',@r]),submit,end_form,end_html use Storable;$f='file';$s=8;$c='Shift_JIS';%p=qw/-1 〇 0 _ 1 ●/;@m=map([map 0
,0..$s+2],0..$s+2);($x,$y)=map param($_)%($s+1),qw/x y/;$r=1;use CGI':all';sub
f2{my($w,$y,$x,$c)=@_;$u=1;if(0>$r*$m[$y][$x]){$c++;$m[$y][$x]*=$u=f2($w,$y+$w
->[0],$x+$w->[1],$c)}elsif(0<$c&&0<$r*$m[$y][$x]){$u*=-1}$u}sub r{if($y&&$x&&!
$m[$y][$x]){for(0..7){$i=$_*atan2 1,1;$l=[map int(sprintf'%f',$_*sqrt 2),sin$i,
cos$i];$z++if 0>f2$l,$y+$l->[0],$x+$l->[1]}if($z){$m[$y][$x]=$r;$r*=-1}}}$m[$s/
2+(0<($_&2))][$s/2+(0<($_&1))]=$_%3?1:-1 for 0..3;($r,@m)=@{retrieve$f}if-s$f;r
;store[$r,@m],$f;print header(-charset=>$c),start_html(-encoding=>$c,-lang=>
'ja'),table(Tr[map{$i=$_;td[map a({-href=>"o.cgi?y=$i&x=$_"},$p{$m[$i][$_]}),1
..$s]}1..$s]),$p{$r},end_html;
7オセロ?
o.cgiで保存。
同じディレクトリに記録用ファイルの "file" を作成。
要 Storable.pm (Active Perl なら最初から入っているはず)
リセットは手動で "file" を空にするw
7行に収まると思ったけど見込みが甘かった。
>>365
本当にありがとうございます。設置の仕方が分かりませんorz orz orz
今日6時間くらい、CGIについて解説してあるサイトを隅から隅まで見ましたが、収穫なしですwww
ばかん ばかん 俺のばかん
テキストエディタ?を使うんですか? >>365氏
本当にありがとうございます。
2chでこんな優しい人初めてだ。
勉強してきますた。
鯖にアップロードして、パーミッションを755にするだけでおKですか? >>374
鯖によるから合ってるとか間違ってるとか言えん。
とにかくやって、エラーが出たらまた聞いてくれよ。
何かやるたびに聞かれたんじゃ迷惑だし、そもそもスレ違い。 ($f,$s,$r,@p)=qw/file 8 1 _ ● 〇/;use Storable;use CGI':all';sub f{$u=1;my($y
,$x,$c)=@_;if(0>($t=$r*$m[$y][$x])){$m[$y][$x]*=f($y+$p,$x+$n,1)}elsif($c&$t){
$u=-1;$z++}$u}$$_=param($_)%($s+1)for qw/x y/;@m=map[(0)x$s+1],0..$s+1;map$m[$s
/2+$_/2][$s/2+$_%2]=$_%3?1:-1,0..3;($r,@m)=@{retrieve$f}if-s$f;$o=\$m[$y][$x];
if($y&&$x&&!$$o){for(0..7){($p,$n)=map sprintf('%.f',$_),sin($i=$_*0.78),cos$i;
f$y+$p,$x+$n}$$o=$r,$r*=-1 if$z}store[$r,@m],$f;charset '';print header,$p[$r],
table Tr[map{$i=$_;td[map a({href,"?y=$i&x=$_"},$p[$m[$i][$_]]),1..$s]}1..$s]
昨日の続きで7オセロ!
モジュール詳しくないからやらないけどモジュール*だけ*で構成なんてのも面白そうだ。
>>374
質問するならまず68,000円のサポートチケットを購入してからにしてくださいw ($f,$s,$r,@p)=qw/file 8 1 _ ● 〇/;use Storable;use CGI':all';sub f{$u=1;my($y
,$x,$c)=@_;if(0>($t=$r*$m[$y][$x])){$m[$y][$x]*=f($y+$p,$x+$n,1)}elsif($c&$t){
$u=-1;$z++}$u}$$_=param($_)%($s+1)for qw/x y/;@m=map[(0)x($s+1)],0..$s+1;map$m[
$s/2+$_/2][$s/2+$_%2]=$_%3?1:-1,0..3;($r,@m)=@{retrieve$f}if-s$f;$o=\$m[$y][$x]
;if($y&&$x&&!$$o){for(0..7){($p,$n)=map sprintf('%.f',$_),sin($i=$_*0.78),cos$i
;f$y+$p,$x+$n}$$o=$r,$r*=-1 if$z}store[$r,@m],$f;charset '';print header,$p[$r]
,table Tr[map{$i=$_;td[map a({href,"?y=$i&x=$_"},$p[$m[$i][$_]]),1..$s]}1..$s]
括弧はずしすぎでバグっていたので修正
ファイル名省略すると Lynx じゃ動かないね。
>>378
パスできない仕様はどうかと。
ファイルに記録するより Cookie にでも持たせた方がいいんじゃない?
参考に C の6行オセロを Perl に移植してみた。
オリジナルより数 byte 大きい。 ;-)
#!/usr/local/bin/perl
sub K{$m[$p]||do{for(@m[0..7]){$v=$p+$_;$v+=$_ while$m[$v]==9-$t;if($v-$p-$_&&$
m[$v]==$t&&($a=$s=$v=$p,$d)){{$m[$v]=$t;$m[$v+=$_]-$t&&redo}}}}}@m[40,41,49,50,
0..7]=(3,6,6,3,-10..-8,-1,1,8..10);$s=$t=3;@c=(qw(・ ○ ●),$/);while($s-1){$_%
9?K$p=$_:($m[$_]=9),print$c[$m[$_]/3]for 9..81;$a?($a=$d=$p=9):$s?($s=0,print
"pass\n"):++$s;K$p+=$t-6?(($p,$_)=<>=~/\d/g,$_*9):1until$a-9;$t=9-$t;$a=$d=0} @x='A'..'G';@y=1..10;@s=qw/合計 平均/;use CGI':all';charset '';print header,
style({type,'text/css'},'table{border-collapse:collapse}td,input{text-align:
right;width:70px}td,th{border:1px solid gray}'),start_form,table(Tr[th(['',@x,
@s]),(map{$i=$_;$s=0;$n=0;td[$_,(map{$p=param"$x[$_]$i";($t=$s)==($s+=$p)||$n++
;($t=$r[$_])==($r[$_]+=$p)||$v[$_]++;textfield"$x[$_]$i"}0..$#x),($r[@x]+=$s,$s
,eval{$s/$n})[1,2]]}@y),td([$s[0],@r,'']),td[$s[1],map($v[$_]?sprintf('%.3f',(
$c++,($t=$r[$_]/$v[$_]),$v+=$t)[1]):'',0..@x),eval{$v/$c}]]),submit,end_form;
>>368 がいまいち糞コードになりきれていなかったので平均の計算も追加。おやすみ〜 ノシ >>379
>パスできない仕様はどうかと。
あまり細かいこと考えていないのでw
今日はもう寝ますがなんかすごそうなので明日動かしてみます。 >>379
昨日見てみましたがこれをCGI化するのは行数的にちょっと無理じゃないですかねぇ。
でも面白かったです。 初回起動時からの累計と過去1週間の日別カウンタ。
設定を変えれば一日の時間別みたいな使い方もできる。
($f,$l,$z)=qw{./counter.dat 7 5};use CGI':all';sub d{sprintf
'%d年%02d月%02d日(%s)',1900+$_[5],1+$_[4],$_[3],(qw/日 月 火 水 木 金 土/)[$_[6
]]}sub n{sprintf"%0${z}d回",shift}$n=time;$d=24*60*60;$p=$n-$n%$d;if(open F,
"+<$f"){eval{flock F,2};($s,@d)=map[split/\s+/],<F>;$s->[0]||=$n;$s->[1]++;$p==
$d[0][0]?$d[0][1]++:unshift@d,[$p,1];$n-=$d*$l;seek F,0,0;printf F"%d\t%010d\n"
,@$_ for@d=($s,grep$n<$_->[0],splice@d,0,$l);truncate F,tell F;close F}charset
'';print header,ul map{li b(n$_->[1]),d localtime$_->[0]}@d
7CMS
このスレで作った >>365 >>378 >>381 >>384 をモジュール化して一元管理する。
サードパーティー製品でもCGI.pmを使ったものなら大丈夫かも。
>>137 >>274 は一応動いた。
使い方は全部同じディレクトリに入れればいいだけだから。
use CGI':all';$d=param '*';@r=[$0=~/([^\\\/]+)$/,'START'];$p=$`;for$n(<*>){if($r
[0][0]ne$n&&$n=~/\.cgi$/){$r='';chdir$p;open F,$n;read F,$c,-s F;tie*G=*STDOUT,
'main';eval"package C$`;$c";untie*G;$r=~s/^.+?(\r?\n){2}//s;$r=~s/(<a\s.*?\?)(.
*?>)/$1*=$d&$2/gisx;$r=~s!(?=</for)!hidden -name,'*',-value,$d!egi;push@r,[
$n,$r.$@]}}AUTOLOAD{ref(shift)?($r.=join'',@_):bless[]}charset '';put header,
table Tr td{style=>'vertical-align:top;text-align:left;border:1px solid gray'},
[ul(li[map a({href,"?*=$_"},$d==$_?b($r[$_][0]):$r[$_][0]),0..$#r]),$r[$d][1]] 7メル
($p,$t,$s)=('/usr/sbin/sendmail','[email protected]','メールフォームから');use
CGI':all';$$_=param $_ for qw/f m/;($f)=$f=~/^([\w.-]{1,64}\@[\w.-]{1,128})$/i;
($m=substr$m,0,2**16)=~tr/\0/ /;$m=~s/\r\n?/\n/g;$m=~s/^\.$/../gm;charset '';put
header,startform,'あなたのメールアドレス',textfield(-name,'f'),br,'メッセージ',
br,textarea(-name,'m',-rows,10,-cols,60),br,submit,endform;if($f&&$m&&open M,
"| $p -t"){print(M join"\n",'Content-Transfer-Encoding: 8bit',"Reply-To: <$f>",
"To: <$t>","Subject: $s",'',$m,'')&&put '管理者へ送信しました。';close M} 7カレ
@c=([('silver')x 7],[('red',('black')x 5,'blue')],'lavender');use CGI':all';$s=
24*60*60;@t=localtime($t=time);@r=td{align=>'right',bgcolor=>$c[2]},font{color
=>$c[1][$t[6]]},b $t[3];@t1=localtime($i=$t-$s);while($t[4]==$t1[4]||$t1[6]<6){
unshift@r,td{align=>'right'},font{color=>$c[$t[4]==$t1[4]][$t1[6]]},$t1[3];@t1=
localtime($i-=$s)}@t2=localtime($i=$t+$s);while($t[4]==$t2[4]||0<$t2[6]){push@r
,td{align=>'right'},font{color=>$c[$t[4]==$t2[4]][$t2[6]]},$t2[3];@t2=localtime
($i+=$s)}charset '';put header,table Tr[map join('',@r[7*$_..7*($_+1)-1]),0..$#r]
何でもいいからボケッと見てないでおまいらも参加しる!
require "cgi-lib.pl";
&ReadParse;if($ENV{'REQUEST_METHOD'} eq 'POST'){if ($in{'imagefile'})
{open(WRITEFILE,'>', "datafile");binmode(WRITEFILE);print WRITEFILE $in{'imagefile'};close(WRITEFILE);}}
7うp掲示板
これ以上はムリポ
>>390
安全を保ちつつ複数ファイルに対応しる! 7ナビ
同一階層以下のHTMLにリンクを貼る。携帯用サイトマップみたいなもん。
$d='./';$e='s?html?';$n=10;@l=(['prev',-1],['next',1]);use CGI':all';sub r{my(
$d,$e)=@_;map{if(-d){r($_,$e)}elsif(/\.$e$/&&$p<=$c++&&$c<=$p+$n&&open F,$_){-B
||read F,$h,2**16;close F;$h=~/>\s*([^<>]*?)\s*<\/ti/is;[$_,$1||$_]}else{()}}
<$d/*>}$p+=param 'p';($d)=$d=~/(.+?)[\\\/]*$/;@r=r$d,$e;if($p<0){$p=$c-$c%$n;$c
=0;@r=r$d,$e}elsif(!@r){$p=0;$c=0;@r=r$d,$e}charset '';put header,dl dt(map a({
href=>"?p=".($p+$n*$_->[1])},$_->[0]),@l),dd{style=>'margin:0px'},join"\n",ol({
start=>1+$p},li[map a({href=>$_->[0]},$_->[1]),@r]),p"$c files"
7 httpd
これはCGIじゃないよ。
起動でlistenとhttp://127.0.0.1/index.htmlで表示。
Options Indexes があるはずも無いのでファイル名まで指定。
if(!grep(/^SERVER/i,keys%ENV)&&socket(S,2,1,0)&&setsockopt(S,65535,4,pack'l',1)
&&bind(S,pack'S n a4 x8',2,80)&&listen S,1){select+(select(S),$|=1)[0];while(
accept C,S){select+(select(C),$|=1)[0];@r=unpack"C*",getpeername C;if(recv(C,$d
,8192,0)&&$d=~/^GET ([\x21-\x7e]{1,256}) H/ and$p=join'/',map{s/\.+/./g;$_}grep
length,split/[\\\/]+/,$1){print C 'HTTP/1.0 ',do{$n="\r\n\r\n";if(open F,"./$p"
){binmode F;read F,$b,-s F;close F;"200$n$b"}else{"404${n}Not Found\n"}};undef
$b}close C;printf"$d%d.%d.%d.%d:%d\n%s\n",@r[4..7],256*$r[2]+$r[3],'-'x 64}} うぅ、ここPerl限定なのか…
PHPスレ欲しいな。
>>368
365だと367の最後の×100が反映されないんですが…。せんせぇ、お願いします。 昔作った今月のカレンダー表示スクリプト。
($$,$:,$;,$=)=(localtime)[3..6];printf"%2d%s",$_,++$=%7?$":$/for(print($;+
1900,'/',$:+1,"/$$\n",$"x(($=-=$$-1)%7*3))..28+($:-1?3-$:%7%2:!($;%4)))
#!/usr/bin/perl
if($ENV{'REQUEST_METHOD'}eq'POST'){read(STDIN,$b,$ENV{'CONTENT_LENGTH'});
foreach(split(/&/,$b)){($c,$d)=split(/=/,$_);$d=~tr/+/ /;
$d=~s/%([a-f\d]{2})/pack('H2',$1)/egi;$form{$c}=$d}open(F,'>>z.txt');
print F "$form{y}\n";close F}print"Content-type:text/html\n\n<html>
<form action=x.cgi method=post><input type=text name=y><input type=submit>
</form><br><br>";open(F,'z.txt');while(<F>){print "$_<br>\n"}print'</html>';
在庫から 7wikimini ドゾ。
YukiWikiMini の7行版みたいな感じです。
実行するにはWという名前のフォルダが必要です。
use CGI":all";charset$c=Shift_JIS;*i=*param;$f=FrontPage;$i=Index;$u=Update;$F=
i(P)||$f;sub e{a{href,"?E=1&P=".pop},@_}sub l($){a{href,"?P=@_"},@_}chdir W;$E=
i E;$U=$F eq$u;$I=$F eq$i;$,=$/;if($_=i T){open F,">$F";print F$_}$H=$I+$U;$t=$
H?join$/,map{localtime((stat)[9]).$_}sort{$U&&-M$a<=>-M$b}<*>:($/=!open F)||$E?
<F>:escapeHTML<F>;$E||$t=~s/([A-Z][a-z]+){2,}/-f$&?l$&:$&.e"?",$&/eg;put header
,start_html(-title=>$F,lang,ja,encoding,$c),l$f,$H?():e(Edit,$F),l$i,l$u,h1($F)
,$E?startform.hidden(P).textarea(T,$t,20,80).submit.endform:pre($t),$P,end_html
ページ削除機能が実装されてないので、もうちょっと改良が必要っす。
おまいら、このスレ出ている7行プログラムを、
インデント付けて整形するプログラムをどうか7行以内で書いてもらえませんか。
>>402
モジュールの力を借りずに Perl の構文解析器を七行で書くのは
絶望的だし、この手のコードは多分に恣意的なインデントや桁揃え
をしないと読み易くもならない。
ので、手っ取り早く「バラし」て流れを読みたいのなら、これで充分。
perl -MO=Deparse script.in > script.out
もちろんチャレンジ精神を否定しているのではないよ。:o) >>402
ム板の7行スレの方であったかもしれぬ。なかったかもしれぬ。 >>404
あったよ。Part 2 の 105,129,135,162,163,169,170 辺り。
…まぁ、通ってきた道なわけですよ。 <?php $s=(int)$_GET['s'];$d=array_map('intval',explode(' ', $_GET['d']));$n=
count($d);$m=max($d);$r=imagecreate($s,$s);imagecolorallocate($r,255,255,255);
$c=imagecolorallocate($r,128,128,128);$h=$s/2;for($i=0;$i<$n;$i++){$a=pi()*(2*
$i/$n-1/2);$t=$h*$d[$i]/$m;$p1[]=$h*(1+cos($a));$p1[]=$h*(1+sin($a));$p2[]=$h+
$t*cos($a);$p2[]=$h+$t*sin($a);imageline($r,$h,$h,$p1[$i*2],$p1[$i*2+1],$c);}
imagepolygon($r,$p1,$n,$c);imagepolygon($r,$p2,$n,imagecolorallocate($r,0,0,255
));header('Content-Type: image/gif');imagegif($r);?>
これはあまり安全じゃないよ。
フォーム作るゆとりなかったからアドレスバーの数字を直接いじってみて〜
http://127.0.0.1/r.php?s=200&d=5+6+9+8+3+7+2 先日、会社でちょっとした7行ゲームを作ったんだけど、
社内でやっちまったんで、持ち出せないんだよな。
7行といっても7分で出来るわけじゃないんだよな。
>>412
そんならカキコすんな
なんていってほしいわけ? ($name, $tripkey) = split(/\#(.+)/, $form{'name'});
if($tripkey){
$salt = substr($tripkey.'H.', 1, 2);
$salt =~ tr/\x3A-\x40\x5B-\x60\x00-\x2D\x7B-\xFF/A-Ga-f./;
$salt =~ s/[^\.-z]/\./g;
$trip = '◆'. substr(crypt($tripkey, $salt), -10);}
print "$name$trip";
2chトリップ判定。
>>416
気持ちはわかるがそれはwebprogではない 6行RSSリーダー 設置して.cgi?以降にfeedのURLを入力
モジュールてんこ盛りなのでもっと短く書けるはず
use LWP::Simple;use CGI":all";use XML::RSS;$h = new CGI;$r = new XML::RSS;
$r->parse(get("$ENV{'QUERY_STRING'}"));%c = %{$r->{'channel'}};
print $h->header.'<a href="'.$c{'link'}.'">'.$c{'title'}.
"</a><br>$c{'description'}<br>";print "<ul>";for $item (@{$r->{'items'}}){
print '<a href="'.$item->{'link'}.'">'.$item->{'title'}.
"</a><br>$item->{'description'}<br>";}print "</ul>".$h->end_html;
>>421
まさか7行で2chに書き込めるスクリプトを?! 書き込みのモジュールなんてあった??<<Perl脳
>>425
単にPOSTするだけって単にPOSTしただけじゃread.cgiに弾かれる 私はPHPならなんとか作れそうだが、それ以前に2chの仕様を勉強しなくちゃだな。
>>428
それすら知らなかった漏れは百回くらい正規表現の勉強でもしましょうか? >>420
縮めた。
#!/usr/bin/perl
use LWP::Simple;use XML::RSS;$r=new XML::RSS;parse$r get$ENV{QUERY_STRING};use
CGI":all";%c=%{$r->{channel}};put header,a({href,$c{link}},$c{title}),br,$c{$d=
description},br,ul(li[map a({href,$_->{link}},$_->{title}).br.$_->{$d}.br,@{$r
->{items}}]),end_html >>430
sugeeeeeeeeeeeeeeeeeeeeee
問題無く動いた >>430 からもうちょい縮めた上で HTML がまともになるよう追加。
#!/usr/bin/perl
use CGI":all";use LWP::Simple;use XML::RSS;$r=new XML::RSS;sub A{a{href,$_[0]->
{link}},$_[0]->{title}}charset$C="UTF-8";parse$r get pop;%c=%{$$r{channel}};put
header,start_html(-encoding,$C,lang,ja),h1(A\%c),p($c{$d=description}),ul(li[
map A($_).br.$$_{$d},@{$$r{items}}]),end_html
二行半も空いてるけど付け加える機能を思いつかず。 >>432
未読管理機能なんかオススメ
二行半でやる方法は思い浮かばないorz
むしろ、どういう過程を経て効率的なソースが引けるようになったのかの方に興味あり苦笑
どこか参考にしたサイトとかあります? >>433
> 未読管理機能
ほい。新着タイトルを太字表示。
#!/usr/bin/perl
use CGI":all";use LWP::Simple;use XML::RSS;$r=new XML::RSS;dbmopen%n,"7rssrdr",
420;charset$C="UTF-8";sub A{($t,$l)=@$_{"title","link"};a{href,$l},$n{$l}++?$t:
b$t}parse$r get pop;%c=%{$$r{channel}};put header,start_html(-encoding,$C,lang,
ja),h1(A$_=\%c),p($c{$d=description}),ul(li[map A.br.$$_{$d},@{$$r{items}}]),
end_html
> どこか参考にしたサイトとかあります?
駱駝本とか perldoc とか。冗談でも何でもなく。
この遊びのノウハウなら http://cm.xrea.cc/techinfo.cgi に。 >>434
>駱駝本とか perldoc とか。
さもありなんというか結局質の高い基本が一番役にたつんだろうな 月次移動可能なカレンダー。c.phpで保存。
<?php $a=q("Y-m-t","$_GET[y]-1");$d=explode("-",$a);$y="<a href=?y=";$v=$d[0];
$w=$d[1];$z="</tr><tr>";$m="$v-$w";$p=q("Y-m",$w-1,1,$v);$n=q("Y-m",$w+1,1,$v)
;echo"<html>$y$p><</a>$m$y$n>></a> $y c.php>now</a><table border=1><tr>$z";$f=
q("w","$m-1");for($i=-6-$f;$i<$d[2]-q("w",$a)+7;$i++){echo($i<1-$f)?"<th>".q(
"D",$w,$i,$v)."</th>":(($i<1||$i>$d[2])?"<td></td>":"<td>$i</td>");if(($i+$f)%
7==0)echo$z;}echo"</tr></table></html>";function q($x,$w,$i=0,$v=0){return($i)
?date($x,mktime(0,0,0,$w,$i,$v)):date($x,strtotime($w));}?>
>>438
「now」も要らんと思う。
<?php list($v,$w,$d)=explode("-",$a=q("$_GET[y]-1","Y-m-t"));$f=q("$v-$w-1","w"
);echo$l="<a href=?y=",q($w-1,"Y-m",1,$v),"><</a>$v-$w$l",q($w+1,"Y-m",1,$v)
,">></a> $l>now</a><table><tr>";for($i=-6-$f;$i<$d-q($a,"w")+7;){echo$i<1-$f
?"<th>".q($w,"D",$i,$v)."</th>":"<td>".(($i<1||$i>$d)?"":$i)."</td>";if(($i++ +
$f)%7==0)echo"</tr><tr>";}function q($w,$x,$i=0,$v=0){return date($x,$i?mktime(
0,0,0,$w,$i,$v):strtotime($w));}?></tr></table>
PHPは不得手なんで、これよりもっと縮む筈。 >>439
凄いですね。いろんなことができるんだ、と感心しきり。
少しだけ縮めた。
<?php list($v,$w,$d)=explode("-",$a=q("$_GET[y]-1","Y-m-t"));$f=q("$v-$w-1","w"
);echo$l="<a href=?y=",q($w-1,"Y-m",1),"><</a>$v-$w$l",q($w+1,"Y-m",1),">></a>
$l>now</a><table><tr>";for($i=-6-$f;$i<$d-q($a,"w")+7;){echo$i<1-$f?"<th>".q($w
,"D",$i)."</th>":"<td>".($i<1||$i>$d?"":$i)."</td>";if(($f+$i++)%7==0)echo"</tr
><tr>";}function q($w,$x,$i=0){global$v;return date($x,$i?mktime(0,0,0,$w,$i,$v
):strtotime($w));}?></tr></table> 手抜きバージョン。取り合えず表示されるみたいなので…
<?php function q($w,$x,$i=0){global$v;return date($x,$i?mktime(0,0,0,$w,$i,$v):
strtotime($w));}list($v,$w,$d)=explode("-",$a=q("$_GET[y]-1","Y-m-t"));echo$l="
<a href=?y=",q($w-1,"Y-m",1),"><</a>$v-$w$l",q($w+1,"Y-m",1),">></a> $l>now</a>
<table><tr>";for($i=-6-$f=q("$v-$w-1","w");$i<32;){echo$i<1-$f?"<th>".q($w,"D",
$i)."</th>":"<td>".($i<1||$i>$d?"":$i)."</td>";if(($f+$i++)%7==0)echo"</tr><tr>
";}?></tr></table>
HTMLダメダメの超手抜きバージョン。無理やり5行にしてみた。
<?php list($v,$w,$d)=explode("-",q("$_GET[y]-1","Y-m-t"));echo$l="<a href=?y=",
q($w-1,"Y-m",1),"><</a>$v-$w$l",q($w+1,"Y-m",1),">></a> $l>now</a><table>";for(
$i=-6-$f=q("$v-$w-1","w");$i<32;){echo$i<1-$f?"<th>".q($w,"D",$i)."</th>":"<td>
".($i<1||$i>$d?"":$i)."</td>";if(($f+$i++)%7==0)echo"</tr><tr>";}function q($w,
$x,$i=0){global$v;return date($x,$i?mktime(0,0,0,$w,$i,$v):strtotime($w));}?>
閉じタグ無しでいいなら
<?php function q($w,$i=1,$x="Y-m"){global$v;return date($x,$i?mktime(0,0,0,$w,
$i,$v):strtotime($w));}list($v,$w,$d)=explode("-",q("$_GET[y]-1",0,"Y-m-t"));
echo$l="<a href=?y=",q($w-1),"><</a>$v-$w$l",q($w+1),">></a> $l>now</a><table>"
;for($i=-6-$f=q("$v-$w-1",0,"w");$i<32;){echo"<td>",($i<1-$f?q($w,$i,"D"):($i<1
||$i>$d?"":$i)),($f+$i++)%7?"":"<tr>";}
>>334 3年越しの7clap.
#!/usr/bin/perl
use CGI":all";charset$c=Shift_JIS;sub d{($m,$m,$h,$d,$m,$y)=localtime(time-pop);
$l[0]=(190001+$y*100+$m)*100+$d}param(K,$k=1+param K);($w=escapeHTML(param W))=~
y/\0- / /s;($C,$M,$L,$E,@M)=<DATA>;open L;flock L,2;open C;@l=d>(@c=<C>)[-1]?(d,
(0)x25,$/):split/<>/,pop@c;@c<14||shift@c;$l[$_]++for$h+2,1;open C,">$C";print C
@c,join"<>",@l;d 1209600;open M;@m=grep$l[0]<=$_,<M>;open M,">$M";print M@m,""ne
$w&&d."<>$h<>$w<>\n";put header,start_html(-encoding,$c,lang,ja),$k<10?($M[rand@
M],startform,p(hidden(K),Comment,textfield(W),submit Clap),endform):p$E,end_html
__DATA__
log.dat
mes.dat
>lock.dat
沢山の拍手を有り難うございました!
拍手が送信されました。ありがとうございました!
拍手が送信されました。ありがとうございますた!
拍手が送信されました。ありがとさ〜ん!
・flock非保護。
>>327 7kaiseki.cgi
#!/usr/bin/perl
use CGI":all";charset$c=Shift_JIS;($P,$C,$M)=<DATA>;($p=param P).$/ne$P&¨sub
l{(sort@_)[-1]/10||1}sub d{@p=localtime time-86400*pop;$g=(190001+$p[5]*100+$p[4
])*100+$p[3]}open C;%c=map{/<>/;$`,$'}<C>;($l,@l)=$c{$q=param(T)||d}=~/\d+/g;put
header,start_html(-encoding,$c,lang,ja),h1($q),table((map{Tr td[$z++.':00',$_+0,
"/"x($_/l@l)]}@l[0..23]),Tr td[Total,$l+0,""]),h1(Mes),dl(map{s/<>$//;/<>/;$`!=$
z&&dt($z=$`.':00'),dd$'}grep{s/$q<>//}open(M),<M>),h1(Past14day),table(map{Tr td
[a({href,"?P=$p&T=".d$x++},$g),$_,"/"x($_/l@s)]}@s=map{$c{d$_}+0}0..13),end_html
__DATA__
password
log.dat
mes.dat
・HTML適当。
・ファイルロックなし。
・DATAの1行目にパスワードを設定、「?P=password」でリクエスト。
>>446
cos this thread is very good! don't you think so?
| | ガガガガガッ
| |
人
∧_∧ < >_∧∩
( ・∀・) 人`Д´)/ ←>>140
と ) < >_∧∩
Y /ノ .人`Д´)/ ←>>155
/ ) < >_∧∩
_/し' //. V`Д´)/ ←>>320
(_フ彡 / 誰でも簡単にネットで稼げる方法など
参考までに、
⇒ 『半藤のブブイウイウレレ』 というサイトで見ることができます。
グーグル検索⇒『半藤のブブイウイウレレ』
WUFNFIRDC9
☆ 日本の、改憲を行いましょう。現在、衆議員と参議院の
両院で、改憲議員が3分の2を超えております。
『憲法改正国民投票法』、でググってみてください。国会の発議は
すでに可能です。平和は勝ち取るものです。お願い致します。☆☆
プログラミングを誰でも習得できる方法は、「前場アキドルのプログラミングマスター方法」というブログで見られるらしいよ。ネットで調べると見られるらしいです。
9PV1J