Perlでリクに答えるスクリプトを作るスレ

>>490
乙ｗ死ねｗ

>>490
リアルで会ったら頭蹴り飛ばして殺してやるのにｗ

人格異常者だと思われてるから、普段リアルで誰にも相手されないよ〜

会社訪問した際、面接官に目が包丁のようだよと言われますた。
腹が立ったので、帰る際後ろから面接官の頭蹴り飛ばしてやりました。

電車に乗ると、たくさんのひとの頭を蹴り飛ばさなければならないので
怖くて乗れません。

別にいつ死んでもいいので、PG組んでます。

(;´д`)

世の中みんないい人ばかりじゃないしねぇ

ファイル内って書いてて答えがこれ？
C>RENAME *.gif *.bmp
死ね

491-495
で、だれ？おまえら

おれだよ、おれ
500

とりあえずここには
>>478以外、まともな人間はいなさそうだｗ

これ書いてる奴が？
% mv *.gif *.bmp

>>490
(;´д`) いや　話しかけてこないで。さよなら

ローマ字で入力すれば、あらゆるその読みの文字にマッチするスクリプト
gyouで行やら業やらぎょうやらギョウやらgyouやら

migemo

だってあれ完璧じゃないんだもん

>>506
migemo の「辞書」が完璧じゃないんだろ？
「辞書」をしっかり作れ。Perlでmigemoみたいなこと
をやるにせよ、辞書が命だ。

おまえも>503おまえも>506
死ね

>>508
うはｗｗｗｶｯｺﾖｽｗｗｗｗ
俺にも氏ねって言ってぇぇｖｖｖｖｖｖ

>509
しねしねしねー♪从´∇｀从

カウンターで
0＝あ
1＝1
略
49＝を
50＝ん
って感じに変換するにはどーすればいいんですか？

日本語でおｋ

>>511
my %c = (
　'0' => 'あ',
　'1' => '1',
# 略
　'49' => 'を',
　'50' => 'ん'
);

などと作っておいて $c{$count} のような感じで対応する文字列を求める。

>>1
楽天とかで任天堂DSを購入するスクリプト組んでくれよ。人力じゃ無理　買えないｗ

連投スクリプトください

#!perl
use LWP::Simple;
while (1) { get 'http://pc8.2ch.net/test/bbs.cgi'; }

連投スクリプトください

連投規制、バーボンに引っ掛からない２ｃｈ投稿スクリプト希望

#!perl
use LWP::Simple;
while (1) {
get 'http://pc8.2ch.net/test/bbs.cgi';
sleep 30;
}

明らかに悪用する気満々だから嫌。

スレを埋めるときに使うんです（＞＜；）

スレ埋めは、自分でスクリプトを書ける者にのみ許される神聖なる儀式であルッ!!

思いっきり悪用の気配やんか

あんま調子にのんなよ

テキスト処理でおうかがいします。
半角数字と全角数字が混在したテキストがありまして、
一桁のみの数字は全角、二桁以上の数字は半角に統一したいのです。
中身を見てみると、「3３」とか「67９」とかになっていて、
どういう入力をしたのか不思議でなりません。
何かよいお知恵はないでしょうか。

Perl 5.8.1、Mac OS XのTerminalで作業をしています。
入力ファイルのエンコードはUTF-16（中国語処理のため）、
use utf8;で処理しています。

適当に正規表現で変換してったらいいんじゃないの？

s/１/1/

全部半角にしてから全角に直すだな

>>526
>>527

こんな感じで書いてみました。

while(<>) {
tr/[０-９]/[0-9]/;
s/(￥D)１(￥D)/$1１$2/g;
（中略）
s/(\D)9(\D)/$1９$2/g;
print;
}

ただ、これだと2回同じ処理をしないといけないですよね。
最初の処理でtr行、次の処理でs行になるんでしょうか。
これを効率よく1回の処理ですませたいのですが、いいやり方をご存知ないですか？

use utf8;
use Unicode::Normalize;

$str = NFKC($str);
$str =~ s/(?<!\d)(\d)(?!\d)/(my $ret = $1) =~ tr[0-9][０-９]; $ret/ge;

これでどうだろう。

>>528
逆。数字をまず全部全角にして、
その後2文字以上連続する全角数字を半角にする。

TextSS　のWindowsXP(Professional)64bit化おながいします

もしくは64bitにネイティブ対応したテキスト置換ソフトありますか？

