open-chats-from-xmpp-bookmarks.pl

   1 #       MIT License
   2 #
   3 #       Copyright (c) 2009 Matej Cepl <mcepl () redhat ! com>
   4 #
   5 #       Permission is hereby granted, free of charge, to any person obtaining
   6 #       a copy of this software and associated documentation files (the
   7 #       "Software"), to deal in the Software without restriction, including
   8 #       without limitation the rights to use, copy, modify, merge, publish,
   9 #       distribute, sublicense, and/or sell copies of the Software, and to
  10 #       permit persons to whom the Software is furnished to do so, subject to
  11 #       the following conditions:
  12 #
  13 #       The above copyright notice and this permission notice shall be
  14 #       included in all copies or substantial portions of the Software.
  15 #
  16 #       THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  17 #       EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  18 #       MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
  19 #       IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
  20 #       CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
  21 #       TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
  22 #       SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
  23 use Purple;
  24 use Data::Dumper;
  25
  26 my $pluginName = "open-chats-xmpp";
  27 my $plugin = "";
  28
  29 $botname = "USERSERV";
  30 %PLUGIN_INFO = (
  31     perl_api_version => 2,
  32     name => "Perl: Open Chats from XMPP Bookmarks",
  33     version => "0.2",
  34     summary => "Opens all XMPP chats according to bookmarks" .
  35         "stored on the server.",
  36     description => "Opens all XMPP chats according to bookmarks" .
  37         "stored on the server.",
  38     author => "Matěj Cepl <mcepl () redhat ! com>",
  39     url => "http://matej.ceplovi.cz",
  40     load => "plugin_load",
  41     unload => "plugin_unload",
  42 );
  43
  44 # list of outstanding IDs for <iq>s we are waiting to get answer
  45 my @requests_queue = ();
  46
  47 sub is_queued {
  48     my $element = shift;
  49     if ($element) {
  50         my @found = grep($_ eq "$element" , @requests_queue);
  51         my $count = @found;
  52         Purple::Debug::misc("$pluginName",
  53             "Element $element found in queue $count times.\n(@found)\n");
  54         return $count >0;
  55     } else {
  56         return 0 ;
  57     }
  58 }
  59
  60 sub pick_from_queue {
  61     my $element = shift ;
  62
  63     foreach my $item (@requests_queue) {
  64         if ($item =~ /$element/) {
  65             @requests_queue = grep (!/$item/,@requests_queue);
  66             return $item;
  67         }
  68     }
  69     return 0;
  70 }
  71
  72 sub send_iq_request {
  73     my $conn = shift ;
  74     my $payload = shift ;
  75     my $callback_function = shift ;
  76
  77     my $randid = "bkmks-" . int(rand(100));
  78     while (is_queued($randid)) {
  79         $randid = "bkmks-" . int(rand(100));
  80     }
  81
  82     my $nodestr = '<iq type="get" id="' . $randid . '">' . $payload . '</iq>';
  83     Purple::Debug::misc("$pluginName","sending packet:\n$nodestr\nto $conn\n");
  84     my $ret = Purple::Prpl::send_raw($conn,$nodestr);
  85     push @requests_queue, $randid;
  86
  87     my $no_connected_signals = @connected_signals;
  88     if ($no_connected_signals == 0) {
  89         Purple::Debug::misc("$pluginName",
  90         "Connecting got_xml_cb to jabber-receiving-iq signal\n");
  91         my $jabber = Purple::Find::prpl("prpl-jabber");
  92         if (!$jabber) {
  93             die("No jabber protocol?, weird: $!\n");
  94         }
  95         $consignal = Purple::Signal::connect($jabber,
  96             "jabber-receiving-iq",$plugin,\&got_xml_cb, 0);
  97         push @connected_signals,$consignal;
  98     }
  99 }
 100
 101 sub get_bookmarks {
 102     my $im_connection = shift; # current Connection
 103
 104     send_iq_request($im_connection,
 105         '<pubsub xmlns="http://jabber.org/protocol/pubsub">' .
 106         '<items node="storage:bookmarks"/></pubsub>',
 107         \&bookmarks_cb);
 108 }
 109
 110 sub process_conference_node {
 111     my $conn = shift ;
 112     my $curnode = shift ;
 113
 114     my $autojoin = lc($curnode->get_attrib('autojoin'));
 115     if ($autojoin) {
 116         my $count = grep (/$autojoin/ , (1,"true") );
 117         if ($count > 0){
 118             my ($room,$server) = split(/@/,$curnode->get_attrib('jid'));
 119             my $handlenode = $curnode->get_child("nick");
 120             my $handle = $handlenode->get_data();
 121             my $blist_chat = Purple::BuddyList::find_chat($conn,$room);
 122             Purple::Debug::info("$pluginName","\$blist_chat = $blist_chat\n");
 123             my %components = (
 124                 "room" => $room,
 125                 "server" => $server,
 126                 "handle" => $handle,
 127                 "password" => ""
 128             );
 129             Purple::Debug::info("$pluginName",
 130                 "join_chat: " . Dumper(%components) . "\n");
 131             Purple::Serv::join_chat($conn,\%components);
 132         }
 133     }
 134 }
 135
 136 sub got_xml_cb {
 137     my $queue_length = @requests_queue;
 138     if ($queue_length == 0) {
 139         foreach my $signal (@connected_signals) {
 140             Purple::Prefs::disconnect_by_handle($signal);
 141         }
 142         return ;
 143     }
 144     my $conn = shift;     # connection
 145     my $iq_type = shift;  # what type of IQ is this?
 146     my $iq_id = shift;    # what's the ID of the incoming IQ?
 147     my $iq_from = shift;  # who is the IQ from?
 148     my $packet = shift;   # xmlnode
 149     my $soughtid = shift; # random ID
 150     Purple::Debug::misc("$pluginName",
 151         "IQ received: \$iq_type = $iq_type, \$iq_id = $iq_id, ' .
 152             '\$iq_from = $iq_from\n\$packet = $packet\n");
 153
 154     if (($iq_type eq 'result') && is_queued($iq_id)) {
 155         pick_from_queue($iq_id,@requests_queue);
 156
 157         my $packetstr = $packet->to_str();
 158         Purple::Debug::info("$pluginName", "packet: $packetstr\n");
 159         # TODO check that items/@node == "storage:bookmarks" and/or
 160         # xmlns of storage is that.
 161         my $curnode = $packet->get_child("pubsub/items/item/storage/conference");
 162         while ($curnode) {
 163             Purple::Debug::info("$pluginName", "conference: " .
 164             $curnode->to_str() . "\n");
 165             process_conference_node($conn,$curnode);
 166             $curnode = $curnode->get_next_twin();
 167         }
 168     }
 169 }
 170
 171 # information links
 172 # http://xmpp.org/extensions/xep-0048.html
 173 # http://xmpp.org/extensions/xep-0223.html
 174 # http://xmpp.org/extensions/xep-0060.html
 175
 176 sub joined_chat {
 177     my $conv = shift; # PurpleConversation
 178     Purple::Debug::info("$pluginName", "joined chat " .
 179             $conv->get_name() . " for account " .
 180             $conv->get_account()->get_username() . "\n");
 181     # if not("chat already registered") then add_to_server
 182 }
 183
 184 sub left_chat {
 185     my $conv = shift; # PurpleConversation
 186     Purple::Debug::info("$pluginName", "left chat " .
 187             $conv->get_name() . " for account " .
 188             $conv->get_account()->get_username() . "\n");
 189     # if "chat already registered" then remove_from_server
 190 }
 191
 192 my @connected_signals = ();
 193 my $blist;
 194
 195 sub signed_on {
 196     my $conn = shift;
 197     my $account = $conn->get_account();
 198     my $username = $account->get_username();
 199     my $protocol_id = $account->get_protocol_id();
 200     my @buddies ;
 201     Purple::Debug::misc("$pluginName",
 202         "signed-on $username @ $account ($protocol_id)\n");
 203     if ($protocol_id eq "prpl-jabber") {
 204         get_bookmarks($conn);
 205         @buddies = Purple::Find::buddies($account,"");
 206     }
 207 }
 208
 209 sub plugin_load {
 210     $plugin = shift;
 211     my $connected_signal;
 212
 213     # it doesn't make any sense when we don't have jabber
 214     my $jabber = Purple::Find::prpl("prpl-jabber");
 215     if (!$jabber) {
 216         return NULL;
 217     }
 218
 219     # connect signed-on signal
 220     $conn = Purple::Connections::get_handle();
 221     $consignal = Purple::Signal::connect($conn, "signed-on", $plugin,
 222         \&signed_on, 0);
 223     push @connected_signals,$consignal;
 224
 225     # connect IQ management signals
 226     $consignal = Purple::Signal::connect($jabber,
 227         "jabber-receiving-iq",$plugin,\&got_xml_cb, 0);
 228     push @connected_signals,$consignal;
 229
 230     # connect chat management signals
 231     $conn = Purple::Conversations::get_handle();
 232     $consignal = Purple::Signal::connect($conn,
 233         "chat-joined",$plugin,\&joined_chat, 0);
 234     push @connected_signals,$consignal;
 235     $consignal = Purple::Signal::connect($conn,
 236         "chat-left",$plugin,\&left_chat, 0);
 237     push @connected_signals,$consignal;
 238
 239     # Initialize a buddy list
 240     # FIXME Do we need it? What it is good for?
 241     $blist = Purple::get_blist();
 242     Purple::Debug::misc("$pluginName",
 243         "Getting the current Buddy List\n" . Dumper($blist) . "\n");
 244     my $node = Purple::BuddyList::get_root();
 245 }
 246
 247 sub plugin_unload {
 248     foreach my $signal (@connected_signals) {
 249         Purple::Prefs::disconnect_by_handle($signal);
 250     }
 251     Purple::Debug::info("$pluginName", "Login to $botname plugin unloaded\n");
 252 }