読者です 読者をやめる 読者になる 読者になる

totofugaのブログ

ネットワークとかc言語、perlの話。

ヒープ木

順位キューで挿入と探索をlogNで行いたいときに使う

二分ヒープ - Wikipedia

挿入のときは最下層の一番左に挿入して補正 取り出すときは一番上から取得 => 最下層の一番左にあったものを上に付けて補正

を行うので常に完全バランスが取れて、左からノードが埋まっていく。

perlでのheap実装

# heap木

my @a = (7,  2, 3);
foreach ( @a ) {
    heap_insert($_);
}

my $ret;

while ( $ret = heap_remove() ) {
    print $ret. "\n";
}

my @heap;

sub heap_remove {

    return unless ( @heap );

    if ( @heap == 1 ) {
        return pop @heap;
    }

    my $top = $heap[0];
    $heap[0] = pop @heap;
    top_down(0);

    return $top;
}

sub heap_insert {
    my ($data) = @_;
    my $n = scalar @heap;
    $heap[$n] = $data;

    bottom_up($n);
}

sub bottom_up {
    my ($index) = @_;

    return if ( $index == 0 );

    my $parent_index = int ( ( $index + 1 ) / 2 ) - 1;
     if ( $heap[$index] > $heap[$parent_index] ) {

         @heap[$index, $parent_index] = @heap[$parent_index, $index]; # swap
         bottom_up($parent_index);
     }
 }

 sub top_down {
     my ($index) = @_;

     my $n = scalar @heap;

     my $l = ($index + 1) * 2 - 1;
     my $r = $l + 1;

     if ( $l < $n && $heap[$l] > $heap[$index] ) {
         @heap[$l, $index] = @heap[$index, $l];
         top_down($l);
     } elsif ( $r < $n && $heap[$r] > $heap[$index] ) {
         @heap[$r, $index] = @heap[$index, $r];
         top_down($r);
     }
 }

データは配列として格納する。 一つ上のノードにアクセスする場合は /2 一つ下のノードにアクセスする場合は *2 をする。

アセンブラからELF

64bitに以降したら

nasm -f elf test.asm
ld test.o

としていたアセンブラから実行ファイルへの変換が動かなくなっていた

could not read symbols: File in wrong format

の様なエラーが出る。 どうやら-m elf_i386を指定しないといけないらしい。

#!/bin/sh

