Perlはもう古い、これからはDocker

本記事の内容はWEB+DB Vol.88 Perl Hackers Hub 第34回 に「DockerによるPerlのWebアプリケーション開発」という記事にまとめなおしていますのでそちらをご覧ください。

この記事は Perl Advent Calendar 2014 の19日目の記事です。 Plack/Carton で構築したモダンな Perl の Web アプリケーションの開発環境を Docker 化するための試行錯誤を紹介します。

普段は、Plack, Router::Simple, Text::Xslate, DBIx::Sunnyなどを組み合わせたフレームワークでアプリケーションを書く/運用することが多いですが、今回はサンプルとして Amon2 を使いました。 サンプルは GitHub に置いています。

続きを読む

とにかくややこしいことをしない ORM がほしくて Coteng とかいうCPANモジュールを作った

名前の通り、Teng::Lite みたいなモジュールを作った。 Teng::Lite でも良かったけど、なんとなくそれっぽい名前が思い浮かんだのでそれにした。 ORM というよりはやや重めのDBIラッパーかもしれない。

早速、会社で作ってるサーバ管理アプリケーションのTengをCotengに置き換えてみた。 サーバ管理アプリケーションの話はこっち。YAPC::Asia 2013ではてなのサーバ管理ツールの話のはなしをしました - ゆううきブログ

背景

普段Perlの ORM として、Teng にお世話になっている。 ただ、最近採用しているフレームワークとの相性が悪くて、そんなに使わない機能があったりする。 もうちょっと薄いやつがほしくて探したけど無かったので自分で書いた。 探した中で スキーマ定義がいらないという点で DBIx::Lite が一番近かったかもしれない。 DBIx::Liteについてはmotemenさんの資料がわかりやすい。

Kyoto.pm #2 で DBIx::Lite の紹介をしました #kyotopm - NaN days - subtech

先に採用しているフレームワークというものをまず簡単に説明しておく。 ちなみに、Amon2みたいな実装としてのフレームワークではなくて、考え方としてのフレームワークのことを言っているつもり。

まず大きな方針として、

コストの高い処理やリスクの高い処理を気軽に書けないようにする

というのがある。

SQLの発行というのは、Webアプリケーションに必要とされる処理の中で、コストの高い処理に分類されると思う。 ActiveRecord的なパターンに従うと、Modelクラスにfindとかdeleteや、リレーションテーブルへのSQLを発行するメソッドが生えていたりするのが普通だと思う。 ただこれだと、例えば、$user->bookmarks とかやって、コストの高い処理を簡単に書けてしまう。 そこで、SQLを発行する処理はService層に書くっていうのをやってる。 '層'というと大げさで、実際はただのクラスメソッドの集まりになってる。

例を挙げると以下の様な感じ。 https://github.com/hatena/Intern-Bookmark-2013/blob/master/lib/Intern/Bookmark/Service/Bookmark.pm

package Intern::Bookmark::Service::Bookmark;

# Service層のメソッド。ただのクラスメソッド。
sub find_bookmarks_by_entry {
    my ($class, $db, $args) = @_;

    my $entry = $args->{entry} // croak 'entry required';

    $db->dbh('intern_bookmark')->select_all_as(q[
        SELECT * FROM bookmark
          WHERE entry_id = :entry_id
    ], {
        entry_id => $entry->entry_id,
    }, 'Intern::Bookmark::Model::Bookmark');
}

# 呼び出し元
package Intern::Bookmark::Service::Bookmark;

my $bookmarks = Intern::Bookmark::Service::Bookmark->find_bookmarks_by_entry(
    $c->db,
    { entry => $entry },
);

もう少し複雑な例。SQL::Makerを使ってクエリを組み立ててる。

package Intern::Bookmark::Service::Bookmark;

