七行プログラミング
>困りました。:) ごめん。パズルに夢中で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>"; 拙作をまとめていた isweb のサイト、広告ウザいので引っ越し。 ついでに配布体裁整え。http://calorymate.s15.xrea.com/ 7wiki と 7files 、参加作という事でサイトに載っけていいですか? >>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="..." となるので特に影響はないけど。 read.cgi ver 07.5.1 2024/04/28 Walang Kapalit ★ | Donguri System Team 5ちゃんねる