ログインしてさらにmixiを楽しもう

コメントを投稿して情報交換!
更新通知を受け取って、最新情報をゲット!

ホーム > コミュニティ > PC、インターネット > Perl > トピック一覧 > perlならではの便利な短いコ...

Perlコミュのperlならではの便利な短いコードを書き留めたい

  • mixiチェック
  • このエントリーをはてなブックマークに追加

コミュ内全体

数行からワンライナーまで、いろんなものに使えるパーツというかコードを書きとめたい。
また、皆様が日ごろ使っている便利な小物をぜひ教えて下さい。本に載っていたとかでもかまいません。
いろいろ勉強さていただきます。

コメント(42)

たしか Effective Perl より。

- リストの重複を無くす。
- 順番は保存されない
- undef 入れたら死。

sub uniq { keys %{{ map { $_ => "moemoe" } @_ }} }

ex. @uniq = uniq(@hoge);

--

ファイル名を小文字にするのは,map より foreach の方が直感的かも…
ファイルからランダムに一行抜き出す。

rand($.) < 1 && ($line = $_) while <FILE>;

manのFAQに載ってたような。
この一行に出合ってまじめにマニュアル系を読むようになりました(笑
出合ったときは目からウロコが!!
おみくじ・占いといろいろお世話になりました。



open(FILE,"hoge.txt");
srand;
rand($.) < 1 && ($line = $_) while <FILE>;
3桁ごとにカンマを入れる!!

1 while $yen =~ s/(.*\d)(\d\d\d)/$1,$2/g;

カンマないと数字の桁が分からないヘタレな僕は
自分モジュールに絶対入れるほどよく使います。



$yen = 1324567980;
1 while $yen =~ s/(.*\d)(\d\d\d)/$1,$2/g;
print $yen;
(微妙に本題から外れますが)
私がカンマを入れるコードを書いて他の人に渡し、必要に応じてその人が書き換えるということをやっていました。
しばらくしてその人に「四則演算がうまくいかない」と相談されました。よく見るとカンマのついたまま四則演算をやろうとしていました。
呪文的なコードのせいでカンマを入れる処理をやっていることに気づいてもらえなかったようです。
一見して何をやっているかわからないコードにはコメントを入れよう,という教訓ですね。:)

私の場合,その手のコードは関数にして仕様を書いておくことが多いです。
あ、けっこうありますよね。
後でそのスカラーを使う可能性があって表示の時だけなんとかしたい場合そのスカラーを変更してしまうのは何なので、僕の場合は出力の時だけだけカンマを打つような(ちょっと変な)方法をしています。
#--------------------------------------------
sub keta{
my $yen=shift;
1 while $yen =~ s/(.*\d)(\d\d\d)/$1,$2/g;
return \$yen; # リファレンス注意
}

$ONEDAN=19800;
print "この値段は¥${&keta($ONEDAN)}-.です。\n";
print "税込みだと¥${&keta($ONEDAN * 1.05)}-.\n";
#--------------------------------------------

# そもそもの数字はいじらない。
# 桁打ちは表示の時にいるのでそのときだけ使う。

デリファレンスやクォート内での式の実行などの賛否や流儀はこのさいおいといて・・・くださいm(__)m
($aa,$bb)=($bb,$aa);

僕が当時、CGIで表をストライプにしたい・・・
背景を白、薄いグレイと交互にしたいと思って悩んでいたときにperlを覚えるきっかけとなったperl使いの人にニヤニヤしながら教えてくれたもの。
当時なんでニヤニヤしていたかわかんなかったんですが、今は!!!!!!です。
数年たってEffective Perl にも載っていたのを見てちょっとカンドー。
@keys = sort { $hash{$a} cmp $hash{$b} } keys %hash;

# ハッシュの値でソート
@foo = ($str =~ m{([\x00-\x7f] | # ASCII or JIS X0201 Roman
\x8e[\xa0-\xdf] | # JIS X 0201 Katakana
\x8f[\xa1-\xfe]{2} | # JIS X 0212
[\xa1-\xfe]{2})}gx); # JIS X 0208

文字単位に分解する。(EUC-JPのみ)

# そろそろ不要になりそうなテクニックですが。
知ってる方も多いかも知れませんが、
http://www.din.or.jp/~ohzaki/perl.htm
ここらへんを良く見てます
色々なのが出てますよ
全然使えないかも知れませんが、こちらに面白いコードがたくさんあります。
http://www.cpan.org/misc/japh
以前、tree2html.pl なるものを作ってみました。
tree コマンドと組み合わせて、クリッカブルな tree を作るものなんですが……。