sub find_bookmarks_by_user {
    my ($class, $db, $args) = @_;

    my $user = $args->{user} // croak 'user required';

    my $per_page = $args->{per_page};
    my $page = $args->{page};
    my $order_by = $args->{order_by};

    my $where = {
        user_id => $user->user_id,
    };
    my $opts = {};
    $opts->{limit} = $per_page if defined $per_page;
    $opts->{offset} = ($page - 1) * $per_page if defined $page && defined $per_page;
    $opts->{order_by} = $order_by if defined $order_by;

    my ($sql, @binds) = $db->query_builder->select('bookmark', ['*'], $where, $opts);

    $db->dbh('intern_bookmark')->select_all_as($sql, @binds, 'Intern::Bookmark::Model::Bookmark');
}

上記の呼び出し元をみると、ActiveRecord的な$entry->bookmarksと比べて、Intern::Bookmark::Service::Bookmark->find_bookmarks_by_entry とかやってて明らかにめんどくさくなってる。 ただ、これは「コストの高い処理やリスクの高い処理を気軽に書けないようにする」にしたがっているので、こういう感じでよい。 オブジェクト指向的には美しくないかもしれないけど、現実を見てる感じがする。 N+1なクエリを投げてるとすぐに気づく。

ちなみにこのへんは shiba_yu36 先生に教わった。 不揮発性RAMがコモディティ化したり、Infinibandが普及したりして、ディスクI/OとネットワークI/Oが異常にはやくなって、ボトルネックがCPUに移ってくると、気軽にSQLを発行できてもいいのかもしれない。

ただし、今作ってるアプリケーションでは、コントローラとモデルの個数がかなり多くて、同じような処理をたくさん書かないといけない。 本来は丁寧にService層にロジックを書いたらいんだけど、さすがにidとか適当なカラム名で引くだけの簡単なSQLを毎回丁寧にService::Hogeに書いていくのはつらい。 $teng->singleとか$teng->searchとかを直接コントローラに書いたらいいというところで話はとりあえず落ち着く。

しかし、こういうフレームワークだと、Teng::Rowに生えてるdeleteとかupdateとかを使わないし、Teng::Rowオブジェクトはスキーマ情報とかを保持しているからwarn Dumper $rowとかすると不要な情報が結構出てきてしまう。 さらにいうと、Teng::Iteratorを使う局面が今のところないし、スキーマDSLを書かないといけないのも少々めんどくさいし、blessするしないを。

そこで、SQL::Makerでクエリを組み立てて、DBIx::Sunny経由で実行するぐらいのものがあればちょうどよいような気がした。 Tengのsingleとかsearchとかのインタフェースは結構好きなので、ほとんどそのままにしてる。

SYNOPSIS

雰囲気はなんかこういう感じ。

use Coteng;

my $coteng = Coteng->new({
    connect_info => {
        db_master => [
            'dbi:mysql:dbname=server;host=dbmasterhost', 'nobody', 'nobody', {
                PrintError => 0,
            }
        ],
        db_slave => [
            'dbi:mysql:dbname=server;host=dbslavehost', 'nobody', 'nobody',
        ],
    },
});

my $inserted_host = $coteng->db('db_master')->insert(host => {
    name    => 'host001',
    ipv4    => '10.0.0.1',
    status  => 'standby',
}, "Your::Model::Host"); # "Your::Model::Host"でblessされた結果が返る

my $host = $coteng->db('db_slave')->single(host => {
    name => 'host001',
}, "Your::Model::Host");

my $hosts = $coteng->db('db_slave')->search(host => {
    name => 'host001',
}, "Your::Model::Host");

Modelクラスでblessしたくないとき

my $hosts = $coteng->db('db_slave')->single(host => {
    name => 'host001',
});
my $host = $coteng->db('db_slave')->single_named(q[
    SELECT * FROM host where name = :name LIMIT 1
], { name => "host001" }, "Your::Model::Host");

my $host = $coteng->db('db_slave')->single_by_sql(q[
    SELECT * FROM host where name = ? LIMIT 1
], [ "host001" ], "Your::Model::Host");