そういや64bitにネイティブ対応している２ｃｈブラウザてありましたっけ？

テキスト置換で64bitに対応してると
なんかいいことあんの？

>>531
マルチ + スレ違い乙

>530

ご指摘どうもありがとうございます。
他にも処理が山ほどあり、あまり時間がなくてテンパってました。

>529

うまくいきました。どうもありがとうございました。
こういうときに先読み・後読みを使うんですね。
教えていただいたものを流用して、
2桁のみ半角にすることもできました。

>>529 を書いて気が付いたんだが、Encode::JP::H2Z が変換できるのは
カタカナだけなんだな。

日本語処理で凝ったことしようと思ったら、Jcode なんかねぇ…。

>>532
読み込みの段階で６４ビットは有利

うそつけ

>>528
「￥」と来たか。「\」ではないと。

すいません、リクです。

数字を有効数字の桁数で丸めるスクリプトを探しています。
例えば、round(数字, 桁数)の形で使うとすると、
round(-12345.067, 4)
round(-12345.067, 7)
round(0.0567, 1)
round(1234567890123456, 4)
は、それぞれ
-12350
-12345.07
0.06
1.235e+015
を返す、というようなものなんですが、どなたかお願いできませんか

最後の1つはprintfの%.3eでいいだろうし、上3つはMath::SigFigsのFormatSigFigsが
使えると思うから、値の範囲かなんかで場合分けしてそれぞれ食わせればいいんで
ないかな。

>>540
出来ました。どうもです。

あと、CPANを漁っていたらNumber::Formatに似たような機能をみつけたので、
これを改変してもうまくいきました。

sub round {
my ($number, $digits) = @_;
my $sign = $number <=> 0;
my $result = abs($number);
my $index;
if($number =~ /(.*)e(.*)/) {
$result = $1;
$index = $2;
}
my $precision = $digits - length(int($result));
if($result =~ /^0(\.0*)/) {
$precision += length($1);
}
my $multiplier = (10 ** $precision);
$result = int($result * $multiplier + 0.5000001) / $multiplier;
$result = -$result if $sign < 0;
$result *= (10 ** $index) if $index;
return $result;
}

$ip_sample = 222.4.xxx.xxx #フォームや環境変数から取得
$ip_data <<END_DATA;　　#外部ファイルから読み込んだデータ(実際は約2万4千行程度)
国名A-221.184.0.0-221.191.255.255
国名B-221.240.0.0-222.15.255.255
国名C-222.144.0.0-222.151.255.255
END_DATA
foreach (@ip_data) {
($cctld,$ip_a,$ip_b) = split(/-/,$_);
if (　判定ルーチン　)｛$ans = $cctld
last;
}
}
print $ans;#この場合は"国名Ｂ"と表示したい

$ip_dataを参照して$ip_sampleの値が$ip_dataのどの行に在るかの判定を行い
$ansへ該当する$ip_deta行の$cctldを返すようにしたいのですが
判定方法でつまずいています。gethostｘｘｘ関数を使えという方向は無しにして
元の$ip_dataを増やさずに行える極力短い判定のルーチンを教示おねがいします
このテの質問はwebプでやれと言われそうな気がするけど質問の内容が
板を選ぶ以前のレベルの自覚があるので敢えてこちらに投下しまふ。

こういうパズル的なのはどこでも答えてもらえそう

my $target = "222.4.0.0";
my @iptable = qw( 国名A-221.184.0.0-221.191.255.255 国名B-221.240.0.0-222.15.255.255 国名C-222.144.0.0-222.151.255.255 );

$target = pack("C"x4, split(/\./, $target));

for(@iptable){
my($country, $from, $to) = split /-/;
$from = pack("C"x4, split(/\./, $from));
$to = pack("C"x4, split(/\./, $to));
if($from le $target && $target le $to){
print "$countryが範囲内でした\n"
}
}

ありがとうございます
早速走らせて見ます