本人的には結構便利なんですが、どうでしょう?

tree2html.pl:
http://www5.airnet.ne.jp/~morimon/DIARY/2003/index.html#031127

出力結果サンプル:
http://www5.airnet.ne.jp/~morimon/DIARY/tmp/tree.html
スカラーをオンザフライで生成できると知った時は面白いと思った。実際はめったに使わないけど・・・。

$WW='test';
$$WW='あーてすてす。';
print $test,"\n";

${$WW}='このテキストが$testに入っています。';
print $test;

@Hash{ keys %NewHash }= values %NewHash;

# ハッシュの上書き
初めエフェクティブぱぁるを読んでてわけわかんなかったんだけど何回も通読していたふと、この意味することが分かったときのカンドーといったら!!
直感に反するように思えるので,私は
%hash = (%hash, %newhash);
としてます。:)
ハッシュの分解・リスト化・再コピー と ハッシュの新しいところだけ"直接"書き換えるのの違いですね。
少ないハッシュだとたしかに分かりやすいですね。
僕が@Hash{ keys %NewHash }= values %NewHash;で感動したのは、@が配列を意味するものではなく実は!! と分かったから。
これDBとかとタイした時などに強力です。

でもPerlは直感というか「初めに思いついた方法」を推奨します:)
ハッシュのキーでソートしたい。

@keys = sort { $hash{$a} cmp $hash{$b} } keys %hash;

# 使い方の例
%hash=("ああ" => 789,"いい" => 456,"うう"=> 123);
for(sort {$hash{$a} cmp $hash{$b}} keys %hash){print qq{$_ = $hash{$_}\n}};
sub mkhidden
{
my($p) = @_;
my($v, $dest) = ('', '');

foreach $v (keys %$p)
{
foreach(split(/\t/, $$p{"$v"}))
{
$dest .= qq|<input type="hidden" name="$v" value="$_">\n|;
}
}

return $dest;
}

%pは書き込みたいhiddenタグのハッシュ。
ハッシュキーがhiddenタグのnameでハッシュ値がhiddenタグのvalueとして設定しておく、
同一nameで複数ある場合はタブ区切りでハッシュ値を設定しておくと、複数のhiddenタグを生成する。

$p{'tel'} = "03-0000-0000";
$p{'chk'} = "テニス\tカラオケ";
$dest = &mkhidden(\%p);

とやると、

$destは

<input type="hidden" name="tel" value="03-0000-0000">
<input type="hidden" name="chk" value="テニス">
<input type="hidden" name="chk" value="カラオケ">

となる。
$src =~ s|<td([^>]*)></td>|<td$1><br></td>|gi;

<td>$data</td>

とかやったときに、$dataが空で、<td></td>になってしまい、
表示的に不恰好になってしまうのを、最後に置換する。
もちろん

$data = '<br>' if($data eq '');

でいいのだが、諸事情で都度空チェックできないときに。
上のコードはエスケープを怠っているので
安全だと分かっている場合以外は使うべきではありません。

sub escape_param{
my $str = $_;
$str =~ s/&/\&/g;
$str =~ s/"/\"/g;
$str =~ s/'/\'/g;
$str =~ s/</\</g;
$str =~ s/>/\>/g;
return $str;
}

