1package DJabberd::Subscription;
2use strict;
3use Carp qw(croak);
4use DJabberd::Util qw(exml);
5use overload
6    '""' => \&as_string;
7
8use fields (
9            'to',        # all bools
10            'from',
11            'pendin',
12            'pendout',
13            );
14
15# The nine valid subscription states from the spec:
16#                         TO  FROM  PIN  POUT
17#   None                  -   -     -    -
18#   None+PendOut          -   -     -    X
19#   None+PendIn           -   -     X    -
20#   None+PendIn+PendOut   -   -     X    X
21#   To                    X   -     -    -
22#   To+PendIn             X   -     X    -
23#   From                  -   X     -    -
24#   From+PendOut          -   X     -    X
25#   Both                  X   X     -    -
26
27# Invalid conditions:
28#    TO && PendOut
29#    From && PendIn
30
31
32sub new {
33    my $self = shift;
34    $self = fields::new($self) unless ref $self;
35    return $self;
36}
37
38sub none {
39    my $class = shift;
40    return $class->new;
41}
42
43sub new_from_name {
44    my ($class, $name) = @_;
45    my $sb = {
46        'none' => sub { $class->none },
47        # ...
48    }->{$name};
49    croak "Unknown subscription state name '$name'" unless $sb;
50    return $sb->();
51}
52
53sub is_none_pending_in {
54    my $self = shift;
55    return $self->{pendin} &&
56        ! $self->{pendout} &&
57        ! $self->{to} &&
58        ! $self->{from};
59}
60
61sub pending_out {
62    my $self = shift;
63    return $self->{pendout};
64}
65
66sub pending_in {
67    my $self = shift;
68    return $self->{pendin};
69}
70
71sub sub_from {
72    my $self = shift;
73    return $self->{from};
74}
75
76sub sub_to {
77    my $self = shift;
78    return $self->{to};
79}
80
81sub set_from {
82    my ($self, $val) = @_;
83    $val = 1 unless defined $val;
84    $self->{from} = $val;
85    return $self;
86}
87
88sub set_to {
89    my ($self, $val) = @_;
90    $val = 1 unless defined $val;
91    $self->{to} = $val;
92    return $self;
93}
94
95sub set_pending_out {
96    my ($self, $val) = @_;
97    $val = 1 unless defined $val;
98    $self->{pendout} = $val;
99    return $self;
100}
101
102sub set_pending_in {
103    my ($self, $val) = @_;
104    $val = 1 unless defined $val;
105    $self->{pendin} = $val;
106    return $self;
107}
108
109sub got_inbound_subscribed {
110    my $self = shift;
111    $self->{to}      = 1;
112    $self->{pendout} = 0;
113}
114
115sub got_outbound_unsubscribe {
116    my $self = shift;
117    $self->{to}      = 0;
118    $self->{pendout} = 0;
119}
120
121sub got_outbound_unsubscribed {
122    my $self = shift;
123    $self->{pendin}  = 0;
124    $self->{from}    = 0;
125}
126
127sub got_inbound_unsubscribe {
128    my $self = shift;
129    $self->{from}    = 0;
130    $self->{pendin}  = 0;
131}
132
133sub got_outbound_subscribed {
134    my $self = shift;
135    $self->{from}    = 1;
136    $self->{pendin}  = 0;
137}
138
139# returns 1 if any action was taken, 0 if it was no-op
140sub got_outbound_subscribe {
141    my $self = shift;
142    # the no-op case
143    return 0 if $self->{to} && ! $self->{pendout};
144
145    # for some reason, user's pendout bit is set even though
146    # it shouldn't be.  fix up.
147    if ($self->{to} && $self->{pendout}) {
148        $self->{pendout} = 0;
149        return 1;
150    }
151
152    $self->{pendout} = 1;
153    return 1;
154}
155
156sub as_bitmask {
157    my $self = shift;
158    my $ret = 0;
159    $ret = $ret | 1   if $self->{to};
160    $ret = $ret | 2   if $self->{from};
161    $ret = $ret | 4   if $self->{pendin};
162    $ret = $ret | 8   if $self->{pendout};
163    return $ret;
164}
165
166sub from_bitmask {
167    my ($class, $mask) = @_;
168    $mask += 0;  # force to numeric context
169    my $new = $class->new;
170    $new->{to}      = 1 if $mask & 1;
171    $new->{from}    = 1 if $mask & 2;
172    $new->{pendin}  = 1 if $mask & 4;
173    $new->{pendout} = 1 if $mask & 8;
174    return $new;
175}
176
177sub as_string {
178    my $self = shift;
179    my @fields = grep { $self->{$_} } qw(to from pendin pendout);
180    return "[@fields]";
181}
182
183sub as_attributes {
184    my $self = shift;
185    my $state;
186    if ($self->{to} && $self->{from}) {
187        $state = "both";
188    } elsif ($self->{to}) {
189        $state = "to";
190    } elsif ($self->{from}) {
191        $state = "from";
192    } else {
193        $state = "none";
194    }
195
196    my $ret = "subscription='$state'";
197    if ($self->{pendout}) {
198        $ret .= " ask='subscribe'";
199    }
200    return $ret;
201}
202
2031;
204
205
206
207