Perlでソケットが受信したメッセージをprintで出力されなかった挙動についてとscalar関数について

【下にプラグインを追記。正直check_tcpの再発明の気が今でもするけど。】
今日、Nagiosで監視プラグインを作るのにちょっとしたPerlスクリプトを書いていた。
概要はこんなの。※というかソケット通信の処理は「Geekなページさんの：簡単なTCPサーバとクライアント」のコピペでやりました＞＜

#!/usr/bin/perl

use IO::Socket;

$sock = new IO::Socket::INET(PeerAddr=>'localhost',
                PeerPort=>12345,
                Proto=>'tcp');

die "IO::Socket : $!" unless $sock;

print $sock "HELLO!!!\n";

print <$sock>;

close($sock);

で、サーバ側はクライアントが送信した物を単純に返すechoサーバで、
接続する→メッセージ送信→メッセージ受信・出力→終了
という事をやりたかったのですが、上記のコードだと
接続する→メッセージ送信で止まってしまいました。

「うわーん、なんだよー(ノД`)・゜・。」とツイッターにつぶやいた所、
神様（id:kamipoさん）が！

「（略）print scalar <$sock>; とかで回避できませんか？」
http://twitter.com/kamipo/status/30911702069415937

「Perlは呼び出し側がスカラー値を期待するかリストを返すのを期待するかで挙動が変わる関数があるんですよ。（略）」
http://twitter.com/kamipo/status/30915143441321984

??(ﾟДﾟ；)そ、そんな動きが・・・という事なので、

print <$sock>;

を

print scalar <$sock>;

と修正するとちゃんと期待した動作が！！！！！

で、scalar関数の事を調べてみると、

「指定した値ををスカラー・コンテキストで評価します。
例えば，printのようにリストを引数に取る関数にlocaltimeのようなリスト・コンテキストとスカラー・コンテキストで
結果が変わる関数を指定すると，リスト・コンテキストに対する値を返します。
このときscalarを使うと，スカラー・コンテキストに対する値を返すことができます。」
http://itpro.nikkeibp.co.jp/article/Reference/20080930/315749/

との記述が。なので、受信した文字列がちゃんとスカラー・コンテキストとして扱われない状態だったので、
ずーっと待ちに入ってしまったようです。

最終的にちゃんとした回避策としては、
「サーバ側がEOFを返したりcloseしたりすればリストコンテキストでもブロッキングされないはず！」
http://twitter.com/#!/kamipo/status/30958226568646657
という事で、サーバ側のclose箇所を変えてみるとちゃんと初めのコードでも問題無く動きました！
ちゃんちゃん。

上記の処理で動作確認がちゃんと出来たので、最終的にはこんな感じのプラグインにしました。
送信メッセージと受信するはずのメッセージをオプションで指定して、
期待通りだったら戻り値0、ダメならNagiosでCriticalと判定するために戻り値2です。

#!/usr/bin/perl

use IO::Socket;
use Getopt::Long;

my %config = ();
my $help_msg = "-ho [host(:must)] -p [port(:must)] -s [send_message] -r [recive message] --HELP or -H => PRINT HELP MESSAGE  \n\n";

GetOptions(\%config, 'host=s', 'port=i', 'send_msg=s','rcv_msg=s','HELP');

if ( $config{help} == 1){
        print $help_msg;
        exit(1);
}

$config{send_msg} ||= "HELLO Server\n";
$config{rcv_msg} ||= "status OK\n";
die "$help_msg \n\n " unless defined $config{host} and $config{port};

sub connect_test {
        my $host = $_[0] ;
        my $port = $_[1] ;
        my $send = $_[2] ;
        my $rcv  = $_[3] ;

        $sock = new IO::Socket::INET(PeerAddr=> $host,
                PeerPort=> $port,
                Proto=>'tcp');

        die "IO::Socket : $!" unless $sock;

        print $sock "$send\n";
        print "Client RECV START\n\n";

        my $tmp = <$sock>;
        close($sock);

        if ( $tmp =~ /$rcv/){
                print "Server Response OK !! \n\n";
                exit(0);
        }
        else {
                print "Server Response NG !!!! \n";
                exit(2);
        }
}

connect_test($config{host},$config{port},$config{send_msg},$config{rcv_msg});