perl/lib/Thrasher/Roster.pm

   1 package Thrasher::Roster;
   2 use strict;
   3 use warnings;
   4
   5 =pod
   6
   7 =head1 NAME
   8
   9 Thrasher::Roster - code for dealing with the roster
  10
  11 =head1 DESCRIPTION
  12
  13 Gateways need to recall the previous state of the rosters, in order
  14 to tell upon the next connection whether the user has added people
  15 to their roster or removed them by means other than the gateway.
  16 Ideally, we'd cheat and extract the roster directly from the user,
  17 but we can't do that with a standard XEP, so we have to track it
  18 separately.
  19
  20 Rosters are represented in Thrasher as simple hashes. The keys
  21 are the legacy names on the roster, and the values are the state
  22 of the user on the roster, using the constants
  23 Thrasher::Roster::subscribed, Thrasher::Roster::unsubscribed,
  24 and Thrasher::Roster::want_subscribe (that is, the legacy user wants
  25 to subscribe to the gateway user). These are subs that return
  26 numbers representing those states. However, legacy users who
  27 are unsubscribed should not come back as having the value
  28 "unsubscribed", but with no entry in the roster at all. (API
  29 users can use "unsubscribed" to indicate that a user is being
  30 unsubscribed.)
  31
  32 In addition, this module provides a "diff" function that takes
  33 two rosters, and describes the differences between them, in the
  34 form of a hash reference that gives the before and after states.
  35 Components can use this to determine what additional presence tags
  36 need to be sent out to bring the user's roster up-to-date.
  37
  38 =cut
  39
  40 use base 'Exporter';
  41 our @EXPORT_OK = qw(subscribed unsubscribed want_subscribe roster_diff);
  42 our %EXPORT_TAGS = (all => \@EXPORT_OK,
  43                     constants => [qw(subscribed unsubscribed want_subscribe)]);
  44
  45 sub subscribed { 1 }
  46 sub unsubscribed { 2 }
  47 sub want_subscribe { 3 }
  48
  49 # Returns a hash containing the changes, where the key is the legacy
  50 # name and the value is an array ref containing [old, new], where
  51 # these are each one of 'subscribed', 'unsubscribed', or 'want_subscribe'.
  52 sub roster_diff {
  53     my $roster1 = shift;
  54     my $roster2 = shift;
  55
  56     my $result = {};
  57
  58     while (my ($legacy_user, $value) = each %$roster1) {
  59         my $other_value = $roster2->{$legacy_user} || unsubscribed;
  60
  61         if ($value != $other_value) {
  62             $result->{$legacy_user} = [$value, $other_value];
  63         }
  64     }
  65
  66     while (my ($legacy_user, $value) = each %$roster2) {
  67         if (!exists($result->{$legacy_user})) {
  68             my $other_value = $roster1->{$legacy_user} || unsubscribed;
  69
  70             if ($value != $other_value) {
  71                 $result->{$legacy_user} = [$other_value, $value];
  72             }
  73         }
  74     }
  75
  76     return $result;
  77 }
  78
  79 1;