File Coverage

blib/lib/DJabberd/Plugin/EntityTime.pm
Criterion Covered Total %
statement 12 41 29.2
branch 0 8 0.0
condition 0 3 0.0
subroutine 4 8 50.0
pod n/a
total 16 60 26.6


line stmt bran cond sub pod time code
1             package DJabberd::Plugin::EntityTime;
2              
3 1     1   43810 use warnings;
  1         2  
  1         38  
4 1     1   8 use strict;
  1         2  
  1         41  
5 1     1   6 use base 'DJabberd::Plugin';
  1         7  
  1         1548  
6              
7 1     1   1816 use POSIX qw(strftime);
  1         8871  
  1         8  
8              
9             our $logger = DJabberd::Log->get_logger();
10              
11             =head1 NAME
12              
13             DJabberd::EntityTime - Implements XEP-0090 and XEP-0202
14              
15             =head1 VERSION
16              
17             Version 0.03
18              
19             =cut
20              
21             our $VERSION = '0.03';
22              
23             =head1 SYNOPSIS
24              
25             Implements XEP-0090 and XEP-0202
26              
27            
28            
29            
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 0     0     my ($self,$vhost) = @_;
41             my $private_cb = sub {
42 0     0     my ($vh, $cb, $iq) = @_;
43 0 0 0       unless ($iq->isa("DJabberd::IQ") and defined $iq->to) {
44 0           $cb->decline;
45 0           return;
46             }
47 0 0         unless ($iq->to eq $vhost->{server_name}) {
48 0           $cb->decline;
49 0           return;
50             }
51 0 0         if ($iq->signature eq 'get-{jabber:iq:time}query') {
    0          
52 0           $self->_get_time90($vh, $iq);
53 0           $cb->stop_chain;
54 0           return;
55             } elsif ($iq->signature eq 'get-{urn:xmpp:time}time') {
56 0           $self->_get_time202($vh, $iq);
57 0           $cb->stop_chain;
58 0           return;
59             }
60 0           $cb->decline;
61 0           };
62 0           $vhost->register_hook("switch_incoming_client",$private_cb);
63 0           $vhost->register_hook("switch_incoming_server",$private_cb);
64 0           $vhost->add_feature("jabber:iq:time");
65 0           $vhost->add_feature("urn:xmpp:time");
66             }
67              
68             sub _get_time90 {
69 0     0     my ($self, $vh, $iq) = @_;
70 0           $logger->info('Getting time from : '.$iq->from_jid);
71 0           $iq->send_reply('result',qq()
72             .''.strftime("%Y%m%dT%H:%M:%S",gmtime).''
73             .''.gmtime().''
74             .''.strftime("%Z",gmtime).''
75             .qq() );
76             }
77              
78             sub _get_time202 {
79 0     0     my ($self, $vh, $iq) = @_;
80 0           $logger->info('Getting time from : '.$iq->from_jid);
81 0           my $zone = strftime("%z",gmtime);
82 0           $zone =~ s/(\d\d)(\d\d)$/$1:$2/;
83 0           $iq->send_reply('result',qq(
84             .''.$zone.''
85             .''.strftime("%Y%m%dT%H:%M:%S",gmtime).''
86             .qq() );
87             }
88              
89             =head1 AUTHOR
90              
91             Edward Rudd, C<< >>
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