if [ ! $# -eq 1 ]; then
        echo "please set asmfile"
        exit 1
fi

if [ ! -f $1 ]; then
        echo "file not fount" 1>&2
        exit 1
fi

BASE_NAME=${1%.*}

nasm -f elf ${1} -o ${BASE_NAME}.o
ld -e main -m elf_i386 -o ${BASE_NAME} ${BASE_NAME}.o

rm -rf ${BASE_NAME}.o

こんな感じに修正した。

サーバーで複数ポートを待ち受ける

socketは普通にacceptすると処理をblockしてしまうので複数のポートの待ちうけが出来ません。 acceptする前にIO->Selectのcan_readを使用することにより複数ポートの待ちうけが可能になります。

#!/usr/bin/perl                                      
use strict;                                          
use warnings;                                        
use IO::Socket;                                      
use IO::Select;                                      
                                                     
my @ports = (6000, 7000);                            
                                                     
my $select = IO::Select->new;                        
                                                     
foreach my $port ( @ports ) {                        
    my $listen = IO::Socket::INET->new(              
        Listen => SOMAXCONN,                         
        LocalPort => $port,                          
        Proto => 'tcp',                              
    ) or die $@;                                     
                                                     
    $select->add($listen);                           
}                                                    
                                                     
my @handles;                                         
while(@handles = $select->can_read) {                
    foreach my $handle (@handles) {                  
        my $new = $handle->accept();                 
        if ( my $pid = fork ) {                      
            $new->close();                           
        } else {                                     
                                                     
            select($new);                            
            print "connect to @{[$new->sockport]}\n";
            exit(0);                                 
        }                                            
    }                                                
}

telnetでアクセスすると6000と7000どちらのポートでもアクセスできることを確認できます。

$telnet localhost 6000
Trying ::1...
telnet: connect to address ::1: Connection refused
Trying 127.0.0.1...
Connected to localhost.
Escape character is '^]'.
connect to 6000
Connection closed by foreign host.
$ telnet localhost 7000
Trying ::1...
telnet: connect to address ::1: Connection refused
Trying 127.0.0.1...
Connected to localhost.
Escape character is '^]'.
connect to 7000
Connection closed by foreign host.

perl: warning: Please check that your locale settings: ワーニングの対処法

CentOSにて /etc/sysconfig/i18nで LANG="ja_JP.UTF-8" 言語設定を行った時に

# perl -v 

perl: warning: Setting locale failed.
perl: warning: Please check that your locale settings:
    LANGUAGE = (unset),
    LC_ALL = (unset),
    LANG = "ja_JP.UTF-8"
    are supported and installed on your system.
perl: warning: Falling back to the standard locale ("C").

This is perl, v5.10.1 (*) built for x86_64-linux-thread-multi

Copyright 1987-2009, Larry Wall

Perl may be copied only under the terms of either the Artistic License or the
GNU General Public License, which may be found in the Perl 5 source kit.

Complete documentation for Perl, including FAQ lists, should be found on
this system using "man perl" or "perldoc perl".  If you have access to the
Internet, point your browser at http://www.perl.org/, the Perl Home Page.

と出て来た場合の対処法です。

まずlocaleでja_JP.utf8があるか確認します。(多分無い)

locale -a 

でja_JP.utf8無い場合は 以下に進んでください

glibc-commonパッケージになっていたので 多分あるのでここ飛ばしてもよいですが念のため /usr/share/i18n/charmaps にUTF-8.gzがあることを確認 /usr/share/i18n/locales にja_JPがあることを確認

localeを作成します。

sudo localedef -i ja_JP -f UTF-8 ja_JP.utf8

再びlocaleコマンドを実行するとja_JP.utf8が出来たことを確認してください。

locale -a 

これでwarningが無くなります

Visitorパターン(デザインパターン)

結城さんのJava言語で学ぶデザインパターン入門を読んでみたけど、 Visitorパターンが理解できなかったので少し調べて自分なりにまとめてみた。

Visitorパターンが解決してくれる場面
Interface 動物 {
    走る();
  食べる();
}

Class 犬 : 動物 {
    走る();
  食べる();
}

class 猫 : 動物 {
    走る();
    食べる();
}

というクラスと

function 行動 ( 動物 pet ) {
  pet.走る()
  pet.食べる()
}

という動物Classを使用する関数があったとする。

この場合新しく動物を追加する場合は

class 虎 : PARENT 動物 {
    走る();
    食べる();
}

という新しいクラスを追加すればよく 通常のポリモーフィズムで簡単に実現できる。

では、行動という関数に

pet.寝る()

という行を追加したい場合はどうだろうか?

この場合はインターフェースとそれを実装するクラス すべてに寝るというメソッドを追加しなくてはならなく、 変更の分散(不吉な匂い)につながる。

これを解消してくれるのがVisitorパターンである。

Visitorパターンの例

Visitorパターンでは行動をクラスとして考える

走る run;
食べる eat;
function 行動 ( 動物 pet ) {
    run.開始(pet);
    eat.開始(pet);
}

のように呼びたいが、 このままでは開始メソッド内で、 どのペットかわからないので各ペット毎に違った動作が出来ない。 従って動物自身にそれぞれ犬開始、猫開始を呼んでもらうことで解決するようにする。

走る run;
食べる eat;
function 行動 ( 動物 pet ) {
    pet.開始(run);
    pet.開始(eat);
}

Interface 動物 {
    開始();
}

Class 犬 : PARENT 動物 {
    開始(動作 play) {
        play.犬開始(this)
    }
}

class 猫 : PARENT 動物 {
    開始(動作 play) {
        play.猫開始(this)
    }
}

Interface 動作 {
    猫開始(動物);
    犬開始(動物);
}

class 走る : 動作 {
    猫開始(動物);
    犬開始(動物);
}

class 食べる : 動作 {
     猫開始(動物);
     犬動作(動物);
}

これで新しい動作を追加する場合にクラスを一つ追加するだけで対応出きるようになり 変更の分散にならなくなる。

問題点と使いどころ

上のコードをみて気づくと思うがVisitorパターンを使用したとき、 今度は新しく虎(動物)を加えようとすると動作すべてに虎開始を追加しなくてはいけなくなり、 変更の分散につながる。

動物クラスは増えずに動作のみ増える状況 いわゆる振る舞いのみ増えるよ状況でVisitorパターンを使用することが出来る。

Module::Starterから自分用のテンプレートを生成する

Module::Starter

http://search.cpan.org/~xsawyerx/Module-Starter-1.60/lib/Module/Starter.pm

Module::Starterをcpanからインストールするとmodule-starterコマンドが使用できるようになり、

module-starter --modules=Hoge::Fuga --distro=hoge-fuga

とかすると、

hoge-fuga/:
Changes  MANIFEST  Makefile.PL  README  lib  t

hoge-fuga/lib:
Hoge

hoge-fuga/lib/Hoge:
Fuga.pm

hoge-fuga/t:
00.load.t  perlcritic.t  pod-coverage.t  pod.t

のようにモジュール用のテンプレートファイルが作成されます。 便利なのですが、現在のプロジェクトに合わせるのには自分用にいろいろカスタマイズが必要だったので その方法を調べてみました。

module-starterの設定

module-sterterのconfigファイルは ~/.module-starter/confg ファイルで行います。

root@localhost$ cat ~/.module-starter/config 
author: totofuga
email: test@test
plugins: Module::Starter::Simple

author には作成者名 email にはメールアドレスになります。

module-starterコマンド

f:id:totofuga:20130909151147g:plain

module-starterの呼び出すと上記のように Module::Starter::Appのrunが呼び出されます。 Module::Starter::Appのrunはmodule-starterのconfigファイルのplugins項目に書かれているクラスを生成して

の各メソッドを順に呼び出します。

先ほど設定したplugins項目のModule::Starter::Simpleはモジュール呼び出しのベースとなるクラスで、 上の関数がすべて定義されたクラスなのです。

module-starterをテンプレートから読み込むようにする

plugins項目に複数のクラスを書くとそれらを継承したクラスが呼ばれるようになるのを利用して Module::Starter::Simpleを拡張します。

まずはModule::Starter::Plugin::Templateクラスを追加してみます。

http://search.cpan.org/dist/Module-Starter/lib/Module/Starter/Plugin/Template.pm

cpanからModule::Starter::Plugin::Templateを追加してconfigファイルのplugins項目を

plugins: Module::Starter::Simple, Module::Starter::Plugin::Template

のように変更します。 左が継承元、右が継承先になります。

Module::Starter::Plugin::Templateはcreate_distroをオーバーライドして、 pmやtファイルの生成時にrenderを呼び出すように変更するテンプレートメソッドのクラスになっていてそのままでは使用できません。

Module::Starter::Plugin::Templateを使用するためには

  • renderer (出力エンジンを返す)
  • render (出力を行う)
  • templates (使用するテンプレートを返す)

の三つを実装する必要があります。

f:id:totofuga:20130909154721g:plain

templatesを実装するモジュール

Module::Starter::Plugin::DirStoreはtemplatesを実装してありディレクトリからテンプレートを取得するモジュールです。 今回はこれを使用してみます。

http://search.cpan.org/~rjbs/Module-Starter-Plugin-SimpleStore-0.144/lib/Module/Starter/Plugin/DirStore.pm

cpanからインストール後、configファイルのplugins項目に追加して、 さらにtemplate_dir項目を追加することそのディレクトリからテンプレートファイルを読み込むようになります。

plugins: Module::Starter::Simple, Module::Starter::Plugin::Template, Module::Starter::PluginDirStore
template_dir: /root/.module-starter/templates

注意: この時template_dirを~/ではじめるとエラーになるので絶対パスで指定します。

rendererとrenderを実装するモジュール

Module::Starter::Plugin::TT2はTemplateToolKitを使用してrendererとrenderを実装するモジュールです。 今回はこれを使用してみます。

http://search.cpan.org/~rjbs/Module-Starter-Plugin-TT2-0.125/lib/Module/Starter/Plugin/TT2.pm

cpanからインストール後、configファイルのplugins項目に追加します。 さらにそのままだとwarningが出るのでtemplate_parmsもundefで設定しておきます。(template_parmsはTemplate->newに渡す引数でevalされて使用されます。)

plugins: Module::Starter::Simple, Module::Starter::Plugin::Template, Module::Starter::Plugin::DirStore, Module::Starter::Plugin::TT2
template_dir: /root/.module-starter/templates
template_parms: undef

f:id:totofuga:20130909210118g:plain

テンプレートファイルを作成する

作成可能な主なファイルは以下です。

  • MANIFEST(files)
  • Makefile.PL(main_module, main_pm_file)
  • README(build_instructions)
  • Module.pm(module, rtname)
  • .tで終わるテストファイル(modules)

カッコで指定した値はファイル内で使用できる変数です。 ファイルを作成しないと空ファイルとして作成され、 .tで終わるファイルを作成するとt/下のフォルダにそのファイルが作成されます。

今回は Module.pm を定義してみましょう。

~/.module-starter/templates/にModule.pmを作成して以下の内容を書き込みます。

# this is a module.pm
# module: [% module %]
# rtname: [% rtname %]
# author: [% self.author %]
# hoge:   [% self.hoge %]

先ほど書いたようにModule.pmはmoduel, rtnameという変数が使用できます。 その他にself.で始めるとconfigファイルに書かれた値を参照できます。 hogeを参照しているので、configファイルに

author: test_user
hoge: fuga

を追加しておきます。

そして

module-starter --distro=hoge-fuga --module=Hoge::Fuga

を実行するとhoge-fuga/lib/Hoge/Fuga.pmに

# this is a module.pm
# module: Hoge::Fuga
# rtname: hoge-fuga
# author: test_user
# hoge:   fuga

と展開され自分用のテンプレートが作成できるようになります。

参考にさせてもらったサイト

外部プログラム実行時にエラー出力と終了ステータスも取得する

外部プログラムを実行した時に出力される値には

があります。

http://codepad.org/duNbERYM

use strict;
use warnings;
 
print "std out print";
warn "std err print\n";
 
exit(99);

のようなテストプログラムのすべての値を取得したいとします。

標準出力の取得

perlには外部プログラムを実行する便利な構文としてバッククォートがあるので

my $std_output = `output.pl`;

のように使用すれば標準出力はすぐに取得することができます。

標準エラー出力の取得

先ほどのプログラムでは標準エラー出力が親プロセスと同じになってしまうため 画面にそのまま表示されてしまいます。

そこで標準エラー出力をキャプチャしてみました。

#!/usr/bin/env perl
use strict;
use warnings;
use feature qw(say);

my $std_err;
my $std_out;
{
    open my $err_handle, '>', \$std_err or die "open error";
    local *STDERR = *$err_handle;

    $std_out = `./print.pl`;
}

say "std-out: $std_out";
say "std-err: $std_err";

しかし結果は、

std err print
std-out: std out print
Use of uninitialized value $std_err in concatenation (.) or string at /root/abc/test.pl line 16.
std-err: 

どうやらSTDERRは子に反映されないようです。

open3を使用する

調べてみるとCPANIPC::Open3と言うものがあり、 標準出力と標準エラー出力を分けてとれるようになるみたいです。

ということで簡単に書いてみたのですが、

#!/usr/bin/env perl
use strict;
use warnings;
use IPC::Open3;
use File::Spec;
use feature qw(say);
use Symbol;

my ($stdout_handle, $stderr_handle) = (gensym, gensym);
my $pid = open3(undef, $stdout_handle, $stderr_handle, './print.pl') or die "error $?";

waitpid($pid, 1);

my $std_out = <$stdout_handle>;
my $std_err = <$stderr_handle>;

say "std-out: $std_out";
say "std-err: $std_err";

しかし上記のコードだと http://d.hatena.ne.jp/kazuhooku/20100813/1281690025で kazuhookuさんが言っているように、デッドロックを起こしてしまいます。

修正してみると

#!/usr/bin/env perl
use strict;
use warnings;
use IPC::Open3;
use File::Spec;
use feature qw(say);
use Symbol;
use IO::Select;

my ($stdout_handle, $stderr_handle) = (gensym, gensym);
my $pid = open3(undef, $stdout_handle, $stderr_handle, './print.pl') or die "error $?";

my $print_selector = IO::Select->new($stdout_handle, $stderr_handle);

my $std_out;
my $std_err;
while ( my @redy = $print_selector->can_read ) {
    foreach my $handle ( @redy ) {
        if ($handle == $stdout_handle ) {
            $std_out = <$stdout_handle>;
        } else {
            $std_err = <$stderr_handle>;
        }

        $print_selector->remove($handle) if eof($handle);
    }
}

waitpid($pid, 0);
my $exit_code = $? >> 8;

say "std-out:   $std_out";
say "std-err:   $std_err";
say "exit_code: $exit_code";

結果

std-out:   std out print
std-err:   std err print
exit_code: 99

これで、デッドロックされずにちゃんと取得できるようになります。

参考にさせてもらったサイト

Perlクックブック(Volume2)のレシピ16-9にこの辺の話が詳しく載っています。