From 20921d9f5508d74b0e3cbc314c667393251ef909 Mon Sep 17 00:00:00 2001 From: Edward Rudd Date: Mon, 15 Feb 2010 12:34:02 -0500 Subject: import release 0.02 --- .gitignore | 4 + Changes | 8 + MANIFEST | 10 ++ Makefile.PL | 19 ++ README | 26 +++ lib/DJabberd/RosterStorage/SQLite/Fixed.pm | 274 +++++++++++++++++++++++++++++ scripts/rosteredit.pl | 62 +++++++ t/00-load.t | 9 + t/boilerplate.t | 48 +++++ t/pod-coverage.t | 6 + t/pod.t | 6 + 11 files changed, 472 insertions(+) create mode 100644 .gitignore create mode 100644 Changes create mode 100644 MANIFEST create mode 100644 Makefile.PL create mode 100644 README create mode 100644 lib/DJabberd/RosterStorage/SQLite/Fixed.pm create mode 100755 scripts/rosteredit.pl create mode 100644 t/00-load.t create mode 100644 t/boilerplate.t create mode 100644 t/pod-coverage.t create mode 100644 t/pod.t diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..10b5458 --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +META.yml +Makefile +/blib +/pm_to_blib diff --git a/Changes b/Changes new file mode 100644 index 0000000..caa2188 --- /dev/null +++ b/Changes @@ -0,0 +1,8 @@ +Revision history for DJabberd-RosterStorage-SQLite-Fixed + +0.02 2007-08-21 + Add rosteredit.pl script. Add in views + +0.01 2007-08-01 + First version, released on an unsuspecting world. + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..9afbfda --- /dev/null +++ b/MANIFEST @@ -0,0 +1,10 @@ +Changes +MANIFEST +Makefile.PL +README +scripts/rosteredit.pl +lib/DJabberd/RosterStorage/SQLite/Fixed.pm +t/00-load.t +t/boilerplate.t +t/pod-coverage.t +t/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 @@ +use strict; +use warnings; +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'DJabberd::RosterStorage::SQLite::Fixed', + AUTHOR => 'Edward Rudd ', + VERSION_FROM => 'lib/DJabberd/RosterStorage/SQLite/Fixed.pm', + EXE_FILES => ['scripts/rosteredit.pl'], + ABSTRACT_FROM => 'lib/DJabberd/RosterStorage/SQLite/Fixed.pm', + PL_FILES => {}, + PREREQ_PM => { + 'Test::More' => 0, + 'DJabberd' => 0.83, + 'DJabberd::RosterStorage::SQLite' => 1.00 + }, + dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, + clean => { FILES => 'DJabberd-RosterStorage-SQLite-Fixed-*' }, +); diff --git a/README b/README new file mode 100644 index 0000000..f71c083 --- /dev/null +++ b/README @@ -0,0 +1,26 @@ +DJabberd-RosterStorage-SQLite-Fixed + +Shared Roster for DJabberd using SQLite. + +INSTALLATION + +To install this module, run the following commands: + + perl Makefile.PL + make + make test + make install + + +SUPPORT AND DOCUMENTATION + +After installing, you can find documentation for this module with the perldoc command. + + perldoc DJabberd::RosterStorage::SQLite::Fixed + +COPYRIGHT AND LICENCE + +Copyright (C) 2007 Edward Rudd + +This program is free software; you can redistribute it and/or modify it +under 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 @@ +package DJabberd::RosterStorage::SQLite::Fixed; +use strict; +use warnings; +use base 'DJabberd::RosterStorage::SQLite'; +use DJabberd::Log; +use DJabberd::Util; +our $logger = DJabberd::Log->get_logger(); + +=head1 NAME + +DJabberd::RosterStorage::SQLite::Fixed - a shared roster implementation for the SQLite roster storage + +=head1 VERSION + +Version 0.02 +=cut + +our $VERSION = '0.02'; + +=head1 SYNOPSIS + + + + [...] + + + Database jabberroster.sqlite + FixedGuestOK yes + + + +Valid command are all command valid in DJabberd::RosterStorage::SQLite Plus the following + +FixedGuestOK - Populate accounts with the shared roster if they are not in the roster itself? + Setting this to yes will populate a user who is not in the shared roster with everyone in the shared roster + The default is to only populate rosters for users that are part of the shared roster + +=head1 AUTHOR + +Edward Rudd, C<< >> + +=cut + +=head2 set_config_fixedguestok($self, $guest) + +Called to specify if guests should have the shared roster added to their roster + +=cut + +sub set_config_fixedguestok { + my ($self, $guest) = @_; + $self->{fixed_guestok} = as_bool $guest; +} + +=head2 finalize($self) + +Set defaults for the configuration + +=cut + +sub finalize { + my $self = shift; + $self->{fixed_guestok} = 0 unless $self->{fixed_guestok}; + $self->SUPER::finalize; +} + +=head2 get_roster($self, $cb, $jid) + +Gets the Roster for the user + +=cut + +sub get_roster { + my ($self, $cb, $jid) = @_; + # cb can '->set_roster(Roster)' or decline + + my $myself = lc $jid->as_bare_string; + $logger->info("Fixed loading roster for $myself ..."); + + my $on_load_roster = sub { + my (undef, $roster) = @_; + + my $pre_ct = $roster->items; + $logger->info(" $pre_ct roster items prior to population..."); + + # see which shared contacts already in roster + my %has; + foreach my $it ($roster->items) { + my $jid = $it->jid; + $has{lc $jid->as_bare_string} = $it; + } + + # add missing shared contacts to the roster + my $req_roster = $self->_roster(); + if ($self->{fixed_guestok}==0) { + my $guestok = 0; + foreach my $user ( @$req_roster) { + if ($user->{jid} eq $myself) { + $guestok = 1; + last; + } + } + # Bail if guestOK == 0 && user it not in the roster + return if $guestok == 0; + } + + foreach my $user ( @$req_roster) { + next if $user->{jid} eq $myself; + + my $name = $user->{name}; + my $ri = $has{$user->{jid}} || DJabberd::RosterItem->new(jid => $user->{jid}, + name => ($user->{name} || $user->{jid}), + groups => [$user->{group}]); + + + $ri->subscription->set_from; + $ri->subscription->set_to; + $roster->add($ri); + } + + my $post_ct = $roster->items; + $logger->info(" $post_ct roster items post population..."); + + $cb->set_roster($roster); + }; + + my $cb2 = DJabberd::Callback->new({set_roster => $on_load_roster, + decline => sub { $cb->decline }}); + $self->SUPER::get_roster($cb2, $jid); +} + +=head2 check_install_schema($self) + +Checks the SQL ite Schema + +=cut + +sub check_install_schema { + my $self = shift; + + $self->SUPER::check_install_schema(); + + my $dbh = $self->{dbh}; + + eval { + $dbh->do(qq{ + CREATE TABLE requiredusers ( + jid VARCHAR(255) NOT NULL, + fullname VARCHAR(255) NOT NULL, + groupname VARCHAR(255) NOT NULL, + UNIQUE (jid) + )}); + }; + if ($@ && $@ !~ /table \w+ already exists/) { + $logger->logdie("SQL error $@"); + die "SQL error: $@\n"; + } + eval { + $dbh->do(qq{ + CREATE VIEW RosterPreview AS + SELECT ju.jid AS UserID, g.name AS [Group], + jr.jid AS ContactID, r.name AS Contact, r.subscription AS Subscription + FROM roster r + JOIN jidmap ju ON r.userid=ju.jidid + JOIN jidmap jr ON r.contactid = jr.jidid + JOIN groupitem gi ON gi.contactid=r.contactid + JOIN rostergroup g ON g.userid=r.userid AND g.groupid=gi.groupid + UNION SELECT r1.jid, r2.groupname, r2.jid, r2.fullname, 3 + FROM requiredusers r1, requiredusers r2 + WHERE r1.jid != r2.jid}); + }; + if ($@ && $@ !~ /table \w+ already exists/) { + $logger->logdie("SQL error $@"); + die "SQL error: $@\n"; + } + eval { + $dbh->do(qq{ + CREATE VIEW RosterList AS + SELECT J.jidid as LID, J2.jidid as RID, + G.groupid as GID, + J.jid AS Local, J2.jid AS Remote, + G.name AS [Group] + FROM jidmap J + JOIN rostergroup G ON G.userid=J.jidid + JOIN groupitem M ON G.groupid = M.groupid + JOIN jidmap J2 ON J2.jidid = M.contactid + ORDER BY J.jid, J2.jid}); + }; + if ($@ && $@ !~ /table \w+ already exists/) { + $logger->logdie("SQL error $@"); + die "SQL error: $@\n"; + } + $logger->info("Created all roster tables"); +} + +my $last_roster; +my $last_roster_time = 0; # unixtime of last SQL suck +sub _roster { + my $self = shift; + my $now = time(); + + # Cache list for 1 minute(s) + if ($last_roster && $last_roster_time > $now - 60) { + return $last_roster; + } + + my $dbh = $self->{dbh}; + + my $sql = qq{ + SELECT jid, fullname, groupname FROM requiredusers + }; + + my $roster = eval { + $dbh->selectall_arrayref($sql); + }; + $logger->logdie("Failed to load roster: $@") if $@; + + $logger->info("Found ".($#{ @$roster}+1)." Roster users"); + + my @info = (); + foreach my $item ( @$roster ) { + my $rec = {}; + $rec->{'jid'} = $item->[0]; + $rec->{'name'} = $item->[1]; + $rec->{'group'} = $item->[2]; + push @info, $rec; + } + $logger->info("Loaded ".($#info+1)." Roster users"); + $last_roster_time = $now; + return $last_roster = \@info; +} + +=head2 load_roster_item($self, $jid, $contact_jid, $cb) + +Called when a roster item is added + +=cut + +sub load_roster_item { + my ($self, $jid, $contact_jid, $cb) = @_; + + my $is_shared = sub { + my $jid = shift; + my $roster = $self->_roster(); + foreach my $user (@$roster) { + if (lc $user->{jid} eq lc $jid->as_bare_string) { return 1; } + } + return 0; + }; + + if ($is_shared->($jid) && $is_shared->($contact_jid)) { + my $both = DJabberd::Subscription->new; + $both->set_from; + $both->set_to; + my $rit = DJabberd::RosterItem->new(jid => $contact_jid, + subscription => $both); + $cb->set($rit); + return; + } + + $self->SUPER::load_roster_item($jid, $contact_jid, $cb); +} + +=head1 COPYRIGHT & LICENSE + +Original work Copyright 2006 Alexander Karelas, Martin Atkins, Brad Fitzpatrick and Aleksandar Milanov. All rights reserved. +Copyright 2007 Edward Rudd. All rights reserved. + +This program is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +=cut + +1; 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 @@ +#!/usr/bin/perl + +use strict; + +use DBI; + +if ($#ARGV < 0) { + die ("must specify database then action (list, add, del, preview)\n"); +} +my $db = shift @ARGV; +my $dbh = DBI->connect_cached("dbi:SQLite:dbname=$db","","", { RaiseError => 1, PrintError => 0, AutoCommit => 1 }); + +my $action; +my $param; + +if ($#ARGV < 0) { + die ("must specify action (list, add, del, preview)\n"); +} else { + $action = shift @ARGV; + for ($action) { + if (/^preview$/) { + if ($#ARGV < 0) { + die ("Must specify jabber id"); + } + my $sql = "SELECT [Group], ContactID, Contact, Subscription FROM RosterPreview WHERE UserID = ?"; + my ($jid) = @ARGV; + my $roster = eval { + $dbh->selectall_arrayref($sql,{ Slite=> {} },$jid); + }; + foreach my $item ( @$roster ) { + print "Entry: $item->[3] $item->[2]<$item->[1]> in group $item->[0]\n"; + } + } elsif (/^list$/) { + my $sql = "SELECT jid, fullname, groupname FROM requiredusers ORDER BY groupname, fullname"; + my $roster = eval { + $dbh->selectall_arrayref($sql,{ Slite=> {} }); + }; + foreach my $item ( @$roster ) { + print "Entry: $item->[1]<$item->[0]> in group $item->[2]\n"; + } + } elsif (/^add$/) { + if ($#ARGV < 2) { + die ("Must specify jabber id, fullname and groupname"); + } + my $sql = "INSERT INTO requiredusers (jid, fullname, groupname) VALUES (?, ?, ?)"; + my ($jid, $fname, $gname) = @ARGV; + print "Adding: $fname<$jid> to group $gname\n"; + $dbh->do($sql,undef,$jid,$fname,$gname); + } elsif (/^del$/) { + if ($#ARGV < 0) { + die ("Must specify jabber id"); + } + my $sql = "DELETE FROM requiredusers WHERE jid = ?"; + my ($jid) = @ARGV; + print "Deleting: $jid\n"; + $dbh->do($sql,undef,$jid); + } else { + die ("Unknown action $action\n"); + } + } +} + 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 @@ +#!perl -T + +use Test::More tests => 1; + +BEGIN { + use_ok( 'DJabberd::RosterStorage::SQLite::Fixed' ); +} + +diag( "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 @@ +#!perl -T + +use strict; +use warnings; +use Test::More tests => 3; + +sub not_in_file_ok { + my ($filename, %regex) = @_; + open my $fh, "<", $filename + or die "couldn't open $filename for reading: $!"; + + my %violated; + + while (my $line = <$fh>) { + while (my ($desc, $regex) = each %regex) { + if ($line =~ $regex) { + push @{$violated{$desc}||=[]}, $.; + } + } + } + + if (%violated) { + fail("$filename contains boilerplate text"); + diag "$_ appears on lines @{$violated{$_}}" for keys %violated; + } else { + pass("$filename contains no boilerplate text"); + } +} + +not_in_file_ok(README => + "The README is used..." => qr/The README is used/, + "'version information here'" => qr/to provide version information/, +); + +not_in_file_ok(Changes => + "placeholder date/time" => qr(Date/time) +); + +sub module_boilerplate_ok { + my ($module) = @_; + not_in_file_ok($module => + 'the great new $MODULENAME' => qr/ - The great new /, + 'boilerplate description' => qr/Quick summary of what the module/, + 'stub function definition' => qr/function[12]/, + ); +} + +module_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 @@ +#!perl -T + +use Test::More; +eval "use Test::Pod::Coverage 1.04"; +plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; +all_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 @@ +#!perl -T + +use Test::More; +eval "use Test::Pod 1.14"; +plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; +all_pod_files_ok(); -- cgit