source: perl/modules/Jabber/lib/Net/XMPP/PrivacyLists.pm @ b401ef2

barnowl_perlaimdebianrelease-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since b401ef2 was c2bed55, checked in by Nelson Elhage <nelhage@mit.edu>, 18 years ago
Moving Net::Jabber into Jabber.par
  • Property mode set to 100644
File size: 8.1 KB
Line 
1##############################################################################
2#
3#  This library is free software; you can redistribute it and/or
4#  modify it under the terms of the GNU Library General Public
5#  License as published by the Free Software Foundation; either
6#  version 2 of the License, or (at your option) any later version.
7#
8#  This library is distributed in the hope that it will be useful,
9#  but WITHOUT ANY WARRANTY; without even the implied warranty of
10#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
11#  Library General Public License for more details.
12#
13#  You should have received a copy of the GNU Library General Public
14#  License along with this library; if not, write to the
15#  Free Software Foundation, Inc., 59 Temple Place - Suite 330,
16#  Boston, MA  02111-1307, USA.
17#
18#  Copyright (C) 1998-2004 Jabber Software Foundation http://jabber.org/
19#
20##############################################################################
21
22package Net::XMPP::PrivacyLists;
23
24=head1 NAME
25
26Net::XMPP::PrivacyLists - XMPP Privacy Lists Object
27
28=head1 SYNOPSIS
29
30  This module is not yet complete.  Do not use.
31
32=head1 DESCRIPTION
33
34=head2 Basic Functions
35
36=head2 Advanced Functions
37
38=head1 METHODS
39
40=head2 Basic Functions
41
42=head2 Advanced Functions
43
44=head1 AUTHOR
45
46Ryan Eatmon
47
48=head1 COPYRIGHT
49
50This module is free software; you can redistribute it and/or modify
51it under the same terms as Perl itself.
52
53=cut
54
55use strict;
56use Carp;
57
58sub new
59{
60    my $proto = shift;
61    my $self = { };
62
63    my %args;
64    while($#_ >= 0) { $args{ lc(pop(@_)) } = pop(@_); }
65
66    $self->{CONNECTION} = $args{connection};
67   
68    bless($self, $proto);
69
70    $self->init();
71   
72    return $self;
73}
74
75
76##############################################################################
77#
78# init - initialize the module to use the privacy lists.
79#
80##############################################################################
81sub init
82{
83    my $self = shift;
84
85    $self->{CONNECTION}-> SetXPathCallBacks('/iq[@type="result" or @type="set"]/query[@xmlns="jabber:iq:privacy"]'=>sub{ $self->handler(@_) });
86}
87
88
89##############################################################################
90#
91# debug - print out a representation of the privacy lists.
92#
93##############################################################################
94sub debug
95{
96    my $self = shift;
97
98    &XML::Stream::printData("\$self->{LISTS}",$self->{LISTS});
99}
100
101
102##############################################################################
103#
104# addItem - add list item to a list.
105#
106##############################################################################
107sub addItem
108{
109    my $self = shift;
110    my ($list,%item) = @_;
111
112    my $order = delete($item{order});
113    $self->{LISTS}->{$list}->{$order} = \%item;
114}
115
116
117###############################################################################
118#
119# clear - delete all of the JIDs from the DB completely.
120#
121###############################################################################
122sub clear
123{
124    my $self = shift;
125
126    $self->{CONNECTION}->{DEBUG}->Log3("PrivacyLists::clear: clearing the database");
127    foreach my $list ($self->lists())
128    {
129        $self->remove($list);
130    }
131    $self->{CONNECTION}->{DEBUG}->Log3("PrivacyLists::clear: database is empty");
132}
133
134
135##############################################################################
136#
137# exists - allows you to query if the JID exists in the Roster DB.
138#
139##############################################################################
140sub exists
141{
142    my $self = shift;
143    my $list = shift;
144
145    return unless exists($self->{LISTS});
146    return unless exists($self->{LISTS}->{$list});
147    return 1;
148}
149
150
151##############################################################################
152#
153# fetch - fetch the privacy lists from the server and populate the database.
154#
155##############################################################################
156sub fetch
157{
158    my $self = shift;
159
160    my $iq = $self->{CONNECTION}->PrivacyListsGet();
161    $self->handleIQ($iq);
162}
163
164
165##############################################################################
166#
167# fetchList - fetch the privacy list from the server and populate the database.
168#
169##############################################################################
170sub fetchList
171{
172    my $self = shift;
173    my $list = shift;
174   
175    my $iq = $self->{CONNECTION}->PrivacyListsGet(list=>$list);
176    $self->handleIQ($iq);
177}
178
179
180##############################################################################
181#
182# lists - returns a list of the current privacy lists.
183#
184##############################################################################
185sub lists
186{
187    my $self = shift;
188
189    return () unless exists($self->{LISTS});
190    return () if (scalar(keys(%{$self->{LISTS}})) == 0);
191    return keys(%{$self->{LISTS}});
192}
193
194
195##############################################################################
196#
197# items - returns a list of all of the items in the specified privacy list.
198#
199##############################################################################
200sub items
201{
202    my $self = shift;
203    my $list = shift;
204
205    my @items;
206
207    return () unless $self->exists($list);
208    foreach my $order (sort{ $a <=> $b } keys(%{$self->{LISTS}->{$list}}))
209    {
210        my %item = %{$self->{LISTS}->{$list}->{$order}};
211        $item{order} = $order;
212        push(@items,\%item);
213    }
214
215    return @items;
216}
217
218
219##############################################################################
220#
221# handler - takes a packet and calls the correct handler.
222#
223##############################################################################
224sub handler
225{
226    my $self = shift;
227    my $sid = shift;
228    my $packet = shift;
229
230    $self->handleIQ($packet) if ($packet->GetTag() eq "iq");
231}
232
233
234##############################################################################
235#
236# handleIQ - takes an iq packet that contains roster, parses it, and puts
237#            the roster into the Roster DB.
238#
239##############################################################################
240sub handleIQ
241{
242    my $self = shift;
243    my $iq = shift;
244
245    print "handleIQ: iq(",$iq->GetXML(),")\n";
246
247    my $type = $iq->GetType();
248    return unless (($type eq "set") || ($type eq "result"));
249
250    if ($type eq "result")
251    {
252        my $query = $iq->GetChild("jabber:iq:privacy");
253       
254        my @lists = $query->GetLists();
255
256        return unless ($#lists > -1);
257       
258        my @items = $lists[0]->GetItems();
259       
260        if (($#lists == 0) && ($#items > -1))
261        {
262            $self->parseList($lists[0]);
263        }
264        elsif ($#lists >= -1)
265        {
266            $self->parseLists(\@lists);
267        }
268    }
269}
270
271
272sub parseList
273{
274    my $self = shift;
275    my $list = shift;
276   
277    my $name = $list->GetName();
278
279    foreach my $item ($list->GetItems())
280    {
281        my %item = $item->GetItem();
282       
283        $self->addItem($name,%item);
284    }
285}
286
287
288sub parseLists
289{
290    my $self = shift;
291    my $lists = shift;
292   
293    foreach my $list (@{$lists})
294    {
295        my $name = $list->GetName();
296        $self->fetchList($name);
297    }
298}
299
300
301##############################################################################
302#
303# reload - clear and refetch the privacy lists.
304#
305##############################################################################
306sub reload
307{
308    my $self = shift;
309
310    $self->clear();
311    $self->fetch();
312}
313
314
315##############################################################################
316#
317# remove - removes the list from the database.
318#
319##############################################################################
320sub remove
321{
322    my $self = shift;
323    my $list = shift;
324
325    if ($self->exists($list))
326    {
327        $self->{CONNECTION}->{DEBUG}->Log3("PrivacyLists::remove: deleting $list from the DB");
328       
329        delete($self->{LISTS}->{$list});
330        delete($self->{LISTS}) if (scalar(keys(%{$self->{LISTS}})) == 0);
331    }
332}
333
334
335sub save
336{
337    my $self = shift;
338
339    foreach my $list ($self->lists())
340    {
341        $self->saveList($list);
342    }
343}
344
345
346sub saveList
347{
348    my $self = shift;
349    my $list = shift;
350
351    my @items = $self->items($list);
352    $self->{CONNECTION}->PrivacyListsSet(list=>$list,
353                                         items=>\@items);
354}
355
356
3571;
358
Note: See TracBrowser for help on using the repository browser.