実は････
- foreach (@ip_data) {
+ foreach ($ip_data) {
ですた、阿呆ですんませんです･･･ orz

その2万4千行のデータの状態によっては物凄く処理速度に差が出そうだ。
データを読みながら1回から2万4千回判定するのがいいか、
全部配列に読み込んでおよそ5回判定するのがいいか。

違った。14回？

>>543
web鯖にはまだ置いてませんが手元の環境では問題なく動きました。
答えを教えてもらうと、なるほどなぁと納得行くのですが
その答えをせめて自分で作れるまでにはなりたいです。
ネットでも資料沢山あるけどラクダ本がほしくなったので
日曜日にでも街に探しにｲｯﾃｷﾏｽ
目標は脱ド初心者ｗ

>>545
できれば色々なパターンをベンチ取って一番軽い処理を使いたいですｗ
どうしても重かったらIP国別データを2〜3000行程度に分けて
IPの最初の8ﾋﾞｯﾄを参照して呼び分けてみようかなと思ってますが・・・

>>547
アルゴリズムの勉強したほうがいいよ。
>>545-546でバイナリサーチに気づかないのはかなり重症

>>547

スマソ。書き込む前に送信してもうた・・・

>>547
IPをキー、国名を値にもつハッシュを作り、データベースクラスにtieしてみては？
2万4千行をメモリに持つのはつらいと思う。

ちょっと練習で書いてみた。IPは悩んだ末、強引に１０進数に変換した。

my $data = <<EOF;
A-221.184.0.0-221.191.255.255
B-221.240.0.0-222.15.255.255
C-222.144.0.0-222.151.255.255
EOF
unlink 'test.db';
use Fcntl;
use DB_File;
tie my %db, 'DB_File', 'test.db', O_RDWR|O_CREAT, 0644, $DB_BTREE or die;
foreach(split/\n/, $data) {
my ($country, $from, $to) = split /-/;
for($from, $to) {
s/(\d+)\.(\d+)\.(\d+)\.(\d+)/$1*256**3+$2*256*256+$3*256+$4/e;
}
$db{$from-1} = 'N/A';
$db{$to} = $country;
}
untie %db;
sub find_country {
my $query = shift;
$query =~ s/(\d+)\.(\d+)\.(\d+)\.(\d)/$1*256**3+$2*256*256+$3*256+$4/e;
my $x = tie my %db, 'DB_File', 'test.db', O_RDONLY, 0644, $DB_BTREE or die;
my ($ip, $country) = ($query, 'N/A');
$x->seq($ip, $country, R_CURSOR);
return $country;
}

print find_country('221.239.0.1');

# IPアドレス→32bit整数
$ip = unpack('N', pack('CCCC', split(/\./, $ip)));
これで2倍くらいの速度になった
キャプチャが大きいんかなぁ

2個目のIPアドレス変換部分、最後が\d+じゃなくて\dになってたよ。
桁数が多いから計算ミスかと思ったけど、数字が文字列として尻についてただけなんだね。

>>552
use Socket; して inet_aton() 使ったら?

ベンチしたらinet_aton意外にとてつもなく遅いです。あとは
・「.」でばらすのはsplitより正規表現でキャプチャする方が速い
・4つの10進数から32bit整数にするのは、シフト>掛け算>pack-unpackの順で速い。
552の言うのとは逆の結果になったわけだがなんでかね?

Benchmark: running inet_aton, multiple_re, shift_re, unpack_re, unpack_split for at least 3 CPU seconds...
inet_aton: 5 wallclock secs ( 1.62 usr + 1.46 sys = 3.08 CPU) @ 425.97/s (n=1312)
multiple_re: 7 wallclock secs ( 3.26 usr + 0.00 sys = 3.26 CPU) @ 229803.99/s (n=749161)
shift_re: 3 wallclock secs ( 3.08 usr + 0.03 sys = 3.11 CPU) @ 274049.84/s (n=852295)
unpack_re: 3 wallclock secs ( 3.10 usr + 0.00 sys = 3.10 CPU) @ 183073.87/s (n=567529)
unpack_split: 4 wallclock secs ( 3.13 usr + 0.00 sys = 3.13 CPU) @ 119672.52/s (n=374575)

use Benchmark;
use Socket qw(inet_aton);
my $ip_a = 100.100.100.100;

timethese(undef,
{
unpack_split => sub {
my $ip = unpack('N', pack('CCCC', split(/\./, $ip_a)));
},
unpack_re => sub {
$ip_a =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/;
my $ip = unpack('N', pack('CCCC', $1, $2, $3, $4));
},
multiple_re => sub {
$ip_a =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/;
my $ip = $1*256*256*256 + $2*256*256 + $3*256 + $4;
},
shift_re => sub {
$ip_a =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/;
my $ip = $1 << 24 + $2 << 16 + $3 << 8 + $4;
},
inet_aton => sub {
my $ip = inet_aton($ip_a);
},
}
);

すまん、どうにも直観と反する結果なのでさらに調べていたらなんのことはない
my $ip_a = 100.100.100.100;

になっていたorz... もちろん正しくは

my $ip_a = '100.100.100.100';

なのでベンチ取り直した。

Benchmark: running inet_aton, multiple_re, shift_re, unpack_re, unpack_split for at least 3 CPU seconds...
inet_aton: 3 wallclock secs ( 3.16 usr + 0.00 sys = 3.16 CPU) @ 267949.37/s (n=846720)
multiple_re: 3 wallclock secs ( 3.16 usr + 0.00 sys = 3.16 CPU) @ 69144.94/s (n=218498)
shift_re: 4 wallclock secs ( 3.11 usr + 0.00 sys = 3.11 CPU) @ 74248.87/s (n=230914)
unpack_re: 3 wallclock secs ( 3.21 usr + 0.00 sys = 3.21 CPU) @ 68071.03/s (n=218508)
unpack_split: 2 wallclock secs ( 3.13 usr + 0.00 sys = 3.13 CPU) @ 95474.76/s (n=298836)

まとめ:

inet_atonはやっぱり速いので、自分で書くのはやめよう。

v文字列以外では
・ inet_atonはpackしたIPアドレス("100.100.100.100"なら"dddd")を返すのに、他は整数(1684300900)を算出している。
・ "+"演算子は"<<"演算子より優先度が高いため($1 << 24)とカッコで括らなければならない。

一応 sub getRandIPString { join '.', int rand 256, int rand 256, int rand 256, int rand 256; } といったものを用意して
全てバイナリ文字列を出力するコードにしてからベンチ取ったけど、inet_atonが常に1位だった。

今更だけど、後で直接比較可能にするための前処理として保存しとけば速度関係無かったね。

Mac OS XでPerlを使っています。
Macで作成したテキストを処理したいのですが、改行コードがCRになるのでうまく処理できません。
LFでないため、全て1行として認識されてしまいます。

標準入力を常にLFとして読み込んだ後、それに対してマッチや置換を行いたいのです。
以下のように書いてみましたけどダメでした。

while (<>) {
s/\x0D\x0A|\x0D|\x0A/\x0A/g;
if (/aaa/) {
print;
}
}

出力されたデータはLFになりましたが、マッチはうまくいきませんでした。
何かいいやり方はないものでしょうか。

求めてるのは<>使う前の $/ = "\x0D"; か /aaa/m あたりかも

>559さん

入力時の区切り文字をCRに決めてやればいいんですね。
解決しました。ありがとうございました。

すいません。行のナンバリングをリクエストしてもよろしいでしょうか。

あいうえお（段落1）
かきくけこ（段落2）
さしすせそ（段落3）

たちつてと（段落4）
なにぬねの（段落5）
はひふへほ（段落6）

という文章があって、これを、

1：あいうえお（段落1）
2：かきくけこ（段落2）
3：さしすせそ（段落3）

1：たちつてと（段落4）
2：なにぬねの（段落5）
3：はひふへほ（段落6）

のように空行をはさんで新たにナンバリングを開始したいのですが方法が思い浮かびません。

言いたいことが分からんが新たにナンバリングを開始したいところで
ナンバリング用の変数を初期化して空行を出力するだけじゃないのか？

>>561は、単純にすべての行に通し番号でナンバリングするプログラムは作れるのか？

>563

あっ、はい。

my $i = 0;

while (<STDIN>) {

if (/^./) {
print ++$i;
print ": ";
print;

}

}
ちょっと冗長ですけど。

うーん、、、自分で作りたい？それとも誰かにサクッと作って欲しい？

>>564
そこまでかけるなら
else で $i = 0; を書けないか?

空行が来たらカウントをリセットする、というと、こんな感じ?

$n = 1;
while (<>) {
　$n = 1 if (/^\s*$/
　print "$n: $_";
　$n++;
}

あ、閉括弧とか忘れた。まあいいや。脳内で修正してくれ。

>566

elseを使っても結果が変わらないんです。
マッチがヘボいんでしょうか。

>567

実行させると入力がぶっとんでしまいました…

>565

いろいろ試してみたのですが、自分の力ではムリっぽいです…
あつかましいとは承知していますが、作っていただくと助かります。

出来てしまいました！

my $i = 0;
while (<STDIN>) {
　if (/^..+/) {
　print ++$i;
　print ": ";
　print;
　} else {
　$i = 0;
　print;
　}
}

else文で「my $i = 0;」にしていたのがまずかったようで、
空行になっても$iが初期化されなかったみたいです。
レス下さったみなさん、ありがとうございました。
おさわがせしました。
私ってPerlの才能ないのかな…

>>570
完成おめ！
才能がどうかは知らないけど、結局経験じゃないですかね？
俺も本スレで叩かれたりしながら勉強してますｗ

一応俺が用意してたスクリプト貼っておきます。。。
use strict;
my $c = 1;
open IN, 'filename';
while (<IN>) {
    (/^$/) ? $c = 1 : print $c++ . ':';
    print;
}
close IN;

>571

ありがとうございます。
自分のはだいぶ冗長だと思うので、用意していただいたスクリプトを参考にさせていただきます。
今自分の書いたものを見直してみると、if (/^./)でいいですよね...
恥ずかしい...

>>570
myはローカル変数の宣言。単なる代入では無いよ。
myを使うと、同名の新たな一時変数を作る事になる。
んで、詳しい条件は忘れたが、ブロック抜ける時とかに消える。

長いコードになると
「この変数名って他で使われて無かったっけ…？」
ってなるけど、my使えばそんな心配が減るワケ。

>>558

>>560では解決しちゃったみたいだけど、これ俺も知りたい。
コマンドラインから入力されたテキストの改行コードをLFに統一、
という前処理をしてからwhileループ処理をかますってできるのかな？
あんまりセパレータとか変えたくないんで。

>>574
>セパレータとか変えたくない

なんで？

>575

セパレータも一文字として認識されてしまわない？
回避する方法があればいいんだけど。

認識できるから区切れるんだが。
いまいち言いたいことが分からん。

メタキャラ「.」って改行を除く一文字にマッチするじゃん。
でも「.」もCRにマッチしちゃわね？
LF読み込むときと処理が変わっちゃうからイライラすんだよね。

自分の都合に合わせてセパレーター変えるなり置換するなりすりゃいいじゃん。

あーいう変数ってlocal出来ないっけ？

whileで読み込む前に処理しとくって、
できないってことでおｋ？

質問は質問スレ行け

Win32::GUI::ListView ソートメソッドないじゃん・・・orz

　た・・・す・・・け・・・て・・・・

りすとびゅーか...
なにもかもがな・・つ・・か・・し・・ぃ・・

一瞬、不治痛の電子帳票ソフトかと思った

初めまして。

浅知恵で掲示板の改造を試みています。
オートリンク機能付き掲示板に記事修正機能を追加したのですが、
記事修正をするたびに、文中にあるリンク先が
<A href=http://www.a.b.c target=_blank><A HREF=http://www.a.b.c target=_blank>
http://www.a.b.c</A></A>
と、タグが無制限に追加されていきます。

そこでお願いしたいのは、
記事修正時にファイルに保存されているデータ
----------------------------------------------
<A HREF=http://www.a.b.c target=_blank>
http://www.a.b.c</A>
----------------------------------------------
を一端
----------------------------------------------
http://www.a.b.c
----------------------------------------------
というデータに戻すサブルーチンを作成したいのですが、
行き詰まっています。
よろしくお願いします。

オートリンク機能のスクリプトは以下の通りです。
***************************************************************
#オートリンク
sub auto_link {
my($msg) = $_[0];
$msg =~ s/([^=^\"]|^)(http\:[\w\.\~\-\/\?\&\+\=\:\@\%\;\#]+)/$1<A HREF=$2 target=_blank>$2<\/A>/g;
return $msg;
}

↑　ありゃ、文字がおかしい。

全角にしてありますが、Aタグです。
http://www.a.b.c　の後ろは、＜／Ａ＞

そういう時は表示時にオートリンクを適用すればいい。
保存時にいじっちゃうと後でいじりにくくなるというのは定説。
ファイル構造上、改行の置換とかは仕方無いと思うけどさ。

>>586

ようするに、すでに<A>タグ化されている部分を除外すればいいわけだな？

ああ、ごめん。>>586にいての>>588の意見を読んでなかった。
確かに保存時は生データのまま記録し置いて、閲覧時に
http:なんた