$p{'tel'} = qq(<>&'");
$p{'chk'} = "テニス\tカラオケ";
print join"\n",map{
my $n=escape_param($_);
map{qq(<input type="hidden" name="$n" value=").escape_param($_).qq(">)}
split /\t/,$p{$_};
} keys %p;
&quot; と書いたら変換されてしまった… orz
$ perl lzw_encode < 圧縮元ファイル > 圧縮後ファイル

#!perl -w
binmode STDIN;binmode STDOUT;if(read STDIN,$_,1){$C=ord;$I=256;while(read
STDIN,$_,1){if($E=$H{$D=$C<<8^ord}){$C=$E;next}$H{$D}=$I++if$I<4095;
$B.=pack"v",$C;$C=ord}$B.=pack"v",$C}$B=unpack"h*",$B.pack("v",4095);
$B=~s/(...)0/$1/g;print pack("h*",$B."f"x(length$B&1))

$ perl lzw_decode < 圧縮済ファイル > 復元ファイル

#!perl -w
binmode STDIN;binmode STDOUT;$/=undef;if($B=unpack"h*",<>){
$B=~s/(...)/${1}0/g;@B=unpack"v*",pack("h*",$B);for(@C=($I=0);$I<@B;$I++){
exit if($_=$B[$I])==4095;@S=();while(255<$_){push@S,$C[$_-256];$_=$B[$_-256]
}print pack("C*",$_,reverse@S);@C[$I-1,$I]=($_,$_)if$I<3840}}
正規表現のprintfデバッグ

my $str = <<'END';
<p class=g><a href=http://support.microsoft.com/ onmousedown="return clk(1,this)">308252 - [HOW TO] <b>正規</b><b>表現</b>および Visual C# .NET <b>...</b></a><br><font size=-1> <b>...</b> <b>正規</b><b>表現</b>を定義し、パターン マッチングを使用して電子メール アドレス<br>
始 <b>...</b>
<br><font color=#008000>support.microsoft.com/default.aspx?scid=kb;ja;308252 - 21k - </font><a class=fl href=http://64.233.167.104/search?q=cache:ix>キャッシュ</a> - <a class=fl href=/search?hl=ja&lr=lang_ja&ie=>関連ページ</a></font>
END

my $re = qr|
<a\s*href=(\S+)[^>]*>(?{warn"1_ $^N\n"})(.+?)</a>(?{warn"2_ $^N\n"})
<br><font\s*size=-1>(.+?)(?{warn"3_ $^N\n"})<font[^>]*>\S+\s*-\s*\d+k\s*-\s*</font>
<a\s*class=fl\s*href=\S+>キャッシュ</a>\s*-\s*<a\s*class=fl\s*href=\S+>[^<]+</a></font>(?{ warn"E_ $^N\n"})
|xis;

$str =~ $re and print "match\n";
sort{$a <=> $b || (split "\t",$a)[1] cmp (split "\t",$b)[1]} @dat;

@datはタブ区切りのCSVのラインで頭の数値でソートするんだけど、同じ数字の場合、タブで区切った[1]の値でさらにソートする。

深夜2時30分に思いついた処理なのでよく検討しなおせ > オレ
シュバルツ変換を勉強しなおすべきかな。
はじめまして。
その昔、「 use Time::Local; 」など知らなかったときに書いた関数です。
引数は(秒、分、時、日、月、西暦)の順です。
自分では、ちょっとだけ気に入ってます。

sub time_encode {
my ($se,$mi,$ho,$md,$mo,$ye) = @_[0..5];
my $time_zone = 9;
my @num = (31,28,31,30,31,30,31,31,30,31,30,31);
$num[1] = 29 if(($ye%4 == 0)&&($ye%100 != 0)||($ye%400 == 0));
my $leap_times = (int(--$ye/4) - int($ye/100) + int($ye/400) - 477);
my $sum = eval(join("+",(0,0,@num)[0..$mo]));
return ($se +($mi +($ho - $time_zone +(($md - 1)+ $sum +($ye - 1969)
* 365 + $leap_times)* 24)* 60)* 60);
}
はじめまして。

こんなのどうでしょう。
アクセスログなんかのURLエンコードをデコードします。
モジュール使ってるだけですが(笑)。

perl -MJcode -MCGI -ne 'print Jcode->new(CGI->unescape($_))->euc'
書籍のISBNコードを指定してAmazon.co.jpの売上ランキングをとってくるスクリプト。気になった本の売上ランキング推移を監視するのに使ってます(ヤラしぃ...)

#!/usr/bin/perl

use LWP::Simple;
use strict;

my $isbn = shift || '4774117994';
$isbn =~ s/-//g;
my $url = sprintf 'http://www.amazon.co.jp/exec/obidos/ASIN/%s/', $isbn;
my $html = get($url)
or die "$0: cannot connect URL: $url\n";

$html =~ m|\n<li>\n<b>(?:Amazon.co.jp .+\x81\x46)?</b>\n([\d,]+)\n</font>|
or die "$0: cannot find ranking field.\n";
my $rank = $1;
$rank =~ s/,//g;
print $rank, "\n";
__END__


# インデント効かないのがヤですね。
#=========================
# 配列を混ぜる
#=========================
# @list=shuffle (@list);
sub shuffle {
my @list =@_;

for my $i ( 0..$#list ) {
my $rand=int(rand(@list));
my $tmp=$list[$i];
$list[$i]=$list[$rand];
$list[$rand]=$tmp;
}
@list
}

単純だし、標準でついて欲しいくらいの機能ですけどね。
>>あとむさん
標準モジュールにList::Utilというものがあってその中にshuffleはありますよ

其れはおいておいて自分なりにかいてみました
sub shuffle{
  my @list;
  push( @list, splice(@_, int(rand(@_))) ) while(@_);
  return @list;
}
おお、標準モジュールという手があったかぁ・・なるほど。
あんまり目を向けたことがなかったなぁ・・(;´▽`A``

jjx さんのコードもスッキリしてていいですね。

じゃぁ・・こんなのはどうでしょう?
#============================================
# 文字列を指定した長さに切り詰める(EUCのみ)
# lengthは半角文字数で指定
#============================================
sub String_cut {
my($str,$length) = @_;
my $str2=substr($str,0,$length);

$str2=substr($str,0,$length-1) if ($str2 =~ /\x8F$/ or $str2 =~ tr/\x8E\xA1-\xFE// % 2);
$str2.=".." if( length $str > length $str2 );
$str2
}
考えることは一緒ですね。
昔(7年前)書いたコードですが、すっきりしてて見やすいので投稿してみます。
-------------------------------------------------------
sub TextChop
{
my($l_text,$l_len)=@_;
my($l_cnt);

# EUCが[0xA1〜0xFE][0xA1〜0xFE]の2バイトで構成される事を利用して
# カット後の[0xA1〜0xFE]の個数が偶数個か奇数個かを数える事によって
# 文字列の最後のEUC漢字コードを分断してしまったかどうかを判断する。
# 奇数個の場合、EUC漢字コードの2バイト目を落としたと判断できる。

if($l_text eq "") { return($l_text); } # 例外処理
if($l_len <= 0) { return($l_text); } # 例外処理
if(length($l_text) <= $l_len) { return($l_text); } # 例外処理

$l_text = substr($l_text,0,$l_len); # カットしてみる
$l_cnt= $l_text =~ tr/\xA1-\xFE/\xA1-\xFE/; # EUCコードを数える

if($l_cnt % 2) { return(substr($l_text,0,$l_len-1)); } # 奇数個
return($l_text); # 偶数個
}
-------------------------------------------------------
んじゃ、こんなのはレアかなぁ・・
使う頻度が少ないので便利かどうかは定かではないけど(;´▽`A``
#============================================
# メールアドレスをドメインごとに並べる
# @domainSort =domainSort (@mail_add);
#============================================
sub domainSort {
return map{$_->[0]}
sort{ $a->[1] cmp $b->[1] or $a->[2] cmp $b->[2] }
map { my $domain= (split(/\@/))[-1];[$_,lc reverse $domain,lc $_] } @_
}
e2つで2回eval!!
そんなことできたんだ……。

って、perlopにしっかり書いてあるのね。
$dat=102345687965645;
@ar=($dat=~m/(\d)/g);

print join ":",@ar;
新しい技がいろいろ見つかって楽しいですね。
そんなサイトを作ってました。 Perlにも限定してないし
日頃の作業で困ったことを解決するTipsが中心ですが。

http://scripts.jp

まだまだ、Tipsが足りないのでぜひいろいろ教えてください。

こんなのは結構人気。

リレーを拒否したメールサーバーの一覧
# grep 'reject' /var/log/maillog |perl -e 'while(<>){
/relay=([a-z0-9.-]+)?\s?\[([^]]+)\]/gi;
print "$2\t$1\n";
}'
39だけではイマイチよくわかんないので後の自分用に例おば。

■2ちゃんねるのスレIDとスレタイの変換テーブル%hushを作る
use LWP::Simple;
pritn $html=get('http://tv6.2ch.net/tv/subback.html');
%hush=($html=~m/<a href="(.+?)\/l50">(.*?)<\/a>/gi);
for(keys %hush){print "$_ => $hush{$_}\n";}
s/hush/hash/;
はどうでもいいとして、個人的には subject.txt 解析のほうが好きです。こんな感じかな。

use LWP::Simple;
my $html = get("http://tv6.2ch.net/tv/subject.txt");
my %hash = map { split /\.dat<>/ } split /\n/, $html;
use Data::Dumper; print Dumper \%hash;

ログインすると、残り3件のコメントが見れるよ

mixiユーザー
ログインしてコメントしよう!

Perl 更新情報

Perlのメンバーはこんなコミュニティにも参加しています

星印の数は、共通して参加しているメンバーが多いほど増えます。

人気コミュニティランキング

mixiチケット決済