my $hosts = $coteng->db('db_slave')->search_named(q[
    SELECT * FROM host where id = (:ids)
], { id => [1, 2, 3] }, "Your::Model::Host");

my $hosts = $coteng->db('db_slave')->search_by_ql(q[
    SELECT * FROM host where status = ?
], [ "working" ], "Your::Model::Host");

Modelクラス

ModelクラスはClass::Accessor::Liteとかで作ってることが多い。 Mouse使ってないけど、Mouseでも良さそう。

package Your::Model::Host;

use Class::Accessor::Lite (
    ro => [qw(
      id
      name
      ipv4
      status
      created
    )],
);

1;

雑感

自分がORM的なものに求めている必要十分なものはとりあえずできてる気がする。 フレームワークとかORMをプロジェクト毎に自作する文化に触れていると、最小限のモジュールがとにかくほしくて、絢爛豪華な料理に飽きた食通みたいなおじさんが木の実とかを食べ始めるみたいになる。 けど、そういう文化に興味なかったら普通にTeng便利だと思う。

songmuさんのYAPCの資料とかみてると鎌倉の文化とはだいぶ違うなーという感じがしてる。

YAPC::Asia 2013ではてなのサーバ管理ツールの話のはなしをしました

YAPC::Asia 2013で"はてなのサーバ管理ツールの話"というはなしをします - ゆううきブログ

YAPC::Asia Tokyo 2013で、アルバイトで開発してたサーバ管理ツールのはなしをしました。 前半がサーバ管理ツールの開発思想で、後半がサーバメトリクス可視化の実装についてです。 キワモノツールであるRRDtoolの話は後ろに押し込んであるので、興味ない方は最初のほうだけ見てもらえればよいと思います。

感想

トーク後に結構話しかけられたりしてうれしかった。 トークの内容をブログに書いて、インターネット上で何か反響を得たことはあったけど、トークしたその後、直接話しかけられることは今まであまりなかった気がする。 コミュニティで認められるのに何か発表するのって大事だなと改めて思った。

RRDtoolをご存知の方が会場内でパッとみで1/4くらいいらっしゃったので、結構インフラ系の人来てたのかなという感触だった。

しかし、RRDtoolの話もうやめたい。 プログラマッブルで疎結合な最高のツールの話をしたい。

YAPC1日目の様子です

TCP 3-way handshakeのレイテンシ軽減のためのTCP_DEFER_ACCEPTソケットオプション

2013/10/22 追記した.

Starletのコード読んでてlistening socketにTCP_DEFER_ACCEPTとかいうオプション渡してたので、これ何だって思って調べた.
TCPに特に詳しいわけではないので理解に誤りがあるかもしれない.

package Starlet::Server;
...
    # set defer accept
    if ($^O eq 'linux') {
        setsockopt($self->{listen_sock}, IPPROTO_TCP, 9, 1) # 9がTCP_DEFER_ACCEPTを表す
            and $self->{_using_defer_accept} = 1;
    }
...

TCP_DEFER_ACCEPTはLinux 2.4から導入されている.
Linux 2.6.32から挙動が若干変わっているらしい. (linux の TCP_DEFER_ACCEPT (サーバサイド) の挙動について - kazuhoのメモ置き場)
ApacheとかNginxでも使われてるっぽい.

TCP_DEFER_ACCEPTを理解するのに下記の記事が参考になった.
Take advantage of TCP/IP options to optimize data transmission - TechRepublic

TCP_DEFER_ACCEPTが導入された動機

HTTPリクエストに必要なデータサイズは小さいため,HTTPリクエストは1個のパケット(DATAパケット)に収まる.
本当に必要なパケット(DATAパケット)は1個なのにTCPの3-way handshakeをやらないといけなくて,HTTPリクエストを受信するまでに必要なパケット数が4個になる.

