Dodany przez: Jacekalex, 06:10 12-03-2016

Nowy Pobierz
  1. #!/usr/bin/perl
  2.  
  3. use strict;
  4. use utf8;
  5. use AnyEvent;
  6. use AnyEvent::XMPP::Client;
  7. use AnyEvent::XMPP::IM::Account;
  8. use AnyEvent::XMPP::Ext::Disco;
  9. use AnyEvent::XMPP::Ext::Version;
  10. use AnyEvent::XMPP::Namespaces qw/xmpp_ns/;
  11. # use diagnostics;
  12.  
  13. BEGIN { $ENV{PROTOCOL_OTR_ENABLE_QUICK_RANDOM} = 1 }
  14.  
  15. use Protocol::OTR;
  16.  
  17. binmode STDOUT, ":utf8";
  18.  
  19. my $jid="robot\@domena.tld";
  20. my $pw='hasełkorobota';
  21.  
  22. my $jid2="robot\@drugadomena.tld";
  23. my $pw2='hasełkoxmpp';
  24.  
  25. my $j       = AnyEvent->condvar;
  26. my $konto1  = AnyEvent::XMPP::Client->new( debug => 0 );
  27. my $konto2  = AnyEvent::XMPP::Client->new( debug => 0 );
  28.  
  29. my $disco   = AnyEvent::XMPP::Ext::Disco->new;
  30.  
  31. # my $otr = Protocol::OTR->new({
  32. #              privkeys_file => "/var/lib/robot/otr.private_key",
  33. #           contacts_file => "/var/lib/robot/otr.fingerprints",
  34. #          instance_tags_file => "/var/lib/robot/otr.instance_tags",
  35. #          }
  36. #      );
  37.  
  38. # my $act = $otr->account( $jid, 'prpl-jabber' );
  39. # my $act2 = $otr->account( $jid2, 'prpl-jabber' );
  40.  
  41. $konto1 ->add_extension($disco);
  42. $konto1 ->set_presence( undef, 'Robocik melduje posłusznie pełną gotowość bojową ;)...', 1 );
  43.  
  44.  
  45. $konto2 ->add_extension($disco);
  46. $konto2 ->set_presence( undef, 'Robocik melduje posłusznie pełną gotowość bojową ;)...', 1 );
  47.  
  48. $konto1 ->add_account( $jid, $pw );
  49. print "connecting to $jid...\n";
  50.  
  51. $konto2 ->add_account( $jid2, $pw2);
  52. print "connecting to $jid2...\n";
  53.  
  54. $konto1->reg_cb(
  55.     session_ready => sub {
  56.         my ( $account, $acc ) = @_;
  57.        
  58.     },
  59.    connect => sub {
  60.       print "Robot jest połączony...;\) \n";
  61.    },
  62.    message => sub {
  63.     my ($cl, $acc, $msg) = @_;
  64.     my $from = $msg->from;
  65.     my $message = $msg ->any_body;
  66.     my $repl = $msg ->make_reply;
  67.     $repl->add_body ( "Robot usłyszał:  $message\n");
  68.     $repl->send;
  69.       print "\nRobot - połącznie od:  $from\n";
  70.       print "Robot usłyszał:  $message\n";
  71.    },
  72.      contact_request_subscribe => sub {
  73.         my ( $account, $acc, $roster, $contact ) = @_;
  74.         $contact->send_subscribed;
  75.         warn "Subscribed to " . $contact->jid . "\n";
  76.     },
  77.     error => sub {
  78.         my ( $konto1, $acc, $error ) = @_;
  79.         warn "Error encountered: " . $error->string . "\n";
  80.         $j->broadcast;
  81.     },
  82.     disconnect => sub {
  83.         warn "Got disconnected: [@_]\n";
  84.         $j->broadcast;
  85.     },
  86. );
  87.  
  88. $konto2->reg_cb(
  89.     session_ready => sub {
  90.         my ( $account, $acc ) = @_;
  91.        
  92.     },
  93.    connect => sub {
  94.       print "XMPP jest połączony...;\)\n";
  95.    },
  96.    message => sub {
  97.     my ($cl, $acc, $msg) = @_;
  98.     my $from = $msg->from;
  99.     my $message = $msg ->any_body;
  100.     if ($message ne ""){
  101.                 my $repl = $msg ->make_reply;
  102.                 $repl->add_body ( "XMPP usłyszał: $message\n");
  103.                 $repl->send;
  104.                 print "\nXMPP - połącznie od:  $from\n";
  105.                 print "XMPP usłyszał:  $message\n";
  106.          }
  107.    },
  108.      contact_request_subscribe => sub {
  109.         my ( $account, $acc, $roster, $contact ) = @_;
  110.         $contact->send_subscribed;
  111.         warn "Subscribed to " . $contact->jid . "\n";
  112.     },
  113.     error => sub {
  114.         my ( $konto1, $acc, $error ) = @_;
  115.         warn "Error encountered: " . $error->string . "\n";
  116.         $j->broadcast;
  117.     },
  118.     disconnect => sub {
  119.         warn "Got disconnected: [@_]\n";
  120.         $j->broadcast;
  121.     },
  122. );
  123.  
  124.  
  125. $konto1 ->start;
  126. $konto2 ->start;
  127. print "Robocik melduje pełną gotowość bojową :\)\n";
  128.  
  129.  
  130. $j->wait;
  131.  

Źródło:

Ostatnie wpisy

Linki

Funkcje