七行プログラミング

七行プログラミング (452ﾚｽ)
上下前次 1-新

139: 03/04/20 04:57 ID:??? AAS
>>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?http://.+$!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 的に正しくする為のものなんだけど
(文字コードや言語を指定するから化けずに済む)、そーゆーの
より「似せる」方を重視してるのかな?

140(1): 山崎渉 [（＾＾）sage] 03/04/20 05:57 ID:??? AAS
　　 ∧＿∧
　　（　　＾＾）＜ぬるぽ（＾＾）

141: 03/05/09 00:09 ID:seZLVSXV(1)調 AAS
∩(ﾟ∀ﾟ∩)age

142(1): 03/05/09 21:42 ID:??? AAS
えぇと、みんななんか面白そうなコトやってるね。
俺も参加しよう思ったけど…読めない所が多いや。

143: 03/05/10 00:35 ID:??? AAS
>>142
過疎スレだから、分からんトコは*自分で調べた上で*
適宜質問してくれれば良いかと。

144: 山崎渉 [（＾＾）] 03/05/22 02:04 ID:??? AAS
━―━―━―━―━―━―━―━―━[JR山崎駅（＾＾）]━―━―━―━―━―━―━―━―━―

145(2): 03/05/28 05:53 ID:dphN6O/1(1)調 AAS
ポートスキャナー。

# 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らへんもかなり適当なので動かないかもしれますん。
そんときは自分で手を加えるなりして動くようにしてください。

147(1): 145 03/05/28 19:26 ID:MVa2hSnY(1)調 AAS
縮まった。

# 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と同じ理由で動かないかもしれますん。

これ以上縮まらないヨカソ…。

148: 03/05/28 20:05 ID:Edz5ugJ5(1)調 AAS
>>147
板違い

149: 145 03/05/28 21:50 ID:RXOOGbeu(1)調 AAS
言ってるそばから縮まった。

# 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}}

150: 03/05/29 12:44 ID:??? AAS
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}}

151: 03/07/01 18:25 ID:??? AAS
#!/usr/local/bin/perl
print "Hello World!";
print "Hello World!";
print "Hello World!";
print "Hello World!";
print "Hello World!";
print "Hello World!";

152: 03/07/06 12:17 ID:??? AAS
お前ら！すごいですね

153: 山崎渉 [（＾＾）] 03/07/15 11:13 ID:??? AAS
　__∧＿∧_
　|（　　＾＾）|　＜寝るぽ（＾＾）
　|＼⌒⌒⌒＼
　＼ |⌒⌒⌒~|　　　　　　　　　山崎渉
　　 ~￣￣￣￣

154: 03/07/24 09:35 ID:??? AAS
おもしろそう・・・

155(1): 山崎渉 [（＾＾）sage] 03/08/02 02:38 ID:??? AAS
　　 ∧＿∧
　　（　　＾＾）＜ぬるぽ（＾＾）

156: ぼるじょあ ◆ySd1dMH5Gk [（＾＾）] 03/08/02 05:21 ID:??? AAS
　　　　∧＿∧　 ∧＿∧
ﾋﾟｭ.ｰ　（　・３・） (　　＾＾）＜これからも僕たちを応援して下さいね（＾＾）。
　　＝〔~∪￣￣￣∪￣￣〕
　　＝ ◎――――――◎ 　　　　　　　　　　　　　　　　　　　　　山崎渉&ぼるじょあ

157: 山崎渉 [（＾＾）] 03/08/15 22:57 ID:??? AAS
　　　 (⌒V⌒)
　　　│ ＾＾ │＜これからも僕を応援して下さいね（＾＾）。
　　⊂|　　　　|つ
　　　（＿）（＿）　　　　　　　　　　　　　　　　　　　　　　山崎パン

158(1): 03/08/17 15:16 ID:??? AAS
山崎ばかりなのもナニなので 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/ に。

159: 03/08/17 15:19 ID:??? AAS
>>158
s/？xHHHH/＆#xHHHH/;

160(1): 03/08/18 07:15 ID:??? AAS
ちょっと長くなったけど、初心者質問スレを荒らしている彼に捧げよう。(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=>400s=>10w=>{'キック'=>{d=>60a=>60},'パンチ'=>{d=>20a=>70},}}
,{n=>'荒らし',h=>300s=>0w=>{'キック'=>{d=>100a=>60},'パンチ'=>{d=>40a=>70}}
},{n=>'夏厨',h=>200s=>20w=>{'キック'=>{d=>80a=>90},'パンチ'=>{d=>10a=>100}}
}];

