#                                MIT License
#                                      
#   Copyright (c) 2009 Matej Cepl <mcepl () redhat ! com>
#   
#   Permission is hereby granted, free of charge, to any person obtaining
#   a copy of this software and associated documentation files (the
#   "Software"), to deal in the Software without restriction, including
#   without limitation the rights to use, copy, modify, merge, publish,
#   distribute, sublicense, and/or sell copies of the Software, and to
#   permit persons to whom the Software is furnished to do so, subject to
#   the following conditions:
#   
#   The above copyright notice and this permission notice shall be
#   included in all copies or substantial portions of the Software.
#   
#   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
#   EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
#   MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
#   IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
#   CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
#   TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
#   SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
use Purple;

use strict;
use warnings;

my $pluginName = "filter-img-hrefs";
my $plugin = "";

our %PLUGIN_INFO = (
    perl_api_version => 2,
    name => "Perl: Filter out HREFs from IMG elements",
    version => "0.1",
    summary => "There are annoyingly long HREFs shown in twitter chat, this plugin wants to get rid of them.",
    description => "There are annoyingly long HREFs shown in twitter chat, this plugin wants to get rid of themOpens all chats on XMPP server according to bookmarks stored there.",
    author => "Matěj Cepl <mcepl () redhat ! com>",
    url => "http://matej.ceplovi.cz",
    load => "plugin_load",
    unload => "plugin_unload",
);

# list of outstanding IDs for <iq>s we are waiting to get answer
my @requests_queue = ();
my @target_JIDs = qw( twitter.jabbim.com );

my @connected_signals = ();

sub plugin_load {
	$plugin = shift;

	Purple::Debug::info("$pluginName",
							  "$pluginName plugin loaded\n");
	
	my $jabber = Purple::Find::prpl("prpl-jabber");
	if (!$jabber) {
	Purple::Debug::info("$pluginName",
							  "Works only for Jabber protocol.\n");
		return ;
	}
	my $consignal = Purple::Signal::connect($jabber,
		"jabber-receiving-message",$plugin,\&got_message_cb, 0);
	push @connected_signals,$consignal;
}

sub plugin_unload {
	foreach my $signal (@connected_signals) {
		Purple::Prefs::disconnect_by_handle($signal);
	}
	Purple::Debug::info("$pluginName",
							  "$pluginName plugin unloaded\n");
}

# (18:08:28) darkrain42: mcepl: With that patch, $node->get_child("")
# followed by iterative "$node = $node->get_next()" should work as you'd expect.

sub clear_img {
    my $curnode = shift ;
    my $curname = $curnode->get_name();

    Purple::Debug::misc("$pluginName",
     "clear_img: current node name is "
      . $curname . "\n");

    if ($curname eq "img") {
        $curnode->free();
		  return ;
	 }
	 
	 # doesn't work in perl ... it would be curnode->child in C
    my $curchild = $curnode->get_child("");
	 while ($curchild) {
		  clear_img($curchild);
		  $curchild = $curchild->get_next();
	 }
}

sub got_message_cb {
	my $conn = shift;     # connection
	my $msg_type = shift || ""; # what type of IQ is this?
	my $msg_id = shift || "";   # what's the ID of the incoming IQ?
   my $msg_from = shift || ""; # who is the IQ from?
   my $msg_to = shift || "";   # who is the IQ to?
   my $packet = shift || "";   # xmlnode
	Purple::Debug::misc("$pluginName",
	  "Msg received: \$msg_type = $msg_type, \$msg_id = $msg_id," .
     " \$msg_from = $msg_from, \$msg_to\n\$packet = $packet\n");

	if (grep ( $msg_from =~ /$_/ ,  @target_JIDs )) {

		 my $len = 0; # length of the string generated from XMLNodemv 
		 my $packetstr = $packet->to_str();
		 Purple::Debug::info("$pluginName", "packet: $packetstr\n");
		 clear_img($packet);
		 $packetstr = $packet->to_str();
		 Purple::Debug::info("$pluginName", "new packet: $packetstr\n");
	}
}