File Coverage

blib/lib/AnyEvent/XMPP/Ext/HTML.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package AnyEvent::XMPP::Ext::HTML;
{
  $AnyEvent::XMPP::Ext::HTML::VERSION = '0.02';
}
# ABSTRACT: XEP-0071: XHTML-IM (Version 1.5) for AnyEvent::XMPP

use warnings;
use strict;

use AnyEvent::XMPP::Ext;
use AnyEvent::XMPP::Namespaces qw/set_xmpp_ns_alias xmpp_ns/;

our @ISA = qw/AnyEvent::XMPP::Ext/;


sub new {
    my $this = shift;
    my $class = ref($this) || $this;
    my $self = bless { @_ }, $class;
    $self->init;
    $self;
}


sub init {
    my $self = shift;

    set_xmpp_ns_alias(xhtml_im => 'http://jabber.org/protocol/xhtml-im');
    set_xmpp_ns_alias(xhtml => 'http://www.w3.org/1999/xhtml');

    $self->{disco}->enable_feature($self->disco_feature) if defined $self->{disco};

    $self->{cb_id} = $self->reg_cb(
        send_message_hook => sub {
            my ($self, $con, $id, $to, $type, $attrs, $create_cb) = @_;

            return unless exists $attrs->{html};
            my $html = delete $attrs->{html};

            push @$create_cb, sub {
                my ($w) = @_;

                $w->addPrefix(xmpp_ns('xhtml_im'), '');
                $w->startTag([xmpp_ns('xhtml_im'), 'html']);
                if (ref($html) eq 'HASH') {
                    for (keys %$html) {
                        $w->addPrefix(xmpp_ns('xhtml'), '');
                        $w->startTag([xmpp_ns('xhtml'), 'body'], ($_ ne '' ? ([xmpp_ns('xml'), 'lang'] => $_) : ()));
                        $w->raw($html->{$_});
                        $w->endTag;
                    }
                } else {
                    $w->addPrefix(xmpp_ns('xhtml'), '');
                    $w->startTag([xmpp_ns('xhtml'), 'body']);
                    $w->raw($html);
                    $w->endTag;
                }
                $w->endTag;
            };
        },
    );
}

sub disco_feature {
    xmpp_ns('xhtml_im');
}

sub DESTROY {
    my $self = shift;
    $self->unreg_cb($self->{cb_id});
}

1;

__END__