diff options
author | Edward Rudd | 2010-02-15 12:30:44 -0500 |
---|---|---|
committer | Edward Rudd | 2010-02-15 12:30:44 -0500 |
commit | b935c431024f0eb5eac13c8ebf60feefd0367048 (patch) | |
tree | 6a21fba48d16419923e499e0ba78386f5306b7f9 /lib/DJabberd/Plugin |
import version 0.020.02
Diffstat (limited to 'lib/DJabberd/Plugin')
-rw-r--r-- | lib/DJabberd/Plugin/EntityTime.pm | 102 |
1 files changed, 102 insertions, 0 deletions
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 @@ | |||
1 | package DJabberd::Plugin::EntityTime; | ||
2 | |||
3 | use warnings; | ||
4 | use strict; | ||
5 | use base 'DJabberd::Plugin'; | ||
6 | |||
7 | use POSIX qw(strftime); | ||
8 | |||
9 | our $logger = DJabberd::Log->get_logger(); | ||
10 | |||
11 | =head1 NAME | ||
12 | |||
13 | DJabberd::Plugin::EntityTime - Implements XEP-0090 and XEP-0202 | ||
14 | |||
15 | =head1 VERSION | ||
16 | |||
17 | Version 0.02 | ||
18 | |||
19 | =cut | ||
20 | |||
21 | our $VERSION = '0.02'; | ||
22 | |||
23 | =head1 SYNOPSIS | ||
24 | |||
25 | Implements XEP-0090 and XEP-0202 | ||
26 | |||
27 | <Vhost mydomain.com> | ||
28 | <Plugin DJabberd::Plugin::EntityTime /> | ||
29 | </VHost> | ||
30 | |||
31 | =cut | ||
32 | |||
33 | =head2 register($self, $vhost) | ||
34 | |||
35 | Register the vhost with the module. | ||
36 | |||
37 | =cut | ||
38 | |||
39 | sub register { | ||
40 | my ($self,$vhost) = @_; | ||
41 | my $private_cb = sub { | ||
42 | my ($vh, $cb, $iq) = @_; | ||
43 | unless ($iq->isa("DJabberd::IQ") and defined $iq->to) { | ||
44 | $cb->decline; | ||
45 | return; | ||
46 | } | ||
47 | unless ($iq->to eq $vhost->{server_name}) { | ||
48 | $cb->decline; | ||
49 | return; | ||
50 | } | ||
51 | if ($iq->signature eq 'get-{jabber:iq:time}query') { | ||
52 | $self->_get_time90($vh, $iq); | ||
53 | $cb->stop_chain; | ||
54 | return; | ||
55 | } elsif ($iq->signature eq 'get-{urn:xmpp:time}time') { | ||
56 | $self->_get_time202($vh, $iq); | ||
57 | $cb->stop_chain; | ||
58 | return; | ||
59 | } | ||
60 | $cb->decline; | ||
61 | }; | ||
62 | $vhost->register_hook("switch_incoming_client",$private_cb); | ||
63 | $vhost->register_hook("switch_incoming_server",$private_cb); | ||
64 | $vhost->add_feature("jabber:iq:time"); | ||
65 | $vhost->add_feature("urn:xmpp:time"); | ||
66 | } | ||
67 | |||
68 | sub _get_time90 { | ||
69 | my ($self, $vh, $iq) = @_; | ||
70 | $logger->info('Getting time from : '.$iq->from_jid); | ||
71 | $iq->send_reply('result',qq(<query xmlns="jabber:iq:time">) | ||
72 | .'<utc>'.strftime("%Y%m%dT%H:%M:%S",gmtime).'</utc>' | ||
73 | .'<display>'.gmtime().'</display>' | ||
74 | .'<tz>'.strftime("%Z",gmtime).'</tz>' | ||
75 | .qq(</query>) ); | ||
76 | } | ||
77 | |||
78 | sub _get_time202 { | ||
79 | my ($self, $vh, $iq) = @_; | ||
80 | $logger->info('Getting time from : '.$iq->from_jid); | ||
81 | my $zone = strftime("%z",gmtime); | ||
82 | $zone =~ s/(\d\d)(\d\d)$/$1:$2/; | ||
83 | $iq->send_reply('result',qq(<time xmlns="urn:xmpp:time">) | ||
84 | .'<tzo>'.$zone.'</tzo>' | ||
85 | .'<utc>'.strftime("%Y%m%dT%H:%M:%S",gmtime).'</utc>' | ||
86 | .qq(</time>) ); | ||
87 | } | ||
88 | |||
89 | =head1 AUTHOR | ||
90 | |||
91 | Edward Rudd, C<< <urkle at outoforder.cc> >> | ||
92 | |||
93 | =head1 COPYRIGHT & LICENSE | ||
94 | |||
95 | Copyright 2007 Edward Rudd, all rights reserved. | ||
96 | |||
97 | This program is free software; you can redistribute it and/or modify it | ||
98 | under the same terms as Perl itself. | ||
99 | |||
100 | =cut | ||
101 | |||
102 | 1; # End of DJabberd::Plugin::EntityTime | ||