161: 03/08/18 12:36 ID:??? AAS
>>160
ﾜﾛﾀ

162: 03/08/19 11:57 ID:??? AAS
縮めて 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=>400S=>10W=>{'キック'=>{D=>60 A=>60},'パンチ'=>{D=>20A=>70 }}},
{N=>'荒らし',H=>300S=>0 W=>{'キック'=>{D=>100A=>60},'パンチ'=>{D=>40A=>70 }}},
{N=>'夏厨', H=>200S=>20W=>{'キック'=>{D=>80 A=>90},'パンチ'=>{D=>10A=>100}}},
];

163: 03/08/20 07:02 ID:??? AAS
メッセージを削るという安直な方法で七行達成。

#!/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

164(1): 03/08/28 05:11 ID:??? AAS
「素早さ」を実装したいけど、どうも巧くない。

#--- 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

165: 03/08/28 12:01 ID:??? AAS
>>164
まだやってたのかよｗ

がんがれ！

166(1): 保守 03/10/04 05:54 ID:??? AAS
$$_=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/
}}

167: 03/10/05 03:33 ID:??? AAS
本家スレで出てた切符問題の 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 だと不可。

168: 03/10/05 20:23 ID:??? AAS
コマンドライン・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を含めない

169: 03/10/08 01:14 ID:??? AAS
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'}

170: 7blosxom 03/12/01 03:01 ID:i/vnv4B8(1/4)調 AAS
#!/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),<Fhr,"\n"),close F}}put end_html

171: 7blosxom 03/12/01 03:13 ID:i/vnv4B8(2/4)調 AAS
久しぶりに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/ ... 正規表現が手抜きな為、数字+文字の組合せは無視される。

172: 03/12/01 06:28 ID:i/vnv4B8(3/4)調 AAS
訂正。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 とアクセスする。

173(1): 128 03/12/01 18:34 ID:xLzdr2os(1)調 AAS
それじゃ漏れも久々に投稿。
スレッド式掲示板です。
データ用ディレクトリ 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
------------------------------------------------------

174(3): 03/12/01 20:35 ID:lEOu0k9S(1)調 AAS
モジュールありだったらいくらでも短くできるのでは？

175(5): 03/12/01 23:22 ID:i/vnv4B8(4/4)調 AAS
#!/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<Fhr;
close F}}put end_html
__END__

変更点
< shift@i はいらなかった。
< [5,4,3] をスライスに変更。
< 変数をまとめて宣言。

>174
そうだね。過去ログを読めばわかる通り、それは人によって意見がわかれる所。標準モジュールはokとか。
自分は、モジュールを使っても既存のリソースの有り合わせでおもしろいものが出来ればいいなと思ってる。
wikiもCPANのWiki::関連のモジュールを使えば制限内でも、もっと機能追加出来そうだし。
ただし、短くするためにわざわざモジュールを作る気はなし。

176: 03/12/02 14:16 ID:??? AAS
>>175
h2タグの中にpreタグ(と本文)が入るのですが・・・

177(1): 03/12/02 18:25 ID:??? AAS
>>175
Blosxom 知らんかったので和訳サイト読みながらゴニョゴニョ中。
動作確認用の txt ファイルセット用意してくれたら嬉しい。日付と
中身が違うファイルを沢山作るのは結構ダルい。;)

178: 03/12/02 22:21 ID:??? AAS
>>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

