File Coverage

blib/lib/DJabberd/RosterStorage/SQLite/Fixed.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::RosterStorage::SQLite::Fixed;
2 1     1   24961 use strict;
  1         3  
  1         41  
3 1     1   5 use warnings;
  1         3  
  1         32  
4 1     1   5 use base 'DJabberd::RosterStorage::SQLite';
  1         12  
  1         622  
5 1     1   1049 use DJabberd::Log;
  0            
  0            
6             use DJabberd::Util;
7             our $logger = DJabberd::Log->get_logger();
8              
9             =head1 NAME
10              
11             DJabberd::RosterStorage::SQLite::Fixed - a shared roster implementation for the SQLite roster storage
12              
13             =head1 VERSION
14              
15             Version 0.02
16             =cut
17              
18             our $VERSION = '0.02';
19              
20             =head1 SYNOPSIS
21              
22            
23              
24             [...]
25              
26            
27             Database jabberroster.sqlite
28             FixedGuestOK yes
29            
30            
31              
32             Valid command are all command valid in DJabberd::RosterStorage::SQLite Plus the following
33              
34             FixedGuestOK - Populate accounts with the shared roster if they are not in the roster itself?
35             Setting this to yes will populate a user who is not in the shared roster with everyone in the shared roster
36             The default is to only populate rosters for users that are part of the shared roster
37              
38             =head1 AUTHOR
39              
40             Edward Rudd, C<< >>
41              
42             =cut
43              
44             =head2 set_config_fixedguestok($self, $guest)
45              
46             Called to specify if guests should have the shared roster added to their roster
47              
48             =cut
49              
50             sub set_config_fixedguestok {
51             my ($self, $guest) = @_;
52             $self->{fixed_guestok} = as_bool $guest;
53             }
54              
55             =head2 finalize($self)
56              
57             Set defaults for the configuration
58              
59             =cut
60              
61             sub finalize {
62             my $self = shift;
63             $self->{fixed_guestok} = 0 unless $self->{fixed_guestok};
64             $self->SUPER::finalize;
65             }
66              
67             =head2 get_roster($self, $cb, $jid)
68              
69             Gets the Roster for the user
70              
71             =cut
72              
73             sub get_roster {
74             my ($self, $cb, $jid) = @_;
75             # cb can '->set_roster(Roster)' or decline
76              
77             my $myself = lc $jid->as_bare_string;
78             $logger->info("Fixed loading roster for $myself ...");
79              
80             my $on_load_roster = sub {
81             my (undef, $roster) = @_;
82              
83             my $pre_ct = $roster->items;
84             $logger->info(" $pre_ct roster items prior to population...");
85              
86             # see which shared contacts already in roster
87             my %has;
88             foreach my $it ($roster->items) {
89             my $jid = $it->jid;
90             $has{lc $jid->as_bare_string} = $it;
91             }
92              
93             # add missing shared contacts to the roster
94             my $req_roster = $self->_roster();
95             if ($self->{fixed_guestok}==0) {
96             my $guestok = 0;
97             foreach my $user ( @$req_roster) {
98             if ($user->{jid} eq $myself) {
99             $guestok = 1;
100             last;
101             }
102             }
103             # Bail if guestOK == 0 && user it not in the roster
104             return if $guestok == 0;
105             }
106              
107             foreach my $user ( @$req_roster) {
108             next if $user->{jid} eq $myself;
109              
110             my $name = $user->{name};
111             my $ri = $has{$user->{jid}} || DJabberd::RosterItem->new(jid => $user->{jid},
112             name => ($user->{name} || $user->{jid}),
113             groups => [$user->{group}]);
114              
115              
116             $ri->subscription->set_from;
117             $ri->subscription->set_to;
118             $roster->add($ri);
119             }
120              
121             my $post_ct = $roster->items;
122             $logger->info(" $post_ct roster items post population...");
123              
124             $cb->set_roster($roster);
125             };
126              
127             my $cb2 = DJabberd::Callback->new({set_roster => $on_load_roster,
128             decline => sub { $cb->decline }});
129             $self->SUPER::get_roster($cb2, $jid);
130             }
131              
132             =head2 check_install_schema($self)
133              
134             Checks the SQL ite Schema
135              
136             =cut
137              
138             sub check_install_schema {
139             my $self = shift;
140              
141             $self->SUPER::check_install_schema();
142              
143             my $dbh = $self->{dbh};
144              
145             eval {
146             $dbh->do(qq{
147             CREATE TABLE requiredusers (
148             jid VARCHAR(255) NOT NULL,
149             fullname VARCHAR(255) NOT NULL,
150             groupname VARCHAR(255) NOT NULL,
151             UNIQUE (jid)
152             )});
153             };
154             if ($@ && $@ !~ /table \w+ already exists/) {
155             $logger->logdie("SQL error $@");
156             die "SQL error: $@\n";
157             }
158             eval {
159             $dbh->do(qq{
160             CREATE VIEW RosterPreview AS
161             SELECT ju.jid AS UserID, g.name AS [Group],
162             jr.jid AS ContactID, r.name AS Contact, r.subscription AS Subscription
163             FROM roster r
164             JOIN jidmap ju ON r.userid=ju.jidid
165             JOIN jidmap jr ON r.contactid = jr.jidid
166             JOIN groupitem gi ON gi.contactid=r.contactid
167             JOIN rostergroup g ON g.userid=r.userid AND g.groupid=gi.groupid
168             UNION SELECT r1.jid, r2.groupname, r2.jid, r2.fullname, 3
169             FROM requiredusers r1, requiredusers r2
170             WHERE r1.jid != r2.jid});
171             };
172             if ($@ && $@ !~ /table \w+ already exists/) {
173             $logger->logdie("SQL error $@");
174             die "SQL error: $@\n";
175             }
176             eval {
177             $dbh->do(qq{
178             CREATE VIEW RosterList AS
179             SELECT J.jidid as LID, J2.jidid as RID,
180             G.groupid as GID,
181             J.jid AS Local, J2.jid AS Remote,
182             G.name AS [Group]
183             FROM jidmap J
184             JOIN rostergroup G ON G.userid=J.jidid
185             JOIN groupitem M ON G.groupid = M.groupid
186             JOIN jidmap J2 ON J2.jidid = M.contactid
187             ORDER BY J.jid, J2.jid});
188             };
189             if ($@ && $@ !~ /table \w+ already exists/) {
190             $logger->logdie("SQL error $@");
191             die "SQL error: $@\n";
192             }
193             $logger->info("Created all roster tables");
194             }
195              
196             my $last_roster;
197             my $last_roster_time = 0; # unixtime of last SQL suck
198             sub _roster {
199             my $self = shift;
200             my $now = time();
201              
202             # Cache list for 1 minute(s)
203             if ($last_roster && $last_roster_time > $now - 60) {
204             return $last_roster;
205             }
206              
207             my $dbh = $self->{dbh};
208              
209             my $sql = qq{
210             SELECT jid, fullname, groupname FROM requiredusers
211             };
212              
213             my $roster = eval {
214             $dbh->selectall_arrayref($sql);
215             };
216             $logger->logdie("Failed to load roster: $@") if $@;
217              
218             $logger->info("Found ".($#{ @$roster}+1)." Roster users");
219              
220             my @info = ();
221             foreach my $item ( @$roster ) {
222             my $rec = {};
223             $rec->{'jid'} = $item->[0];
224             $rec->{'name'} = $item->[1];
225             $rec->{'group'} = $item->[2];
226             push @info, $rec;
227             }
228             $logger->info("Loaded ".($#info+1)." Roster users");
229             $last_roster_time = $now;
230             return $last_roster = \@info;
231             }
232              
233             =head2 load_roster_item($self, $jid, $contact_jid, $cb)
234              
235             Called when a roster item is added
236              
237             =cut
238              
239             sub load_roster_item {
240             my ($self, $jid, $contact_jid, $cb) = @_;
241              
242             my $is_shared = sub {
243             my $jid = shift;
244             my $roster = $self->_roster();
245             foreach my $user (@$roster) {
246             if (lc $user->{jid} eq lc $jid->as_bare_string) { return 1; }
247             }
248             return 0;
249             };
250              
251             if ($is_shared->($jid) && $is_shared->($contact_jid)) {
252             my $both = DJabberd::Subscription->new;
253             $both->set_from;
254             $both->set_to;
255             my $rit = DJabberd::RosterItem->new(jid => $contact_jid,
256             subscription => $both);
257             $cb->set($rit);
258             return;
259             }
260              
261             $self->SUPER::load_roster_item($jid, $contact_jid, $cb);
262             }
263              
264             =head1 COPYRIGHT & LICENSE
265              
266             Original work Copyright 2006 Alexander Karelas, Martin Atkins, Brad Fitzpatrick and Aleksandar Milanov. All rights reserved.
267             Copyright 2007 Edward Rudd. All rights reserved.
268            
269             This program is free software; you can redistribute it and/or modify it
270             under the same terms as Perl itself.
271              
272             =cut
273              
274             1;