Perl で undef を含むものをsortについて考えてみた。
blog.likk.jp
で切り捨てた undefについて考えてみた。undef sortした時に最大値ととるか最小値ととるかによって違うけど、最小値として考えるなら以下のとおりにの書き方になる。
use strict; use warnings; use Clone qw/clone/; use YAML; my $list = [ { name => 'aaa', hoge => 10, fuga => 1 }, { name => 'bbb', hoge => 11, fuga => 2 }, { name => 'ccc', hoge => 11, fuga => 1 }, { name => 'ddd', hoge => 12, fuga => 1 }, { name => 'eee', hoge => undef, fuga => undef }, { name => 'fff', hoge => undef, fuga => 1 }, { name => 'ggg', hoge => 10, fuga => undef }, { name => 'hhh', } ]; my $sorted_list = [ map { sprintf("%s, hoge:%s fuga:%s", $_->{name} || '' , $_->{hoge} || '', $_->{fuga} ||'') } sort { (defined($a->{hoge} and $b->{hoge}) ? $a->{hoge} <=> $b->{hoge} : defined($a->{hoge}) ? +1 : defined($b->{hoge}) ? -1 : 0 ) or (defined($a->{fuga} and $b->{fuga}) ? $a->{fuga} <=> $b->{fuga} : defined($a->{fuga}) ? +1 : defined($b->{fuga}) ? -1 : 0 ) } map { $_->{hoge} //=undef; $_->{fuga} //=undef; $_; } @{ clone($list) } ]; warn YAML::Dump $sorted_list; #--- #- 'eee, hoge: fuga:' #- 'hhh, hoge: fuga:' #- 'fff, hoge: fuga:1' #- 'ggg, hoge:10 fuga:' #- 'aaa, hoge:10 fuga:1' #- 'ccc, hoge:11 fuga:1' #- 'bbb, hoge:11 fuga:2' #- 'ddd, hoge:12 fuga:1'
ちなみに、defind とかしなくて普通に <=> してもwarning 吐きながらではあるが同じ結果にはなる。
昇順だけど、undef は最後に出したいとかなら上記の例の符号を逆にすればいい。
そもそもsortしたいカラムならNOT NULL制約かけろよとかデフォルト値設けろという話はとりあえず置いておく。
ところで、同じことしてくれるCPANモジュールあると思うんですが、誰か知りませんか。
Perl で複数条件sort
業務で10年近くperl触ってるのに、普通にやる機会がなかった。
大体DBのorder by で済ましてる気がする。
ちなみに、ソート対象がundefのものが表にでては具合がわるい仕様なので出さないようにしている。order by のように昇順ではundefのものを最初に、降順では最後にもってくるにはもう一工夫が必要。(mysqlの話です。oracleは昇順だと最後に、降順だと最初だと記憶してます。)
use strict; use warnings; use YAML; my $list = [ { name => 'aaa', hoge => 10, fuga => 1 }, { name => 'bbb', hoge => 11, fuga => 2 }, { name => 'ccc', hoge => 11, fuga => 1 }, { name => 'ddd', hoge => 12, fuga => 1 }, { name => 'eee', hoge => undef, fuga => 1 }, ]; my $sorted_list = [ map { $_->{name} } sort { $a->{hoge} <=> $b->{hoge} or $a->{fuga} <=> $b->{fuga} } grep { defined $_->{hoge} and defined $_->{fuga} } @$list ]; warn YAML::Dump $sorted_list; #--- #- aaa #- ccc #- bbb #- ddd
<=> は両方の値が等価の場合は0が返るので、or で次の条件似つなぐ。条件が増えた場合は更にorでなげば良い。
Perl から任意のログインシェルでsystemや``を実行する方法
perl から シェルを実行したいときは system か `` (qx//) で代替済むのですが、それらから呼び出すのが素のsh でどうしても実行環境のzshrc を読み込んだ上でzsh を実行したいことが出てきた。
でも `zsh hoge`; とか system("zsh && hoge"); やってもダメなんですよね。
んで、良い方法も特に思い浮かばなくてローカルに鍵通して `ssh localhost -t "hoge"` にした。
ログインシェルがzsh なので zsh で実行されるし、source .zshrc や source .zprofile すればパスとかも通る。
やったこと、まとめ
`qq{ssh localhost -t "source .zprofile; source .zshrc; cd ~/path/to/;hoge --option"}`
え?最初から zsh で叩けばいいじゃんって?
その反応は多分正しいのですが、黒い画面触りたくない人向けとか、やんごとなき事情で、perlのWAFから zsh 実行したい時があるんですよ。
何か良い方法あったら教えてください。
普段は宣言できないサブルーチン名の作り方
perl のサブルーチン名は数字で始まったり、アンダスコア以外の記号を使ったサブルーチンは宣言できない。
use strict; use warnings; sub 0 { print '0' } &0;
実行すると下記の様に怒られる。
$ perl ./hoge.pl Illegal declaration of subroutine main::a at ./hoge.pl line 4.
しかし下記のようにパッケージのシンボルテーブルをcoderef上書きすると実行できる。
use strict; use warnings; { no strict 'refs'; *{__PACKAGE__ . '::0';} = sub { print 0; }; &0; use strict; }
$ perl ./hoge.pl 0
もう何でもありである。というムダ知識を得たんだ。
use strict; use warnings; { no strict 'refs'; *{__PACKAGE__ . '::1-1'} = sub { say "1-1" }; *{__PACKAGE__ . '::&'} = sub { say "&" }; *{__PACKAGE__ . ':: '} = sub { say " " }; &{"1-1"}; &{&}; &{' '}; use strict; }
追記:という話をperl界隈の人に言ったら、「それ去年のYAPCで…」と言われたので帰ろうと思う。
さらに追記:クラス定義も出来るという話を聞いた。そりゃそうだ。
package main; use strict; use warnings; { no strict 'refs'; *{'&::&'} = sub { shift; say '&::&'}; *{'&::new'} = sub { return bless {}, '&' }; my $method = '&'; "&::new"->()->$method; #なんかもうちょっと良い呼び出し方ありそう。 use strict; }
$ perl ./hoge.pl &::&
スマホで撮影した写真のファイル名が被る場合の整理方法
とある事情で写真の整理をしています。
大ざっぱだけどこんなディレクトリ状態。規則性あるようにも見えるけど実際の所規則性なんてのはない。
hoge/ hoge/2013/aaa.jpg hoge/2013/bbb.jpg hoge/2013/ccc.jpg hoge/2014/05/aaa.jpg hoge/2014/05/bbb.jpg hoge/201405-2014-07/aaa.JPG hoge/201405/マルチバイト文字列/aaa.JPG
大量にかつ複雑なディレクトリの中にあるファイルを一個ずつ見て回ると、どのディレクトリまでみたのか分からなくなって混乱してきた。
一覧でみたいんじゃあああと、直下に集約しようとすると今度はファイル名が被ってるので上書きしてしますか?とか聞いてきたので、ついカッとなって撮影日付で置換して直下に置くスクリプト書いた。
過去に書いた二つの記事の合わせ技
use Image::ExifTool; use Path::Class::Dir; Path::Class::Dir->new("./")->recurse( callback => sub { my $f = shift->stringify; return if -d $f; return unless $f =~ m{\.jpg$}i; my $it = 'Image::ExifTool'->new; $it->ImageInfo($f); my $dt = $it->GetValue('DateTimeOriginal'); $dt =~ s/[: ]//g; $dt = $dt . '.jpg'; print $f . ' -> ' . $dt ."\n"; rename($f, $dt); } )
LOAD DATA INFILE を使った MySQLのデータインポート
一年に一回やるかやらないかぐらいの頻度で、毎回ググって回ってるので備忘録。
mysqldump -u user -p --default-character-set=utf8 --lock-tables --single-transaction database table > table.sql gzip table.sql scp table.sql.gz new-server:/tmp/ ssh new-server cd /tmp zcat table.sql.gz | mysql -u user -p database
基本この流れで問題ないんだけど、千万件辺りからいつまでたっても終わらなくなる感じになるので、LOAD DATA INFILE を使うようにする。
SELECT * INTO OUTFILE '/tmp/table.tsv' FROM table
で書き出して
LOAD DATA INFILE '/tmp/table.tsv' INTO TABLE table;
で読み込む。
必要であれば読み込む前に以下をやっておく
SET foreign_key_checks=0; SET sql_log_bin=0; SET unique_checks=0; SET @@character_set_database=binary
あと、基本だけどこの手の時間がかかる作業はscreenなりtmuxなりやっておかないと、悲しい気持ちになります。
手元にあるデータは新たに更新されることは無いので、最近は昔に書きだしたtsvを再インポートするだけになっている。
参考元:
もっとクソでかいデータを扱う時:
参考先のmaatkitとfifoを使う
次に実行する時に、毎度参考サイトが有るとは限らないのでアーカイブしておきたい所。
数字を3桁ごとにカンマで区切るやつ
Perl 数値 三桁 とかでググると色々出てくるけど微妙に要件満たしてなかったりする。
正負の記号入れると動かなかったりとか、
小数点入れると動かなかったりとか、
小数点以下もご丁寧に3桁区切りになったりとか。
要件を言うと -7,654,321.0000001 と整形されるデータが欲しい。何に使うかは置いといて、Excel先生はそういう風に整形してくれるので挙動を合わせておきたい。
幾つか試した結果、 Number::Format::format_number(); が上記要件を満たしてくれた。
そのまま使うと小数点2桁以下は round されるので perldoc Number::Format して確認すると良いと思う。
今の best practice かどうかは分からないので、他にオススメありましたらよろしくお願いします。