10 files changed, 250 insertions, 0 deletions

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..10b5458
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,4 @@
+META.yml
+Makefile
+/blib
+/pm_to_blib
diff --git a/Changes b/Changes
new file mode 100644
index 0000000..9a0732c
--- /dev/null
+++ b/Changes
@@ -0,0 +1,8 @@
+Revision history for DJabberd-Plugin-EntityTime
+
+0.02    2007-08-03
+        Fixed xmlns on XEP-0202 response
+
+0.01    2007-08-03
+        First version, released on an unsuspecting world.
+
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..73aafd0
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,9 @@
+Changes
+MANIFEST
+Makefile.PL
+README
+lib/DJabberd/Plugin/EntityTime.pm
+t/00-load.t
+t/boilerplate.t
+t/pod-coverage.t
+t/pod.t
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..ce0d492
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,18 @@
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+    NAME                => 'DJabberd::Plugin::EntityTime',
+    AUTHOR              => 'Edward Rudd <urkle@outoforder.cc>',
+    VERSION_FROM        => 'lib/DJabberd/Plugin/EntityTime.pm',
+    ABSTRACT_FROM       => 'lib/DJabberd/Plugin/EntityTime.pm',
+    PL_FILES            => {},
+    PREREQ_PM => {
+        'Test::More' => 0,
+        'DJabberd' => 0.83,
+    },
+    DISTNAME            => 'DJabberd-EntityTime',
+    dist                => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+    clean               => { FILES => 'DJabberd-Plugin-EntityTime-*' },
+);
diff --git a/README b/README
new file mode 100644
index 0000000..78e9d8a
--- /dev/null
+++ b/README
@@ -0,0 +1,40 @@
+DJabberd-Plugin-EntityTime
+
+Implements XEP-0090 and XEP-0202 for DJabberd
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+    perl Makefile.PL
+    make
+    make test
+    make install
+
+
+SUPPORT AND DOCUMENTATION
+
+After installing, you can find documentation for this module with the perldoc command.
+
+    perldoc DJabberd::Plugin::EntityTime
+
+You can also look for information at:
+
+    Search CPAN
+        http://search.cpan.org/dist/DJabberd-Plugin-EntityTime
+
+    CPAN Request Tracker:
+        http://rt.cpan.org/NoAuth/Bugs.html?Dist=DJabberd-Plugin-EntityTime
+
+    AnnoCPAN, annotated CPAN documentation:
+        http://annocpan.org/dist/DJabberd-Plugin-EntityTime
+
+    CPAN Ratings:
+        http://cpanratings.perl.org/d/DJabberd-Plugin-EntityTime
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2007 Edward Rudd
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
diff --git a/lib/DJabberd/Plugin/EntityTime.pm b/lib/DJabberd/Plugin/EntityTime.pm
new file mode 100644
index 0000000..b59cff6
--- /dev/null
+++ b/lib/DJabberd/Plugin/EntityTime.pm
@@ -0,0 +1,102 @@
+package DJabberd::Plugin::EntityTime;
+
+use warnings;
+use strict;
+use base 'DJabberd::Plugin';
+
+use POSIX qw(strftime);
+
+our $logger = DJabberd::Log->get_logger();
+
+=head1 NAME
+
+DJabberd::Plugin::EntityTime - Implements XEP-0090 and XEP-0202
+
+=head1 VERSION
+
+Version 0.02
+
+=cut
+
+our $VERSION = '0.02';
+
+=head1 SYNOPSIS
+
+Implements XEP-0090 and XEP-0202
+
+    <Vhost mydomain.com>
+        <Plugin DJabberd::Plugin::EntityTime />
+    </VHost>
+
+=cut
+
+=head2 register($self, $vhost)
+
+Register the vhost with the module.
+
+=cut
+
+sub register {
+    my ($self,$vhost) = @_;
+    my $private_cb = sub {
+        my ($vh, $cb, $iq) = @_;
+        unless ($iq->isa("DJabberd::IQ") and defined $iq->to) {
+            $cb->decline;
+            return;
+        }
+        unless ($iq->to eq $vhost->{server_name}) {
+            $cb->decline;
+            return;
+        }
+        if ($iq->signature eq 'get-{jabber:iq:time}query') {
+            $self->_get_time90($vh, $iq);
+            $cb->stop_chain;
+            return;
+        } elsif ($iq->signature eq 'get-{urn:xmpp:time}time') {
+            $self->_get_time202($vh, $iq);
+            $cb->stop_chain;
+            return;
+        }
+        $cb->decline;
+    };
+    $vhost->register_hook("switch_incoming_client",$private_cb);
+    $vhost->register_hook("switch_incoming_server",$private_cb);
+    $vhost->add_feature("jabber:iq:time");
+    $vhost->add_feature("urn:xmpp:time");
+}
+
+sub _get_time90 {
+    my ($self, $vh, $iq) = @_;
+    $logger->info('Getting time from : '.$iq->from_jid);
+    $iq->send_reply('result',qq(<query xmlns="jabber:iq:time">)
+        .'<utc>'.strftime("%Y%m%dT%H:%M:%S",gmtime).'</utc>'
+        .'<display>'.gmtime().'</display>'
+        .'<tz>'.strftime("%Z",gmtime).'</tz>'
+        .qq(</query>) );
+}
+
+sub _get_time202 {
+    my ($self, $vh, $iq) = @_;
+    $logger->info('Getting time from : '.$iq->from_jid);
+    my $zone = strftime("%z",gmtime);
+    $zone =~ s/(\d\d)(\d\d)$/$1:$2/;
+    $iq->send_reply('result',qq(<time xmlns="urn:xmpp:time">)
+        .'<tzo>'.$zone.'</tzo>'
+        .'<utc>'.strftime("%Y%m%dT%H:%M:%S",gmtime).'</utc>'
+        .qq(</time>) );
+}
+
+=head1 AUTHOR
+
+Edward Rudd, C<< <urkle at outoforder.cc> >>
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2007 Edward Rudd, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1; # End of DJabberd::Plugin::EntityTime
diff --git a/t/00-load.t b/t/00-load.t
new file mode 100644
index 0000000..2ff39a8
--- /dev/null
+++ b/t/00-load.t
@@ -0,0 +1,9 @@
+#!perl -T
+
+use Test::More tests => 1;
+
+BEGIN {
+        use_ok( 'DJabberd::Plugin::EntityTime' );
+}
+
+diag( "Testing DJabberd::Plugin::EntityTime $DJabberd::Plugin::EntityTime::VERSION, Perl $], $^X" );
diff --git a/t/boilerplate.t b/t/boilerplate.t
new file mode 100644
index 0000000..6502722
--- /dev/null
+++ b/t/boilerplate.t
@@ -0,0 +1,48 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More tests => 3;
+
+sub not_in_file_ok {
+    my ($filename, %regex) = @_;
+    open my $fh, "<", $filename
+        or die "couldn't open $filename for reading: $!";
+
+    my %violated;
+
+    while (my $line = <$fh>) {
+        while (my ($desc, $regex) = each %regex) {
+            if ($line =~ $regex) {
+                push @{$violated{$desc}||=[]}, $.;
+            }
+        }
+    }
+
+    if (%violated) {
+        fail("$filename contains boilerplate text");
+        diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
+    } else {
+        pass("$filename contains no boilerplate text");
+    }
+}
+
+not_in_file_ok(README =>
+    "The README is used..."       => qr/The README is used/,
+    "'version information here'"  => qr/to provide version information/,
+);
+
+not_in_file_ok(Changes =>
+    "placeholder date/time"       => qr(Date/time)
+);
+
+sub module_boilerplate_ok {
+    my ($module) = @_;
+    not_in_file_ok($module =>
+        'the great new $MODULENAME'   => qr/ - The great new /,
+        'boilerplate description'     => qr/Quick summary of what the module/,
+        'stub function definition'    => qr/function[12]/,
+    );
+}
+
+module_boilerplate_ok('lib/DJabberd/Plugin/EntityTime.pm');
diff --git a/t/pod-coverage.t b/t/pod-coverage.t
new file mode 100644
index 0000000..703f91d
--- /dev/null
+++ b/t/pod-coverage.t
@@ -0,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+all_pod_coverage_ok();
diff --git a/t/pod.t b/t/pod.t
new file mode 100644
index 0000000..976d7cd
--- /dev/null
+++ b/t/pod.t
@@ -0,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();