差分

このページの2つのバージョン間の差分を表示します。

--- documents:proglang:perl:perl-004 [2026/05/08 11:54] – ↷ documents:perl:perl-004 から documents:proglang:perl:perl-004 へページを移動しました。 k896951
+++ documents:proglang:perl:perl-004 [2026/05/17 15:06] (現在) – [ＩＰメッセンジャーへメッセージを送る Perl版] k896951
@@ 行 1: / 行 1: @@
+====== 102.ＩＰメッセンジャーへメッセージを送る Perl版 ======
+年01月31日 03時02分02秒\\
+新規
+年6月13日\\
+NKF.pmを使わないソースを追加。意外と需要があったのね。
+===== これは何？ =====
+perlで書いたＩＰメッセンジャークライアント簡易版の説明。
+たまたま、rubyスクリプトで記述されたＩＰメッセンジャークライアントをWeb上で見付けました。
+ジョブの結果をメッセージで知らせる為のものだったようです。
+非常に短くすっきりと書かれていて、「こんな簡単にかけるんだ」と認識。早速Perl対応版を書いてみました。
+※覚書に付き正確性は保証できない
+===== 本物とは違うところ =====
+このスクリプトで送ったメッセージへの返信はできないかもしれません。
+なぜなら、送った先のクライアントのリストに現れていないユーザから受信すると「送信者不明」のメッセージになってしまうのです。
+つまり、匿名で送ってしまう感じになります。
+※ＩＰメッセンジャーの種類によっては送り主のＩＰアドレスを表示できるものもあるかもしれません。
+===== 使い方 =====
+以下のコマンドラインでメッセージを送ります。
+  perl ipmsg.pl 送り先IPアドレス  送り主ニックネーム  メッセージ文字列
+または
+  cat << EOF | perl ipmsg.pl 送り先IPアドレス  送り主ニックネーム
+  メッセージ文字列
+  EOF
+でスクリプトにメッセージを食わせます。
+===== ソース =====
+Perl5.8以降で使える(と思う)Encode.pmを使ったソース。ipmsg.pl と名称をつけてください。
+<code perl ipmsg.pl>
+#!/usr/bin/perl -w
+#
+# ipmsg.pl <host to send> <your name> <message>
+#
+# ipmsg.pl <host to send> <your name>   ... input message from STDIN
+#
+use Socket;
+use Sys::Hostname;
+use Encode;
+## self info
+my $selfencode = "euc-jp";
+my $outencode  = "shift-jis";
+## to info
+my $tohost   = gethostbyname( $ARGV[0] );
+my $toport   = 2425;
+## from info
+my $myname   = $ARGV[1];
+my $myhost   = "hostHoge";
+## net info
+my $proto    = getprotobyname('udp');
+my $ihost    = gethostbyname(hostname());
+my $ipaddr   = sockaddr_in( 0,       $ihost  ); # 0 means let kernel pick
+my $hispaddr = sockaddr_in( $toport, $tohost );
+my $sendtext;
+  if (@ARGV == 3) {
+    my $c = $ARGV[2];
+    $sendtext = sprintf( '1:%d:%s:%s:32:%s', int(rand(100))+1, $myname, $myhost, encode($outencode, decode($selfencode,$c)) );
+  }
+  else {
+    my $c = <STDIN>;
+    $sendtext = encode($outencode, decode($selfencode,$c));
+    $sendtext = sprintf( '1:%d:%s:%s:32:%s', int(rand(100))+1, $myname, $myhost, $sendtext );
+  }
+  socket( SOCKET, PF_INET, SOCK_DGRAM, $proto);
+  bind( SOCKET, $ipaddr);
+  send( SOCKET, $sendtext, 0, $hispaddr);
+</code>
+コード中の
+<code perl>
+my $selfencode = "euc-jp";
+</code>
+はスクリプトを実行するシステムによります。私はeuc-jpな環境で実行したのでこうなっています。utf-8な環境の人はここの書き直しが必要でしょう。
+NKF.pmをつかう古いソース。ipmsg.pl と名称をつけてください。
+<code perl ipmsg.pl>
+ #!/usr/bin/perl -w
+ #
+ # ipmsg.pl <host to send> <your name> <message>
+ #
+ # ipmsg.pl <host to send> <your name>   ... input message from STDIN
+ #
+ use Socket;
+ use Sys::Hostname;
+ use NKF;
+ ## to info
+ my $tohost   = gethostbyname( $ARGV[0] );
+ my $toport   = 2425;
+ ## from info
+ my $myname   = $ARGV[1];
+ my $myhost   = "hostHoge";
+ ## net info
+ my $proto    = getprotobyname('udp');
+ my $ihost    = gethostbyname(hostname());
+ my $ipaddr   = sockaddr_in( 0,       $ihost  ); # 0 means let kernel pick
+ my $hispaddr = sockaddr_in( $toport, $tohost );
+ my $opt = "-sLw";
+ my $sendtext;
+   if (@ARGV == 3) {
+     my $c = $ARGV[2];
+     $sendtext = sprintf( '1:%d:%s:%s:32:%s', int(rand(100))+1, $myname, $myhost, nkf($opt,$c) );
+   }
+   else {
+     my $c = <STDIN>;
+     $sendtext = nkf($opt, $c);
+     $sendtext = sprintf( '1:%d:%s:%s:32:%s', int(rand(100))+1, $myname, $myhost, $sendtext );
+   }
+   socket( SOCKET, PF_INET, SOCK_DGRAM, $proto);
+   bind( SOCKET, $ipaddr);
+   send( SOCKET, $sendtext, 0, $hispaddr);
+ </code>
+NKF.pm および Socket.pm が必要になります。
+※Perl 5.8とかであれば NKF.pm無しにかけるようになるみたいですね。
+{{tag> Perl 技術資料}}