From: Charles McGarvey <chazmcgarvey@brokenzipper.com>
Date: Mon, 6 May 2013 20:22:40 +0000 (-0600)
Subject: initial commit
X-Git-Tag: v0.02^0
X-Git-Url: https://git.dogcows.com/gitweb?p=chaz%2Fp5-AnyEvent-XMPP-Ext-HTML;a=commitdiff_plain;h=cb4475bc4ee48fe02c35b39faf9f1610b68f8777

initial commit
---

cb4475bc4ee48fe02c35b39faf9f1610b68f8777
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..d37f45b
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+/.build
+/AnyEvent-XMPP-Ext-HTML-*
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..2d36a83
--- /dev/null
+++ b/README.md
@@ -0,0 +1,14 @@
+
+AnyEvent::XMPP::Ext::HTML
+=========================
+
+This is a perl5 module that adds XEP-0071 XHTML-IM support to AnyEvent::XMPP.
+For more information, take a look at the module's page on the
+[CPAN](http://search.cpan.org/perldoc?AnyEvent%3A%3AXMPP%3A%3AExt%3A%3AHTML).
+
+License
+-------
+
+This is free software; you can redistribute it and/or modify it under the same
+terms as the Perl 5 programming language system itself.
+
diff --git a/dist.ini b/dist.ini
new file mode 100644
index 0000000..0f4f334
--- /dev/null
+++ b/dist.ini
@@ -0,0 +1,31 @@
+
+name = AnyEvent-XMPP-Ext-HTML
+version = 0.02
+author = Charles McGarvey <ccm@cpan.org>
+license = Perl_5
+copyright_holder = Charles McGarvey
+
+[@Basic]
+
+[PodCoverageTests]
+[PodSyntaxTests]
+[Test::Perl::Critic]
+
+[PkgVersion]
+[PodWeaver]
+
+[GitFmtChanges]
+file_name = Changes
+log_format = %x20 %h %s
+tax_regexp = ^v\d+
+
+[PruneFiles]
+filename = README.md
+filename = dist.ini
+
+[GitHub::Meta]
+repo = chazmcgarvey/p5-AnyEvent-XMPP-Ext-HTML
+[MetaJSON]
+
+[AutoPrereqs]
+
diff --git a/lib/AnyEvent/XMPP/Ext/HTML.pm b/lib/AnyEvent/XMPP/Ext/HTML.pm
new file mode 100644
index 0000000..8df1f6a
--- /dev/null
+++ b/lib/AnyEvent/XMPP/Ext/HTML.pm
@@ -0,0 +1,102 @@
+package AnyEvent::XMPP::Ext::HTML;
+# 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/;
+
+=head1 SYNOPSIS
+
+    my $c = AnyEvent::XMPP::Connection->new(...);
+    $c->add_extension(my $disco = AnyEvent::XMPP::Ext::Disco->new);
+    $c->add_extension(AnyEvent::XMPP::Ext::HTML->new(disco => $disco));
+    
+    $c->send_message(
+        body => "This is plain text; same as usual.",
+        html => "This is <em>XHTML</em>!",
+    );
+
+=head1 DESCRIPTION
+
+An implementation of XEP-0071: XHTML-IM for HTML-formatted messages.
+
+=head1 CAVEATS
+
+HTML messages are not validated nor escaped, so it is your responsibility to
+use valid XHTML-IM tags and to close them properly.
+
+=method new
+
+Creates a new extension handle.  It takes an optional C<disco> argument which
+is a L<AnyEvent::XMPP::Ext::Disco> object for which this extension will be
+enabled.
+
+=cut
+
+sub new {
+    my $this = shift;
+    my $class = ref($this) || $this;
+    my $self = bless { @_ }, $class;
+    $self->init;
+    $self;
+}
+
+=method init
+
+Initialize the extension.  This does not need to be called externally.
+
+=cut
+
+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;
diff --git a/perlcritic.rc b/perlcritic.rc
new file mode 100644
index 0000000..261a4b2
--- /dev/null
+++ b/perlcritic.rc
@@ -0,0 +1,4 @@
+#severity    = brutal
+exclude	    = TestingAndDebugging::RequireUseStrict
+# RequireUseStrict is a good policy, but sadly it doesn't play well with
+# dzil's Pod::Weaver plugin.
diff --git a/t/00-basic.t b/t/00-basic.t
new file mode 100644
index 0000000..3470cab
--- /dev/null
+++ b/t/00-basic.t
@@ -0,0 +1,11 @@
+#!perl
+
+use warnings FATAL => 'all';
+use strict;
+
+use Test::More tests => 1;
+
+BEGIN {
+    use_ok 'AnyEvent::XMPP::Ext::HTML';
+}
+