これらの4個のパケットのせいで余分な遅延やオーバヘッドが発生してしまう.
例えば,3-way handshakeのfinal ACKがパケットロスしたときに,サーバはESTABLISHED stateに移行しない.
ESTABLISHEDになってないと,final ACKの次に送信されたDATAパケットがサーバ到着後にdropされたりする.
この場合は,サーバがSYS/ACKを再送してクライアントのACKを待つことになる.

TCP_DEFER_ACCEPTの挙動

listening socketかconnected socket(つまりサーバサイドかクライアントサイド)のどちらにTCP_DEFER_ACCEPTオプションをつけるかで挙動が変わる.

listening socketの場合は,final ACKを待たずに,DATAパケットを受信するまで,accept(2)をブロックする. (普通はfinal ACKを受信した時点でacceptは処理をユーザプロセスに戻す)
これにより,final ACKがパケットロスしても,DATAパケットさえ受信すればaccept(2)は成功する.
したがって,DATAパケットのロスが無ければSYN/ACKの再送を回避できる.

connected socketの場合は,サーバからSYN/ACKを受信した後すぐにACKを返さずに,ユーザプロセスがwriteを発行した時点でDATAパケットとACKを一緒にして返す.
これにより,やりとりするパケットを1個減らせる.

上記の挙動からわかるように,TCP_DEFER_ACCEPTの使用はクライアントがACKの送信後にすぐにデータを送信する,つまりクライアントから喋り始めるプロトコルであることが前提となっている.

雑感

SYN/ACKの再送問題を回避したい(他にもあるかもしれない)っていうTCP_DEFER_ACCEPTの目的がすぐに理解できなかった.
acceptをブロックするとか動作の内容は書いてあるけど,何のためにそんなことをするのかを直接的に説明した文章が見つからなくてつらい感じだった.

参考

追記

Starletの作者であるkazuhoさんやkazeburoさんからコメントいただきました.

Test::Classのテストメソッド内でsubtestを使うときに起こる問題の原因と対策

id:nobuokaさんがこういう感じの問題に直面していたので調査してみた。

Test::Class と subtest を組み合わせた場合に、とあるテストメソッドの subtest 内で例外が発生してしまうと、それ以降の別のテストメソッドの subtest も全部失敗してしまうっぽい? - えっちなのはいけないと思います

結論から言うと、subtest内で例外が送出されたときにTest::Classのテストメソッドが例外をキャッチしてしまい、Test::Builderインスタンスが初期化されないまま次のテストメソッドを実行することが原因である。

テストメソッドt2を呼び出した時に具体的に失敗する箇所は以下のコード。 Test::Builderインスタンスの'Child_Name'メンバが初期化されていないから例外が投げられるようにみえる。

package Test::Builder;
# ...
# finalizeはsubtest実行時の最後に呼ばれる
sub finalize {
    my $self = shift;

    return unless $self->parent;
    if( $self->{Child_Name} ) {
        $self->croak("Can't call finalize() with child ($self->{Child_Name}) active"); # ここ
    }
    # …  
    $self->parent->{Child_Name} = undef;  # ここでChild_Nameが初期化される
    # ...  
}

Test::Classのテストメソッドの中でsubtestを呼ばなければcroakした時点でテストは終了するから問題はない。

しかし、Test::Classのテストメソッドの中でsubtestを呼ぶとcroakしてもTest::Class側でevalされて、死なずに次のテストメソッドを実行する。

package Test::Class;
# ...
sub _run_method {
# ...
    $skip_reason = eval {$self->$method}; # 例外補足
# ... 
}

Test::BuilderインスタンスはsingletonなのでMyTest名前空間スコープでは生存したままになる。

package Test::Builder;
# ...
our $Test = Test::Builder->new; # singletonだ

sub new {
    my($class) = shift;
    $Test ||= $class->create;
    return $Test;
}

したがって,次のテストメソッド(t2)の中でsubtestを呼ぶとTest::Builderインスタンスのメンバである'Child_Name'は初期化されていないので,finalize実行時にコケる。

