File Coverage

blib/lib/DJabberd/Delivery/OfflineStorage.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package DJabberd::Delivery::OfflineStorage;
2 1     1   19 use strict;
  1         3  
  1         39  
3 1     1   5 use warnings;
  1         2  
  1         37  
4 1     1   4 use base 'DJabberd::Delivery';
  1         2  
  1         600  
5              
6 1     1   542 use DJabberd::Queue::ServerOut;
  0            
  0            
7             use DJabberd::Log;
8             our $logger = DJabberd::Log->get_logger;
9             use Storable qw(nfreeze thaw);
10              
11             use vars qw($VERSION);
12             $VERSION = '0.04';
13              
14             =head1 NAME
15              
16             DJabberd::Delivery::OfflineStorage - Basic OfflineStorage (old style) for DJabberd
17              
18             =head1 DESCRIPTION
19              
20             So you want offline storage - well add this to djabberd.conf:
21              
22            
23              
24             [...]
25            
26             Types Message
27            
28            
29              
30             For InMemoryOnly based storage, and:
31              
32            
33              
34             [...]
35            
36             Database offline.sqlite
37             Types Message
38            
39            
40             For SQLite based storage.
41              
42             Parameter Database specifies the sqlite database file to use, and Types is a list of Stanza
43             types that will be collected. This should really only be Message - think really hard before
44             you ad IQ to the list.
45              
46             Also - it is extremely IMPORTANT as Edward Rudd pointed out - this Plugin MUST be the last
47             in the delivery chain, as it assumes that if S2S and Local haven't dealt with it, then the
48             JID in question is offline.
49              
50              
51             =head1 AUTHOR
52              
53             Piers Harding, piers@cpan.org.
54              
55              
56             =cut
57              
58              
59              
60             sub run_after { ("DJabberd::Delivery::Local") }
61              
62              
63             sub set_config_types {
64             my ($self, $types) = @_;
65             $self->{types} = { map { lc($_) => 1 } grep(/^(IQ|Message)$/i, split(/\s+/, $types)) };
66             }
67              
68              
69             sub new {
70             my $class = shift;
71             my $self = $class->SUPER::new(@_);
72             return $self;
73             }
74              
75              
76             sub register {
77             my ($self, $vhost) = @_;
78             $self->set_vhost($vhost);
79             $vhost->register_hook("OnInitialPresence", sub { $self->on_initial_presence(@_) });
80             $self->SUPER::register($vhost);
81             }
82              
83              
84             # OIntialPresence is used to determine that a user is now available
85             # and can receive stored offline messages
86             sub on_initial_presence {
87             my ($self, $vhost, $cb, $conn) = @_;
88             my $from = $conn->bound_jid
89             or return;
90             my $messages = $self->load_offline_messages($from->as_bare_string);
91             # deliver messages
92             foreach my $message (@$messages) {
93             my $packet = Storable::thaw($message->{packet});
94             my $class = $packet->{type};
95             my $xml = DJabberd::XMLElement->new($packet->{ns}, $packet->{element}, $packet->{attrs}, []);
96             my $stanza = $class->downbless($xml, $conn);
97             $stanza->set_raw($packet->{stanza});
98             $stanza->deliver($vhost);
99             $self->delete_offline_message($message->{id});
100             }
101             }
102              
103              
104             # hit the end of the delivery chain and we know that the user
105             # cannot accept the message -> store it offline for later
106             sub deliver {
107             my ($self, $vhost, $cb, $stanza) = @_;
108             die unless $vhost == $self->{vhost}; # sanity check
109              
110             my $to = $stanza->to_jid
111             or return $cb->declined;
112              
113             # only configured packet types
114             return $cb->declined
115             unless exists $self->{types}->{$stanza->element_name};
116              
117             my $packet = { 'type' => ref($stanza),
118             'element' => $stanza->element_name,
119             'stanza' => $stanza->innards_as_xml,
120             'ns' => $stanza->namespace,
121             'attrs' => {} };
122             map { $packet->{attrs}->{$_} = $stanza->attrs->{$_} } keys %{$stanza->{attrs}};
123              
124             $self->store_offline_message($to->as_bare_string, Storable::nfreeze($packet));
125              
126             $DJabberd::Stats::counter{deliver_to_offline_storage}++;
127              
128             $cb->delivered;
129             }
130              
131             =head1 COPYRIGHT & LICENSE
132              
133             Original work Copyright 2006 Alexander Karelas, Martin Atkins, Brad Fitzpatrick and Aleksandar Milanov. All rights reserved.
134             Copyright 2007 Piers Harding.
135              
136             This program is free software; you can redistribute it and/or modify it
137             under the same terms as Perl itself.
138              
139             =cut
140              
141              
142             1;