source: perl/modules/Jabber/lib/Net/XMPP/Roster.pm @ 9375f8c

barnowl_perlaimdebianrelease-1.10release-1.4release-1.5release-1.6release-1.7release-1.8release-1.9
Last change on this file since 9375f8c was c2bed55, checked in by Nelson Elhage <nelhage@mit.edu>, 19 years ago
Moving Net::Jabber into Jabber.par
  • Property mode set to 100644
File size: 25.5 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::Roster;
23
24=head1 NAME
25
26Net::XMPP::Roster - XMPP Roster Object
27
28=head1 SYNOPSIS
29
30  Net::XMPP::Roster is a module that provides a developer an easy
31  interface to an XMPP roster.  It provides high level functions to
32  query, update, and manage a user's roster. 
33
34=head1 DESCRIPTION
35
36  The Roster object seeks to provide an easy to use API for interfacing
37  with a user's roster.  When you instantiate it, it automatically
38  registers with the connection to receivce the correct packets so
39  that it can track all roster updates, and presence packets.
40 
41=head2 Basic Functions
42
43  my $Client = Net::XMPP::Client->new(...);
44
45  my $Roster = Net::XMPP::Roster->new(connection=>$Client);
46    or
47  my $Roster = $Client->Roster();
48
49  $Roster->clear();
50
51  if ($Roster->exists('bob@jabber.org')) { ... }
52  if ($Roster->exists(Net::XMPP::JID)) { ... }
53
54  if ($Roster->groupExists("Friends")) { ... }
55
56  my @groups = $Roster->groups();
57
58  my @jids    = $Roster->jids();
59  my @friends = $Roster->jids("group","Friends");
60  my @unfiled = $Roster->jids("nogroup");
61
62  if ($Roster->online('bob@jabber.org')) { ... }
63  if ($Roster->online(Net::XMPP::JID)) { ... }
64
65  my %hash = $Roster->query('bob@jabber.org');
66  my %hash = $Roster->query(Net::XMPP::JID);
67
68  my $name = $Roster->query('bob@jabber.org',"name");
69  my $ask  = $Roster->query(Net::XMPP::JID,"ask");
70
71  my $resource = $Roster->resource('bob@jabber.org');
72  my $resource = $Roster->resource(Net::XMPP::JID);
73
74  my %hash = $Roster->resourceQuery('bob@jabber.org',"Home");
75  my %hash = $Roster->resourceQuery(Net::XMPP::JID,"Club");
76
77  my $show   = $Roster->resourceQuery('bob@jabber.org',"Home","show");
78  my $status = $Roster->resourceQuery(Net::XMPP::JID,"Work","status");
79
80  my @resource = $Roster->resources('bob@jabber.org');
81  my @resource = $Roster->resources(Net::XMPP::JID);
82
83  $Roster->resourceStore('bob@jabber.org',"Home","gpgkey",key);
84  $Roster->resourceStore(Net::XMPP::JID,"logged on","2004/04/07 ...");
85
86  $Roster->store('bob@jabber.org',"avatar",avatar);
87  $Roster->store(Net::XMPP::JID,"display_name","Bob");
88
89=head2 Advanced Functions
90
91  These functions are only needed if you want to manually control
92  the Roster.
93 
94  $Roster->add('bob@jabber.org',
95               name=>"Bob",
96               groups=>["Friends"]
97              );
98  $Roster->add(Net::XMPP::JID);
99
100  $Roster->addResource('bob@jabber.org',
101                       "Home",
102                       show=>"dnd",
103                       status=>"Working"
104                      );
105  $Roster->addResource(Net::XMPP::JID,"Work");
106
107  $Roster->remove('bob@jabber.org');
108  $Roster->remove(Net::XMPP::JID);
109
110  $Roster->removeResource('bob@jabber.org',"Home");
111  $Roster->removeResource(Net::XMPP::JID,"Work");
112
113  $Roster->handler(Net::XMPP::IQ);
114  $Roster->handler(Net::XMPP::Presence);
115
116=head1 METHODS
117
118=head2 Basic Functions
119
120
121  new(connection=>object) - This creates and initializes the Roster
122                            object.  The connection object is required
123                            so that the Roster can interact with the
124                            main connection object.  It needs to be an
125                            object that inherits from
126                            Net::XMPP::Connection.
127
128  clear() - removes everything from the database.
129
130  exists(jid) - return 1 if the JID exists in the database, undef
131                otherwise.  The jid can either be a string, or a
132                Net::XMPP::JID object.
133               
134  groupExists(group) - return 1 if the group exists in the database,
135                       undef otherwise.
136
137  groups() - returns a list of all of the roster groups.
138
139  jids([type,    - returns a list of all of the matching JIDs.  The valid
140       [group]])   types are:
141
142                    all     - return all JIDs in the roster. (default)
143                    nogroup - return all JIDs not in a roster group.
144                    group   - return all of the JIDs in the specified
145                              roster group.
146
147  online(jid) - return 1 if the JID is online, undef otherwise.  The
148                jid can either be a string, or a Net::XMPP::JID object.
149
150  query(jid,   - return a hash representing all of the data in the
151        [key])   DB for this JID.  The jid can either be a string,
152                 or a Net::XMPP::JID object.  If you specify a key,
153                 then only the value for that key is returned.
154
155  resource(jid) - return the string representing the resource with the
156                  highest priority for the JID.  The jid can either be
157                  a string, or a Net::XMPP::JID object.
158
159  resourceQuery(jid,      - return a hash representing all of the data
160                resource,   the DB for the resource for this JID.  The
161                [key])      jid can either be a string, or a
162                            Net::XMPP::JID object.  If you specify a
163                            key, then only the value for that key is
164                            returned.
165
166  resources(jid) - returns the list of resources for the JID in order
167                   of highest priority to lowest priority.  The jid can
168                   either be a string, or a Net::XMPP::JID object.
169
170  resourceStore(jid,      - store the specified value in the DB under
171                resource,   the specified key for the resource for this
172                key,        JID.  The jid can either be a string, or a
173                value)      Net::XMPP::JID object.
174
175  store(jid,      - store the specified value in the DB under the
176        key,        specified key for this JID.  The jid can either
177        value)      be a string, or a Net::XMPP::JID object.
178
179
180
181=head2 Advanced Functions
182
183add(jid,                 - Manually adds the JID to the Roster with the
184    ask=>string,           specified roster item settings.  This does not
185    groups=>arrayref       handle subscribing to other users, only
186    name=>string,          manipulating the Roster object.  The jid
187    subscription=>string)  can either be a string or a Net::XMPP::JID.
188
189addResource(jid,            - Manually add the resource to the JID in the
190            resource,         Roster with the specified presence settings.
191            priority=>int,    This does not handle subscribing to other
192            show=>string,     users, only manipulating the Roster object.
193            status=>string)   The jid can either be a string or a
194                              Net::XMPP::JID.
195
196remove(jid) - Removes all reference to the JID from the Roster object.
197              The jid can either be a string or a Net::XMPP::JID.
198
199removeResource(jid,      - Removes the resource from the jid in the
200               resource)   Roster object.  The jid can either be a string
201                           or a Net::XMPP::JID.
202
203handler(packet) - Take either a Net::XMPP::IQ or Net::XMPP::Presence
204                  packet and parse them according to the rules of the
205                  Roster object.  Note, that it will only waste CPU time
206                  if you pass in IQs or Presences that are not roster
207                  related.
208
209=head1 AUTHOR
210
211Ryan Eatmon
212
213=head1 COPYRIGHT
214
215This module is free software; you can redistribute it and/or modify
216it under the same terms as Perl itself.
217
218=cut
219
220use strict;
221use Carp;
222
223sub new
224{
225    my $proto = shift;
226    my $self = { };
227
228    my %args;
229    while($#_ >= 0) { $args{ lc(pop(@_)) } = pop(@_); }
230
231    if (!exists($args{connection}) ||
232        !$args{connection}->isa("Net::XMPP::Connection"))
233    {
234        croak("You must pass Net::XMPP::Roster a valid connection object.");
235    }
236
237    $self->{CONNECTION} = $args{connection};
238   
239    bless($self, $proto);
240
241    $self->init();
242   
243    return $self;
244}
245
246
247##############################################################################
248#
249# init - initialize the module to use the roster database
250#
251##############################################################################
252sub init
253{
254    my $self = shift;
255
256    $self->{CONNECTION}-> SetXPathCallBacks('/iq[@type="result" or @type="set"]/query[@xmlns="jabber:iq:roster"]'=>sub{ $self->handler(@_) });
257    $self->{CONNECTION}-> SetXPathCallBacks('/presence'=>sub{ $self->handler(@_) });
258}
259
260
261##############################################################################
262#
263# add - adds the entry to the Roster DB.
264#
265##############################################################################
266sub add
267{
268    my $self = shift;
269    my ($jid,%item) = @_;
270
271    $jid = $jid->GetJID() if UNIVERSAL::isa($jid,"Net::XMPP::JID");
272    if (exists $self->{JIDS}->{$jid})
273    {
274        foreach my $key (keys %item)
275        {
276            $self->{JIDS}->{$jid}->{$key} = $item{$key};
277        }
278    }
279    else
280    {
281        $self->{JIDS}->{$jid} = \%item;
282    }
283
284    foreach my $group (keys %{ $self->{GROUPS} })
285    {
286        # Clear user from old groups.
287        delete $self->{GROUPS}->{$group}->{$jid};
288        # Clean up empty groups.
289        delete $self->{GROUPS}->{$group} unless scalar keys %{ $self->{GROUPS}->{$group} };
290    }
291
292    foreach my $group (@{$item{groups}})
293    {
294        $self->{GROUPS}->{$group}->{$jid} = 1;
295    }
296}
297
298
299
300##############################################################################
301#
302# addResource - adds the resource to the JID in the Roster DB.
303#
304##############################################################################
305sub addResource
306{
307    my $self = shift;
308    my $jid = shift;
309    my $resource = shift;
310    my (%item) = @_;
311
312    $jid = $jid->GetJID() if UNIVERSAL::isa($jid,"Net::XMPP::JID");
313
314    my $priority = $item{priority};
315    $priority = 0 unless defined($priority);
316
317    $self->{CONNECTION}->{DEBUG}->Log3("Roster::addResource: add $jid/$resource with priority $priority to the DB");
318
319    my $loc = -1;
320    $self->{JIDS}->{$jid}->{priorities}->{$priority} = []
321        unless exists($self->{JIDS}->{$jid}->{priorities}->{$priority});
322    foreach my $index (0..$#{$self->{JIDS}->{$jid}->{priorities}->{$priority}})
323    {
324        $loc = $index
325            if ($self->{JIDS}->{$jid}->{priorities}->{$priority}->[$index]->{resource} eq $resource);
326    }
327    $loc = $#{$self->{JIDS}->{$jid}->{priorities}->{$priority}} + 1 if ($loc == -1);
328
329    $self->{JIDS}->{$jid}->{resources}->{$resource}->{priority} = $priority;
330    $self->{JIDS}->{$jid}->{resources}->{$resource}->{status} = $item{status}
331        if exists($item{status});
332    $self->{JIDS}->{$jid}->{resources}->{$resource}->{show} = $item{show}
333        if exists($item{show});
334    $self->{JIDS}->{$jid}->{priorities}->{$priority}->[$loc]->{resource} = $resource;
335}
336
337
338###############################################################################
339#
340# clear - delete all of the JIDs from the DB completely.
341#
342###############################################################################
343sub clear
344{
345    my $self = shift;
346
347    $self->{CONNECTION}->{DEBUG}->Log3("Roster::clear: clearing the database");
348    foreach my $jid ($self->jids())
349    {
350        $self->remove($jid);
351    }
352    $self->{CONNECTION}->{DEBUG}->Log3("Roster::clear: database is empty");
353}
354
355
356##############################################################################
357#
358# exists - allows you to query if the JID exists in the Roster DB.
359#
360##############################################################################
361sub exists
362{
363    my $self = shift;
364    my ($jid) = @_;
365
366    $jid = $jid->GetJID() if UNIVERSAL::isa($jid,"Net::XMPP::JID");
367   
368    return unless exists($self->{JIDS});
369    return unless exists($self->{JIDS}->{$jid});
370    return 1;
371}
372
373
374sub fetch
375{
376    my $self = shift;
377
378    my %newroster = $self->{CONNECTION}->RosterGet();
379
380    $self->handleRoster(\%newroster);
381}
382
383
384##############################################################################
385#
386# groupExists - allows you to query if the group exists in the Roster
387#                       DB.
388#
389##############################################################################
390sub groupExists
391{
392    my $self = shift;
393    my ($group) = @_;
394
395    return unless exists($self->{GROUPS});
396    return unless exists($self->{GROUPS}->{$group});
397    return 1;
398}
399
400
401##############################################################################
402#
403# groups - returns a list of the current groups in your roster.
404#
405##############################################################################
406sub groups
407{
408    my $self = shift;
409
410    return () unless exists($self->{GROUPS});
411    return () if (scalar(keys(%{$self->{GROUPS}})) == 0);
412    return keys(%{$self->{GROUPS}});
413}
414
415
416##############################################################################
417#
418# handler - takes a packet and calls the correct handler.
419#
420##############################################################################
421sub handler
422{
423    my $self = shift;
424    my $sid = shift;
425    my $packet = shift;
426
427    $self->handleIQ($packet) if ($packet->GetTag() eq "iq");
428    $self->handlePresence($packet) if ($packet->GetTag() eq "presence");
429}
430
431
432##############################################################################
433#
434# handleIQ - takes an iq packet that contains roster, parses it, and puts
435#            the roster into the Roster DB.
436#
437##############################################################################
438sub handleIQ
439{
440    my $self = shift;
441    my $iq = shift;
442
443    my $type = $iq->GetType();
444    return unless (($type eq "set") || ($type eq "result"));
445
446    my %newroster = $self->{CONNECTION}->RosterParse($iq);
447
448    $self->handleRoster(\%newroster);
449}
450
451
452sub handleRoster
453{
454    my $self = shift;
455    my $roster = shift;
456
457    foreach my $jid (keys(%{$roster}))
458    {
459        if ($roster->{$jid}->{subscription} ne "remove")
460        {
461            $self->add($jid, %{$roster->{$jid}});
462        }
463        else
464        {
465            $self->remove($jid);
466        }
467    }
468}
469
470
471##############################################################################
472#
473# handlePresence - takes a presence packet and groks the presence.
474#
475##############################################################################
476sub handlePresence
477{
478    my $self = shift;
479    my $presence = shift;
480
481    my $type = $presence->GetType();
482    $type = "" unless defined($type);
483    return unless (($type eq "") ||
484                   ($type eq "available") ||
485                   ($type eq "unavailable"));
486
487    my $jid = $presence->GetFrom("jid");
488
489    my $resource = $jid->GetResource();
490    $resource = " " unless ($resource ne "");
491   
492    $jid = $jid->GetJID();
493    $jid = "" unless defined($jid);
494
495    return unless $self->exists($jid);
496    #XXX if it doesn't exist... is it us?
497    #XXX is this a presence based roster?
498
499    $self->{CONNECTION}->{DEBUG}->Log3("Roster::PresenceDBParse: fromJID(",$presence->GetFrom(),") resource($resource) type($type)");
500    $self->{CONNECTION}->{DEBUG}->Log4("Roster::PresenceDBParse: xml(",$presence->GetXML(),")");
501
502    $self->removeResource($jid,$resource);
503
504    if (($type eq "") || ($type eq "available"))
505    {
506        my %item;
507       
508        $item{priority} = $presence->GetPriority();
509        $item{priority} = 0 unless defined($item{priority});
510
511        $item{show} = $presence->GetShow();
512        $item{show} = "" unless defined($item{show});
513
514        $item{status} = $presence->GetStatus();
515        $item{status} = "" unless defined($item{status});
516
517        $self->addResource($jid,$resource,%item);
518    }
519}
520
521
522##############################################################################
523#
524# jids - returns a list of all of the JIDs in your roster.
525#
526##############################################################################
527sub jids
528{
529    my $self = shift;
530    my $type = shift;
531    my $group = shift;
532
533    $type = "all" unless defined($type);
534
535    my @jids;
536
537    if (($type eq "all") || ($type eq "nogroup"))
538    {
539        return () unless exists($self->{JIDS});
540        foreach my $jid (keys(%{$self->{JIDS}}))
541        {
542            next if (($type eq "nogroup") &&
543                     exists($self->{JIDS}->{$jid}->{groups}) &&
544                     ($#{$self->{JIDS}->{$jid}->{groups}} > -1));
545
546            push(@jids, Net::XMPP::JID->new($jid));
547        }
548    }
549   
550    if ($type eq "group")
551    {
552        return () unless exists($self->{GROUPS});
553        if (defined($group) && $self->groupExists($group))
554        {
555            foreach my $jid (keys(%{$self->{GROUPS}->{$group}}))
556            {
557                push(@jids, Net::XMPP::JID->new($jid));
558            }
559        }
560    }
561
562    return @jids;
563}
564
565
566###############################################################################
567#
568# online - returns if the jid is online or not.
569#
570###############################################################################
571sub online
572{
573    my $self = shift;
574    my $jid = shift;
575
576    $jid = $jid->GetJID() if UNIVERSAL::isa($jid,"Net::XMPP::JID");
577
578    return unless $self->exists($jid);
579
580    my @resources = $self->resources($jid);
581
582    return ($#resources > -1);
583}
584
585
586##############################################################################
587#
588# priority - return the highest priority for the jid, or for the specified
589#            resource.
590#
591##############################################################################
592sub priority
593{
594    my $self = shift;
595    my $jid = shift;
596    my $resource = shift;
597
598    $jid = $jid->GetJID() if UNIVERSAL::isa($jid,"Net::XMPP::JID");
599   
600    if (defined($resource))
601    {
602        return unless $self->resourceExists($jid,$resource);
603        return unless exists($self->{JIDS}->{$jid}->{resources}->{$resource}->{priority});
604        return $self->{JIDS}->{$jid}->{resources}->{$resource}->{priority};
605    }
606   
607    return unless exists($self->{JIDS}->{$jid}->{priorities});
608    my @priorities = sort{ $b <=> $a } keys(%{$self->{JIDS}->{$jid}->{priorities}});
609    return $priorities[0];
610}
611
612
613##############################################################################
614#
615# query - allows you to get one of the pieces of info from the Roster DB.
616#
617##############################################################################
618sub query
619{
620    my $self = shift;
621    my $jid = shift;
622    my $key = shift;
623
624    $jid = $jid->GetJID() if UNIVERSAL::isa($jid,"Net::XMPP::JID");
625   
626    return unless $self->exists($jid);
627    if (defined($key))
628    {
629        return unless exists($self->{JIDS}->{$jid}->{$key});
630        return $self->{JIDS}->{$jid}->{$key};
631    }
632    return %{$self->{JIDS}->{$jid}};
633}
634
635
636##############################################################################
637#
638# remove - removes the JID from the Roster DB.
639#
640##############################################################################
641sub remove
642{
643    my $self = shift;
644    my $jid = shift;
645
646    $jid = $jid->GetJID() if UNIVERSAL::isa($jid,"Net::XMPP::JID");
647
648    if ($self->exists($jid))
649    {
650        $self->{CONNECTION}->{DEBUG}->Log3("Roster::remove: deleting $jid from the DB");
651       
652        if (defined($self->query($jid,"groups")))
653        {
654            foreach my $group (@{$self->query($jid,"groups")})
655            {
656                delete($self->{GROUPS}->{$group}->{$jid});
657                delete($self->{GROUPS}->{$group})
658                    if (scalar(keys(%{$self->{GROUPS}->{$group}})) == 0);
659                delete($self->{GROUPS})
660                    if (scalar(keys(%{$self->{GROUPS}})) == 0);
661            }
662        }
663   
664        delete($self->{JIDS}->{$jid});
665        delete($self->{JIDS}) if (scalar(keys(%{$self->{JIDS}})) == 0);
666    }
667}
668
669
670##############################################################################
671#
672# removeResource - removes the resource from the JID from the Roster DB.
673#
674##############################################################################
675sub removeResource
676{
677    my $self = shift;
678    my $jid = shift;
679    my $resource = shift;
680
681    $jid = $jid->GetJID() if UNIVERSAL::isa($jid,"Net::XMPP::JID");
682
683    if ($self->resourceExists($jid,$resource))
684    {
685        $self->{CONNECTION}->{DEBUG}->Log3("Roster::removeResource: remove $jid/$resource from the DB");
686
687        my $oldPriority = $self->priority($jid,$resource);
688        $oldPriority = "" unless defined($oldPriority);
689
690        if (exists($self->{JIDS}->{$jid}->{priorities}->{$oldPriority}))
691        {
692            my $loc = 0;
693            foreach my $index (0..$#{$self->{JIDS}->{$jid}->{priorities}->{$oldPriority}})
694            {
695                $loc = $index
696                    if ($self->{JIDS}->{$jid}->{priorities}->{$oldPriority}->[$index]->{resource} eq $resource);
697            }
698           
699            splice(@{$self->{JIDS}->{$jid}->{priorities}->{$oldPriority}},$loc,1);
700
701            delete($self->{JIDS}->{$jid}->{priorities}->{$oldPriority})
702                if (exists($self->{JIDS}->{$jid}->{priorities}->{$oldPriority}) &&
703                    ($#{$self->{JIDS}->{$jid}->{priorities}->{$oldPriority}} == -1));
704        }
705
706        delete($self->{JIDS}->{$jid}->{resources}->{$resource});
707
708    }
709}
710
711
712###############################################################################
713#
714# resource - retrieve the resource with the highest priority.
715#
716###############################################################################
717sub resource
718{
719    my $self = shift;
720    my $jid = shift;
721
722    $jid = $jid->GetJID() if UNIVERSAL::isa($jid,"Net::XMPP::JID");
723
724    return unless $self->exists($jid);
725
726    my $priority = $self->priority($jid);
727
728    return unless defined($priority);
729
730    return $self->{JIDS}->{$jid}->{priorities}->{$priority}->[0]->{resource};
731}
732
733
734##############################################################################
735#
736# resourceExists - check that the specified resource exists.
737#
738##############################################################################
739sub resourceExists
740{
741    my $self = shift;
742    my $jid = shift;
743    my $resource = shift;
744   
745    $jid = $jid->GetJID() if UNIVERSAL::isa($jid,"Net::XMPP::JID");
746
747    return unless $self->exists($jid);
748    return unless exists($self->{JIDS}->{$jid}->{resources});
749    return unless exists($self->{JIDS}->{$jid}->{resources}->{$resource});
750}
751
752
753##############################################################################
754#
755# resourceQuery - allows you to get one of the pieces of info from the Roster
756#                 DB.
757#
758##############################################################################
759sub resourceQuery
760{
761    my $self = shift;
762    my $jid = shift;
763    my $resource = shift;
764    my $key = shift;
765
766    $jid = $jid->GetJID() if UNIVERSAL::isa($jid,"Net::XMPP::JID");
767   
768    return unless $self->resourceExists($jid,$resource);
769    if (defined($key))
770    {
771        return unless exists($self->{JIDS}->{$jid}->{resources}->{$resource}->{$key});
772        return $self->{JIDS}->{$jid}->{resources}->{$resource}->{$key};
773    }
774    return %{$self->{JIDS}->{$jid}->{resources}->{$resource};}
775}
776
777
778###############################################################################
779#
780# resources - returns a list of the resources from highest priority to lowest.
781#
782###############################################################################
783sub resources
784{
785    my $self = shift;
786    my $jid = shift;
787
788    $jid = $jid->GetJID() if UNIVERSAL::isa($jid,"Net::XMPP::JID");
789
790    return () unless $self->exists($jid);
791
792    my @resources;
793
794    foreach my $priority (sort {$b cmp $a} keys(%{$self->{JIDS}->{$jid}->{priorities}}))
795    {
796        foreach my $index (0..$#{$self->{JIDS}->{$jid}->{priorities}->{$priority}})
797        {
798            next if ($self->{JIDS}->{$jid}->{priorities}->{$priority}->[$index]->{resource} eq " ");
799            push(@resources,$self->{JIDS}->{$jid}->{priorities}->{$priority}->[$index]->{resource});
800        }
801    }
802    return @resources;
803}
804
805
806##############################################################################
807#
808# resourceStore - allows you to store anything on the item that you want to.
809#                 The only drawback is that when the item is removed, the data
810#                 is not kept.  You must restore it in the DB.
811#
812##############################################################################
813sub resourceStore
814{
815    my $self = shift;
816    my $jid = shift;
817    my $resource = shift;
818    my $key = shift;
819    my $value = shift;
820
821    $jid = $jid->GetJID() if UNIVERSAL::isa($jid,"Net::XMPP::JID");
822
823    return unless defined($key);
824    return unless defined($value);
825    return unless $self->resourceExists($jid,$resource);
826
827    $self->{JIDS}->{$jid}->{resources}->{$resource}->{$key} = $value;
828}
829
830
831##############################################################################
832#
833# store - allows you to store anything on the item that you want to.  The
834#         only drawback is that when the item is removed, the data is not
835#         kept.  You must restore it in the DB.
836#
837##############################################################################
838sub store
839{
840    my $self = shift;
841    my $jid = shift;
842    my $key = shift;
843    my $value = shift;
844
845    $jid = $jid->GetJID() if UNIVERSAL::isa($jid,"Net::XMPP::JID");
846
847    return unless defined($key);
848    return unless defined($value);
849    return unless $self->exists($jid);
850
851    $self->{JIDS}->{$jid}->{$key} = $value;
852}
853
854
8551;
856
Note: See TracBrowser for help on using the repository browser.