ちなみにfinalizeはsubtestを実行しないと呼ばれないのでテストメソッド内でsubtestを使わない場合は何も問題ない。

対策

Test::Builderインスタンスを初期化してやればよいので下記のコードの

__PACKAGE__->builder->reset;

を追加すればt1が失敗してもt2はちゃんと成功する。 ただし,resetを実行すると'Child_Name'以外にもいろいろ初期化してしまうため副作用がありそう。 実際に初期化が必要なものは'Child_Name'メンバだけなので、

__PACKAGE__->builder->{Child_Name} = undef;

のほうがいいかもしれない。 teardownで呼べばよさそう。

package MyTest;
use utf8;
use strict;
use warnings;
use parent qw(Test::Class);

use Test::More;

sub t1 : Tests {
    subtest 'ok if I die?' => sub {
        die "I'l die";
    };
}

__PACKAGE__->builder->reset;

sub t2 : Tests {
    subtest 'okokokok!!!' => sub {
        ok 1;
    };
}

__PACKAGE__->runtests();

__END__

prove test.t
test.t .. #
# MyTest->t1
    # Child (is it ok if I die?) exited without calling finalize()

not ok 1 - is it ok if I die?
not ok 2 - t1 died (I'l die at test.t line 11.)

#   Failed test 'is it ok if I die?'
#   at /Users/yuuki/.plenv/versions/5.14.4/lib/perl5/site_perl/5.14.4/Test/Class.pm line 289.
#   (in MyTest->t1)

#   Failed test 't1 died (I'l die at test.t line 11.)'
#   at test.t line 22.
#   (in MyTest->t1)
#
# MyTest->t2
    ok 1 - t2
    1..1
ok 1 - okokokok!!!
# Tests were run but no plan was declared and done_testing() was not seen.
Failed 2/3 subtests

Test Summary Report
-------------------
test.t (Wstat: 0 Tests: 3 Failed: 2)
  Failed tests:  1-2
  Parse errors: Tests out of sequence.  Found (1) but expected (3)
                No plan found in TAP output
Files=1, Tests=3,  0 wallclock secs ( 0.03 usr  0.01 sys +  0.03 cusr  0.00 csys =  0.07 CPU)
Result: FAIL

例外補足時にちゃんと初期化しないTest::Classが悪いのかもしくはsingletonとか使ってるTest::Builderが悪いのか。

Kyoto.pm 05で自作のサーバリソース可視化ツールのはなしをしました

nekokakさんを呼んで、7/13(土)にKyoto.pm 05 Tech Talkを開催します!!!!! - $shibayu36->blog;

Kyoto.pm 05で自作のサーバリソース可視化ツールについて20分くらいしゃべりました。 簡単にいうと、既存のサーバリソース可視化ツールのサブシステムとして個別に実装されているであろうRRDtool周りの処理を汎用化したものです。 Monitorelと呼んでます。

まだちゃんとしたプロダクトにはなっていません。 Proof Of Conceptです。

スライドはこんな感じです。

なにがRRDtoolだ。

トーク感想

今日はJPA派遣講師としてnekokakさんに来ていただいていました。 分散型Job QueueシステムのClutchのお話でした。 どうもありがとうございました。 あとTengとかQudoとかいつもお世話になっています。 それとJob Queue周りの記事とかでよく勉強させていただいています。

Clutchの話はこの辺にあったりしました。 blog.nekokak.org - blog.nekokak.org

最近、Job Queue使ってて今のところJob Queueサーバを分散したい気運はないけど、そのうちやりそうなので参考にしたい感じ。

最近、8段JOINの解体とかしていて、JOIN便利なんだけどJOINで引いてきた結果をModelオブジェクト(Tengの場合はTeng::Rowオブジェクト)で良い感じにラップできないなと思っていて、songmuさんのTeng::Plugin::SearchJoined便利だと思いました。

あとはonishiさんのDevel::Kytprofとかpapixさんが話してたNephiaとかazumakuniyukiさんのHainekoとかtoku_bassさんのEpub::Parserのコード眺めてたりしました。

Kyoto.pmの様子です

みなさまおつかれさまでした!!! shibayu++

GrowthForecastでサーバルームの室温監視

研究室のサーバールームの空調が弱くて,40コアくらいある計算サーバにフルで仕事させると室温が上がって,全サーバが落ちるみたいな事例が去年あったらしいので,室温のグラフ化とアラートメール送信をやれみたいなタスクが降ってきた.

そこで,サーバルームのうちのサーバ1台にUSB温度計を差して,定期的に温度を取得し,GrowthForecastに投げればいいと考えた. アラートメールのほうは温度を取得したのちに閾値を超えていたらsendmailでメール投げる感じ。

USB温度計として下記を使用する.Linuxから温度データを取得できることが重要.

Amazon.co.jp: サンコー USB温度計 AKIBA58: 家電・カメラ

必要なもの

  • Ubuntu 12.04
  • perl (GrowthForacastがPerlで書かれているので必要)
  • GrowthForecast (グラフ表示用のWebアプリケーション)
  • Temper (上記温度をGrowthForecastに登録してくれるスクリプト.アラートメール機能もある)

必要なパッケージとモジュールのインストール

$ sudo apt-get install build-essential libusb-0.1-4 libusb-dev build-dep sendmail git
$ curl -L http://cpanmin.us/ | sudo perl - App::cpanminus
$ sudo cpanm -n GrowthForecast HTTP::Tiny Email::Simple Email::Sender

GrowthFocastのインストール

以前の 研究室のサーバに流行りのGrowthForecastを導入してみた - ゆううきブログ を参照. perlbrew使ってたけど,perl-buildにした.

Temper

Temperをインストールする.TemperはUSBドライバAPIを叩いて上記USB温度計から温度情報を摂氏で取得して標準出力に出力してくれるもので,たぶん有志の人がつくってくれたやつ.

bitplane/temper · GitHub

今回はこれをforkして,出力される時間をJSTに直して,さらにGrorwthForecastのAPIを叩く処理とメール投げる処理を書いたスクリプトを入れておいた.

リポジトリの中身

  • temperコマンド: 温度情報を摂氏で取得して標準出力
  • temper_gfcast.pl: temperコマンドを実行して,GrowthForecastのAPIを叩いて温度を登録し,閾値を超えていたらアラートメールを投げる
  • temper_gfcast.conf: 閾値などの設定を行う
  • install.sh
$ git clone https://github.com/y-uuki/temper
$ cd temper
$ sudo ./install.sh

これで,temperコマンドとtemper_gfcast.plが/usr/local/binに入り,/etc/temper_gfcast/temper_gfcast.confが作成される.

まず, /etc/temper_gfcast/temper_gfcast.confを書き換える.

# Examle
#
# sender: root@example.com
# receiver: server-group@example.com
#
# graph_url: http://example.com/list/server-room/watch
#
# warning_threshold: 35
# critical_threshold: 45
#

sender: server-room@laboraoty
receiver: y_uuki@laboratory

graph_url: http://growthforecast.laboratory/list/server-room/temper

warning_threshold: 35
critical_threshold: 45

senderはメールの送信者,receiverはメールの受信者,graph_urlはGrowthForecast APIのendpointで, warnings_thresholdとcriticalthresholdにはメールアラートのための閾値を設定する.上記の場合,温度が35度以上ならばwarningメールを,45度以上ならばcriticalメールを送信する.

最後に,cronで一定時間ごとにtemper_gfcast.plを実行させておけばよい,

$ sudo crontab -e

cronに下記の一行を登録する. 5分ごとに温度監視することにした.

*/5 * * * * /opt/perl-5.14/bin/perl /usr/local/bin/temper_gfcast.pl >> /var/log/temper.log 2>&1

以上で,おわり.

temper_gfcast.pl

GrowthForecastのAPIはHTTP::Tinyで叩いて,アラートメールは Email::Simpleでメール内容を作成して,Email::Senderを介してsendmailで投げる感じ.

#!/usr/bin/env perl
use utf8;
use strict;
use warnings;

use Try::Tiny;
use HTTP::Tiny;
use Email::Sender::Simple 'sendmail';
use Email::Simple;

use constant {
    TEMPER_PATH => '/usr/local/bin/temper',
    CONF_PATH   => '/etc/temper_gfcast/temper_gfcast.conf',
    DEFAULT_WARN_THRESHOLD     => 35,
    DEFAULT_CRITICAL_THRESHOLD => 45,
};


main();
exit;

sub main {
    my $temp_value = current_temperature();

    # putput log
    my ($sec, $min, $hour, $day, $month, $year) = localtime(time);
    print sprintf("temperature:%d\ttime:%04d%02d%02d-%02d:%02d:%02d\n",
        $temp_value, $year + 1900, $month + 1, $day, $hour, $min, $sec);

    send_to_gfcast($temp_value);

    my $params = parse_conf(CONF_PATH);
    my $mail_from = $params->{sender} or die "Not found sender in conf file";
    my $mail_to   = $params->{receiver} or die "Not found receiver in conf file";
    my $graph_url = $params->{graph_url} or die "Not found graph_url in conf file";
    my $warn_threshold     = $params->{warning_threshold} || DEFAULT_WARN_THRESHOLD;
    my $critical_threshold = $params->{critical_threshold} || DEFAULT_CRITICAL_THRESHOLD;

    for ($warn_threshold, $critical_threshold) {
        die "threshold is invalid. $_ is not integer" if $_ !~ /\d+/;
    }

    return if $temp_value < $warn_threshold;
    # Warning or Critical process

    my $status = $critical_threshold <= $temp_value ? 'critical' : 'warning';

    my $email = create_alertmail($mail_from, $mail_to, $graph_url, $status, $temp_value);
    try {
        sendmail($email);
    } catch {
        die "Failed sending mail $_";
    };
}


sub current_temperature {
    my $output = readpipe(TEMPER_PATH);
    chomp $output;
    unless ($output =~ /,([\d|.]+)/) {
        die "Not Found temperature";
    }
    return int($1);
}


sub parse_conf {
    my $conf_path = shift;

    unless (-f $conf_path) {
        die "file:$conf_path is not found";
    }

    open(my $conf_fh, "<", $conf_path)
        or die "failed to open file:$conf_path";

    my $params = {};
    while (my $line = <$conf_fh>) {
       chomp $line;
       next if $line =~ /^\s*$/; # empty line
       next if $line =~ /^\s*#/; # for commentout

       my ($name, $value) = split(/:\s/, $line);
       $value =~ s/(.+?)#?/$1/;
       $params->{$name} = $value;
    }

    return $params;
}


sub send_to_gfcast {
    my $temp_value = shift;

    my $http = HTTP::Tiny->new;
    my $response = $http->post_form('http://localhost/api/server-room/watch/temperature', {
        number => int($temp_value),
        mode   => 'gauge',
        color  => '#333399'
    });

    if ($response->{status} =~ /^(4\d\d|5\d\d)/) {
       die "$response->{status}: $response->{reason}\n" . $response->{content};
    }
}


sub create_alertmail {
    my ($from, $to, $graph_url, $status, $temp_value) = @_;

    my $body = <<"EOS";
Server Room Temperature

Status: $status
Temperature: '$temp_value' degrees

Graph: $graph_url
EOS

    my $email = Email::Simple->create(
        header => [
            From    => "\"Temperature Alert\" <$from>",
            To      => "<$to>",
            Subject => "Server room tempature $status",
        ],
        body => $body,
        attributes => {
            content_type => 'text/html',
        },
    );
    return $email;
}

参考