179: 03/12/02 23:32 ID:??? AAS
>>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}

180(1): 03/12/03 02:02 ID:??? AAS
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<Fhr}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

181: 03/12/03 02:13 ID:??? AAS
>>180
1月ダメじゃん…。

:($m=$_-1): => :($m=$_):
!($m&&$m-$M) => !($m&&$m-$M-1)

182(4): 03/12/03 06:43 ID:4m1BwtbU(1)調 AAS
>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<Fhr
;close F}put end_html;

若干仕様変更。
- カテゴリ名は /^\D\w*$/
- ファイルの指定は、PATH_INFO の末尾のみ有効。
- findの対象はカレントディレクトリ以下のみ。(絶対パス指定できるのは、流石にちょっと

BTW,ファイルハンドルってスコープ抜けたら勝手にcloseされるんだっけ？perlって。

183: 03/12/03 07:46 ID:??? AAS
>182
テスト不十分だった。訂正
> $i[-1]!~/\.txt$/||/^$i[-1]$/

184: 7thread 03/12/03 09:43 ID:??? AAS
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+http://.+$!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

185(1): 03/12/03 20:55 ID:??? AAS
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+http://.+$!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

186(4): 03/12/03 23:13 ID:??? AAS
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<Fhr}put end_html

>>182
'..' さえ防いだら大丈夫な気も…
既に開かれてるファイルハンドルを open し直すと、開いていたファイルは
close されてから新しいファイルを open するので、close は明示しなくても
可な筈。
http://perldoc.com/perl5.8.0/pod/func/close.html

187: 03/12/03 23:57 ID:??? AAS
>>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<Fhr}put end_html

188: 03/12/04 01:07 ID:??? AAS
なにこのすれ(;´Д｀)

189(1): 128 03/12/04 03:24 ID:h3ZU5uFM(1/2)調 AAS
皆、お疲れ〜。
元気っぽいですな。

>>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+http://.+$!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

190: 128 03/12/04 03:32 ID:h3ZU5uFM(2/2)調 AAS
オオボケでした。
開発中のを送ってしまった。

こっちです。

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+http://.+$!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

191: 03/12/04 06:04 ID:??? AAS
>>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+http://.+!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 周りに。

192: 03/12/04 21:36 ID:b7RTKokI(1)調 AAS
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は無理かなぁ

193(2): 128 03/12/05 03:38 ID:2kvaGCEL(1)調 AAS
乙ｶﾚｰっす。

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+http://.+!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=><DATAencoding,$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;}

194(2): 03/12/05 06:41 ID:1VQJofzV(1)調 AAS
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+http://.+!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

195(1): 03/12/05 06:41 ID:??? AAS
>>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+http://.+!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;}
七氏

196: 195 03/12/05 06:42 ID:??? AAS
>>194
むぅ。(w

197(1): 03/12/05 07:03 ID:??? AAS
>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="..." となるので特に影響はないけど。

198: 03/12/05 13:00 ID:??? AAS
>>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 だと開いたままいぢれたけど。

199: 128 03/12/05 18:07 ID:??? AAS
皆様。乙！
sage 機能いいですねぇ。

>>197
チェックありがとっす！
-style ってバージョンによって違ったんですね。
2.98でも確認できました。

修正版です。$/の定義はズルしてます。（ｗ

#!/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!.+http://.+!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;}

200(6): 03/12/05 22:30 ID:??? AAS
マ板から誘導されました。
既出と承知しつつ、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;}

201(2): 03/12/06 00:29 ID:??? AAS
>>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/ に載せていいですか? ＞オリジナル作者各位
と言っても実際に載せるのは年越してからになると思いますが(苦)。

202(1): 03/12/06 17:16 ID:??? AAS
ｽﾚ汚し失礼。簡易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}

203: 128 03/12/07 00:41 ID:??? AAS
>>201
7ch と 7thread のオリジナル作者です。
どうぞ載せてくださいませ。

