summaryrefslogtreecommitdiffstatsabout
diff options
context:
space:
mode:
-rw-r--r--.gitignore4
-rw-r--r--Changes8
-rw-r--r--MANIFEST10
-rw-r--r--Makefile.PL19
-rw-r--r--README26
-rw-r--r--lib/DJabberd/RosterStorage/SQLite/Fixed.pm274
-rwxr-xr-xscripts/rosteredit.pl62
-rw-r--r--t/00-load.t9
-rw-r--r--t/boilerplate.t48
-rw-r--r--t/pod-coverage.t6
-rw-r--r--t/pod.t6
11 files changed, 472 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..10b5458
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,4 @@
1META.yml
2Makefile
3/blib
4/pm_to_blib
diff --git a/Changes b/Changes
new file mode 100644
index 0000000..caa2188
--- /dev/null
+++ b/Changes
@@ -0,0 +1,8 @@
1Revision history for DJabberd-RosterStorage-SQLite-Fixed
2
30.02 2007-08-21
4 Add rosteredit.pl script. Add in views
5
60.01 2007-08-01
7 First version, released on an unsuspecting world.
8
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..9afbfda
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,10 @@
1Changes
2MANIFEST
3Makefile.PL
4README
5scripts/rosteredit.pl
6lib/DJabberd/RosterStorage/SQLite/Fixed.pm
7t/00-load.t
8t/boilerplate.t
9t/pod-coverage.t
10t/pod.t
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..a7cff9f
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,19 @@
1use strict;
2use warnings;
3use ExtUtils::MakeMaker;
4
5WriteMakefile(
6 NAME => 'DJabberd::RosterStorage::SQLite::Fixed',
7 AUTHOR => 'Edward Rudd <urkle@outoforder.cc>',
8 VERSION_FROM => 'lib/DJabberd/RosterStorage/SQLite/Fixed.pm',
9 EXE_FILES => ['scripts/rosteredit.pl'],
10 ABSTRACT_FROM => 'lib/DJabberd/RosterStorage/SQLite/Fixed.pm',
11 PL_FILES => {},
12 PREREQ_PM => {
13 'Test::More' => 0,
14 'DJabberd' => 0.83,
15 'DJabberd::RosterStorage::SQLite' => 1.00
16 },
17 dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
18 clean => { FILES => 'DJabberd-RosterStorage-SQLite-Fixed-*' },
19);
diff --git a/README b/README
new file mode 100644
index 0000000..f71c083
--- /dev/null
+++ b/README
@@ -0,0 +1,26 @@
1DJabberd-RosterStorage-SQLite-Fixed
2
3Shared Roster for DJabberd using SQLite.
4
5INSTALLATION
6
7To install this module, run the following commands:
8
9 perl Makefile.PL
10 make
11 make test
12 make install
13
14
15SUPPORT AND DOCUMENTATION
16
17After installing, you can find documentation for this module with the perldoc command.
18
19 perldoc DJabberd::RosterStorage::SQLite::Fixed
20
21COPYRIGHT AND LICENCE
22
23Copyright (C) 2007 Edward Rudd
24
25This program is free software; you can redistribute it and/or modify it
26under the same terms as Perl itself.
diff --git a/lib/DJabberd/RosterStorage/SQLite/Fixed.pm b/lib/DJabberd/RosterStorage/SQLite/Fixed.pm
new file mode 100644
index 0000000..fe41363
--- /dev/null
+++ b/lib/DJabberd/RosterStorage/SQLite/Fixed.pm
@@ -0,0 +1,274 @@
1package DJabberd::RosterStorage::SQLite::Fixed;
2use strict;
3use warnings;
4use base 'DJabberd::RosterStorage::SQLite';
5use DJabberd::Log;
6use DJabberd::Util;
7our $logger = DJabberd::Log->get_logger();
8
9=head1 NAME
10
11DJabberd::RosterStorage::SQLite::Fixed - a shared roster implementation for the SQLite roster storage
12
13=head1 VERSION
14
15Version 0.02
16=cut
17
18our $VERSION = '0.02';
19
20=head1 SYNOPSIS
21
22 <VHost mydomain.com>
23
24 [...]
25
26 <Plugin DJabberd::RosterStorage::SQLite::Fixed>
27 Database jabberroster.sqlite
28 FixedGuestOK yes
29 </Plugin>
30 </VHost>
31
32Valid command are all command valid in DJabberd::RosterStorage::SQLite Plus the following
33
34FixedGuestOK - 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
40Edward Rudd, C<< <urkle at outoforder.cc> >>
41
42=cut
43
44=head2 set_config_fixedguestok($self, $guest)
45
46Called to specify if guests should have the shared roster added to their roster
47
48=cut
49
50sub set_config_fixedguestok {
51 my ($self, $guest) = @_;
52 $self->{fixed_guestok} = as_bool $guest;
53}
54
55=head2 finalize($self)
56
57Set defaults for the configuration
58
59=cut
60
61sub 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
69Gets the Roster for the user
70
71=cut
72
73sub 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
134Checks the SQL ite Schema
135
136=cut
137
138sub 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
196my $last_roster;
197my $last_roster_time = 0; # unixtime of last SQL suck
198sub _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
235Called when a roster item is added
236
237=cut
238
239sub 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
266Original work Copyright 2006 Alexander Karelas, Martin Atkins, Brad Fitzpatrick and Aleksandar Milanov. All rights reserved.
267Copyright 2007 Edward Rudd. All rights reserved.
268
269This program is free software; you can redistribute it and/or modify it
270under the same terms as Perl itself.
271
272=cut
273
2741;
diff --git a/scripts/rosteredit.pl b/scripts/rosteredit.pl
new file mode 100755
index 0000000..4c7132d
--- /dev/null
+++ b/scripts/rosteredit.pl
@@ -0,0 +1,62 @@
1#!/usr/bin/perl
2
3use strict;
4
5use DBI;
6
7if ($#ARGV < 0) {
8 die ("must specify database then action (list, add, del, preview)\n");
9}
10my $db = shift @ARGV;
11my $dbh = DBI->connect_cached("dbi:SQLite:dbname=$db","","", { RaiseError => 1, PrintError => 0, AutoCommit => 1 });
12
13my $action;
14my $param;
15
16if ($#ARGV < 0) {
17 die ("must specify action (list, add, del, preview)\n");
18} else {
19 $action = shift @ARGV;
20 for ($action) {
21 if (/^preview$/) {
22 if ($#ARGV < 0) {
23 die ("Must specify jabber id");
24 }
25 my $sql = "SELECT [Group], ContactID, Contact, Subscription FROM RosterPreview WHERE UserID = ?";
26 my ($jid) = @ARGV;
27 my $roster = eval {
28 $dbh->selectall_arrayref($sql,{ Slite=> {} },$jid);
29 };
30 foreach my $item ( @$roster ) {
31 print "Entry: $item->[3] $item->[2]<$item->[1]> in group $item->[0]\n";
32 }
33 } elsif (/^list$/) {
34 my $sql = "SELECT jid, fullname, groupname FROM requiredusers ORDER BY groupname, fullname";
35 my $roster = eval {
36 $dbh->selectall_arrayref($sql,{ Slite=> {} });
37 };
38 foreach my $item ( @$roster ) {
39 print "Entry: $item->[1]<$item->[0]> in group $item->[2]\n";
40 }
41 } elsif (/^add$/) {
42 if ($#ARGV < 2) {
43 die ("Must specify jabber id, fullname and groupname");
44 }
45 my $sql = "INSERT INTO requiredusers (jid, fullname, groupname) VALUES (?, ?, ?)";
46 my ($jid, $fname, $gname) = @ARGV;
47 print "Adding: $fname<$jid> to group $gname\n";
48 $dbh->do($sql,undef,$jid,$fname,$gname);
49 } elsif (/^del$/) {
50 if ($#ARGV < 0) {
51 die ("Must specify jabber id");
52 }
53 my $sql = "DELETE FROM requiredusers WHERE jid = ?";
54 my ($jid) = @ARGV;
55 print "Deleting: $jid\n";
56 $dbh->do($sql,undef,$jid);
57 } else {
58 die ("Unknown action $action\n");
59 }
60 }
61}
62
diff --git a/t/00-load.t b/t/00-load.t
new file mode 100644
index 0000000..786b9cd
--- /dev/null
+++ b/t/00-load.t
@@ -0,0 +1,9 @@
1#!perl -T
2
3use Test::More tests => 1;
4
5BEGIN {
6 use_ok( 'DJabberd::RosterStorage::SQLite::Fixed' );
7}
8
9diag( "Testing DJabberd::RosterStorage::SQLite::Fixed $DJabberd::RosterStorage::SQLite::Fixed::VERSION, Perl $], $^X" );
diff --git a/t/boilerplate.t b/t/boilerplate.t
new file mode 100644
index 0000000..824d393
--- /dev/null
+++ b/t/boilerplate.t
@@ -0,0 +1,48 @@
1#!perl -T
2
3use strict;
4use warnings;
5use Test::More tests => 3;
6
7sub not_in_file_ok {
8 my ($filename, %regex) = @_;
9 open my $fh, "<", $filename
10 or die "couldn't open $filename for reading: $!";
11
12 my %violated;
13
14 while (my $line = <$fh>) {
15 while (my ($desc, $regex) = each %regex) {
16 if ($line =~ $regex) {
17 push @{$violated{$desc}||=[]}, $.;
18 }
19 }
20 }
21
22 if (%violated) {
23 fail("$filename contains boilerplate text");
24 diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
25 } else {
26 pass("$filename contains no boilerplate text");
27 }
28}
29
30not_in_file_ok(README =>
31 "The README is used..." => qr/The README is used/,
32 "'version information here'" => qr/to provide version information/,
33);
34
35not_in_file_ok(Changes =>
36 "placeholder date/time" => qr(Date/time)
37);
38
39sub module_boilerplate_ok {
40 my ($module) = @_;
41 not_in_file_ok($module =>
42 'the great new $MODULENAME' => qr/ - The great new /,
43 'boilerplate description' => qr/Quick summary of what the module/,
44 'stub function definition' => qr/function[12]/,
45 );
46}
47
48module_boilerplate_ok('lib/DJabberd/RosterStorage/SQLite/Fixed.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 @@
1#!perl -T
2
3use Test::More;
4eval "use Test::Pod::Coverage 1.04";
5plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
6all_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 @@
1#!perl -T
2
3use Test::More;
4eval "use Test::Pod 1.14";
5plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
6all_pod_files_ok();