204: 03/12/07 03:57 ID:enSfwhvY(1/3)調 AAS
>201
参加してたんだw。どぉも。一年ぶりです。
<- 7blosxomのプロトタイプ提供者(===7wiki)です。

> http://cm.xrea.cc/ に載せていいですか?
他にも幾つかストックあるので、公開時には掲載よろしくお願いします。m(_ _)m

205: 7uploader 03/12/07 09:25 ID:enSfwhvY(2/3)調 AAS
もっと詰めてからにしようと思ったけど、とりあえず公開します。後はよろしく:)

#!/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)
[ ] 他のブラウザへの対応。

206: 03/12/07 09:39 ID:??? AAS
>>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)

207(1): 03/12/07 20:49 ID:enSfwhvY(3/3)調 AAS
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が返らなかった。
端末への対応、悪化してたりしたらゴメン(焦

208: 7hoo 03/12/09 13:46 ID:+unlQkjh(1)調 AAS
PerlHoo(http://www.webreference.com/perl/xhoo/)です。
ディレクトリ型のリンク集。後１行がなかなか縮まらない >_<。

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 {} \;

210: 03/12/10 15:33 ID:??? AAS
おつかれ〜

211: 200 03/12/11 21:24 ID:??? AAS
連投でうざかったらすみません。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行です。

//項目が全部ひらがななのは自サイトで使う用なので。苦笑

212: 200 03/12/11 21:51 ID:??? AAS
それと、2行目の$Fでログファイル名、$nで自ファイル名を変更可能。
3行目の先頭にある18を「最大ログ数にしたい数-2」に変更すれば
最大ログを設定できます。

213(1): 03/12/12 02:52 ID:??? AAS
● 最低限押さえるべきポイント for Perl
・識別子は全て一文字にする
・演算子の優先順位を把握して冗長な括弧を全て省く
・サブルーチンは頭の方で宣言して routine(); から括弧を省く
・ブロックの最後の文はセミコロンを省略できる ("main" ブロック然り)

● 基本縮めテクニック for Perl
・使用する関数に関してマニュアルを精読する :)
・bare word ([A-Za-z]\w*) を使ってクォートを省く
・長い名前の関数を複数回使うなら別名を作る (*P=*param;)
・特殊変数や暗黙の代入を積極的に使う
・(スカラー|リスト|ブール)コンテキストでの各挙動を意識する

● Tips for Perl
・同名のファイルハンドルを open し直すなら close は要らない (>>186 参照)
・最も短くかける無限ループは "{ ... ;redo}"

● 「使える」Web プログラムを目指す人に
・XSS 脆弱性に配慮する
・文字コードに依存する定数は外部へ追い出す
・「想定外の入力」でどのように誤作動するか確認する
・多機能より堅牢を

Tips を充実させたいところ。

214: 03/12/12 19:15 ID:O0tbE8Vp(1/2)調 AAS
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の違いには注意。

215(1): PATH_INFO 内での '..' 03/12/12 19:52 ID:O0tbE8Vp(2/2)調 AAS
>>186 読んで思い出した。
PATH_INFO に .. が現れるのってどういった場合なんでしょう？
親ディレクトリより上を参照出来る危険があるのかなと思ったけど。
QUERY_STRINGからなら勿論チェックが必要ですが。
PATH_INFOの場合CGI自体が呼ばれない様な気がする。

以下のようなリクエストを試してみました

http://www.example.com/bar.cgi/../
http://www.example.com/~foo/bar.cgi/../
http://www.example.com/~foo/bar.cgi/../~foo/bar.cgi

bar.cgi/../ とすると、
サーバーは bar.cgi のあるディレクトリの indexを返してくる様なんだけど。
これって、サーバーの実装に依存するのかな？apache,IIS他幾つかのサイトで確認。
流石にDocumentRootより上を参照しようとするとBad Requestになるけど。

今、丁度7行HTTPdを公開しようと調整していたので、自分でも調べるつもりですが
もし、詳しく知ってる方いたらフォローお願いします。m(_ _)m

216(1): 03/12/13 16:17 ID:??? AAS
ご自由に編集して下さい。(´ω｀
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 を参考に色々いぢってみました。

217(1): 03/12/15 02:27 ID:??? AAS
>>215
/foo%5C..%5C..%5Cbar なんてのをそのまま Win 鯖で食うとヤバいかと。

218(2): 7memo 03/12/15 13:08 ID:??? AAS
ちょぼちょぼいぢり。

#!/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

219: 03/12/15 13:18 ID:??? AAS
>>218
s/\$F/\$_/g;　＿|￣|○

220(2): Unit7.pm 03/12/15 17:14 ID:zoqm3JaO(1/3)調 AAS
#!/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 で実行できるかな？と互換性を期待したけど、無理だった。

221(1): 03/12/15 17:21 ID:zoqm3JaO(2/3)調 AAS
>>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");
}
}

222(1): 03/12/15 18:50 ID:zoqm3JaO(3/3)調 AAS
>>220.diff
- $o ... 成功したテストの数
+ $O ... 成功したテストの数

>>221 の捕捉。
基底クラスを Test::Unit::TestCase に変更するとTestRunner.pl でも実行できます。
でも、Test::Unit::TestCase => Unit7の互換はなし。

>>216
ありがとう。早速使わせてもらってます。
>>218
()や{}の末尾では、引数の型宣言なしに弧省略出来たと思う。

nice tricky closure.
FP的なアプローチってコードの短縮に貢献出来るテクニック多いよね。

>>217
Windows 環境の事すっかり忘れてた。
でも、エンコードしなきゃ大丈夫じゃない？ %5C

223: 03/12/16 04:29 ID:??? AAS
>>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 は周りに無いので未調査。

224(1): 7memo 03/12/16 14:56 ID:??? AAS
これで一旦完成。

#!/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

225: 03/12/20 01:06 ID:??? AAS
>>224
お疲れ様です。
使いやすいしいい感じ。

226: ?O?????|?X 03/12/28 16:50 ID:7YW8A3U6(1)調 AAS
c

227: ?O?????|?X 03/12/28 21:24 ID:7YW/F4a6(1)調 AAS
b

228: ?O?????|?X 03/12/30 16:01 ID:2yZZI8A2(1)調 AAS
ccv

229: [　] 04/01/02 08:14 ID:??? AAS
(・Д・）

230: 04/01/18 12:18 ID:??? AAS
テクニックメモを基に既存プログラムのメンテ中。
・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>'

231: 7ch.cgi 04/01/18 14:25 ID:??? AAS
#!/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?http://.+!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 }

232: 04/01/18 20:09 ID:Hq0k6H3L(1)調 AAS
CCC

233: 7blosxom 04/01/19 14:33 ID:??? AAS
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$!}

234(3): 04/01/20 15:14 ID:F518czSp(1)調 AAS
激しく板違いなんですけど
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ルーチンで済ますことってできますか？

235: 234 [age] 04/01/20 15:22 ID:??? AAS
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";
}
}
}
}
}
間違えました。訂正しまつでつ。

236: 234 [age] 04/01/20 15:25 ID:??? AAS
ついでに2回のforルーチンでもいいです。

237: 04/01/20 16:52 ID:??? AAS
>>234
コードを短くしたいという意図はわかるけど、
実用的なプログラムでは、ここに挙がっている様なテクニックは、
なるべく使わない方が良いよ。

238(1): 04/02/01 15:24 ID:??? AAS
#!/usr/bin/perl
require 'bbs.pl';
bbsmain();

3行で掲示板作ったぞ

上下前次 1-新書関写板覧索設栞歴

あと 214 ﾚｽあります
ｽﾚ情報赤ﾚｽ抽出画像ﾚｽ抽出歴の未読ｽﾚ AAｻﾑﾈｲﾙｱﾎﾞﾝOFF

ぬこの手ぬこTOP 0.050s