XMPP2/IM/Presence.pm

package Net::XMPP2::IM::Presence;
use strict;
use Net::XMPP2::Util;
use Net::XMPP2::IM::Message;

=head1 NAME

Net::XMPP2::IM::Presence - XMPP presence

=head1 SYNOPSIS

=head1 DESCRIPTION

This module represents an XMPP presence. It stores
the full JID of the contact, the show value, status value
and priority.

=head1 METHODS

=over 4

=cut

sub new {
   my $this = shift;
   my $class = ref($this) || $this;
   bless { @_ }, $class;
}

sub clone {
   my ($self) = @_;
   my $p = $self->new (connection => $self->{connection});
   $p->{$_} = $self->{$_} for qw/show jid priority status/;
   $p
}

sub update {
   my ($self, $node) = @_;

   my $type       = $node->attr ('type');
   my ($show)     = $node->find_all ([qw/client show/]);
   my ($priority) = $node->find_all ([qw/client priority/]);

   my %stati;
   $stati{$_->attr ('lang') || ''} = $_->text
      for $node->find_all ([qw/client status/]);

   my $old = $self->clone;

   $self->{show}     = $show     ? $show->text     : undef;
   $self->{priority} = $priority ? $priority->text : undef;
   $self->{status}   = \%stati;
   $self->{type}     = $type;

   $old
}

=item B<jid>

Returns the full JID of this presence.

=cut

sub jid { $_[0]->{jid} }

=item B<priority>

Returns the priority of this presence.

=cut

sub priority { $_[0]->{priority} }

=item B<status_all_lang>

Returns all language tags of available status descriptions.
See also L<status>.

=cut

sub status_all_lang {
   my ($self, $jid) = @_;
   keys %{$self->{status} || []}
}

=item B<show>

Returns the show value of this presence, which is one of:

   'away', 'chat', 'dnd', 'xa'

or the empty string if the presence is 'available'.

=cut

sub show { $_[0]->{show} }

=item B<status ([$lang])>

Returns the presence description. C<$lang> is optional can should be one of
the tags returned by C<status_all_lang>.

=cut

sub status {
   my ($self, $lang) = @_;

   if (defined $lang) {
      return $self->{status}->{$lang}
   } else {
      return $self->{status}->{''}
         if defined $self->{status}->{''};
      return $self->{status}->{en}
         if defined $self->{status}->{en};
   }

   undef
}

=item B<make_message>

Returns a L<Net::XMPP2::IM::Message> object with the to field set to
this presence full JID.

=cut

sub make_message {
   my ($self) = @_;
   Net::XMPP2::IM::Message->new (
      connection => $self->{connection},
      to         => $self->jid
   );
}

sub debug_dump {
   my ($self) = @_;
   printf "   * %-30s [%-5s] (%3d)          {%s}\n",
      $self->jid,
      $self->show     || '',
      $self->priority || 0,
      $self->status   || '',
}

=back

=head1 AUTHOR

Robin Redeker, C<< <elmex at ta-sa.org> >>, JID: C<< <elmex at jabber.org> >>

=head1 COPYRIGHT & LICENSE

Copyright 2007 Robin Redeker, 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;
Revision:	1.6
Committed:	Thu Jul 5 20:26:00 2007 UTC (19 years, 4 months ago) by elmex
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.5:	+1 -1 lines
Log Message:	fixed some more typos
#	User	Rev	Content
1	elmex	1.1	package Net::XMPP2::IM::Presence;
2			use strict;
3			use Net::XMPP2::Util;
4			use Net::XMPP2::IM::Message;
5
6	elmex	1.4	=head1 NAME
7
8	elmex	1.5	Net::XMPP2::IM::Presence - XMPP presence
9	elmex	1.4
10			=head1 SYNOPSIS
11
12			=head1 DESCRIPTION
13
14	elmex	1.6	This module represents an XMPP presence. It stores
15	elmex	1.4	the full JID of the contact, the show value, status value
16			and priority.
17
18			=head1 METHODS
19
20			=over 4
21
22			=cut
23
24	elmex	1.1	sub new {
25			my $this = shift;
26			my $class = ref($this) \|\| $this;
27			bless { @_ }, $class;
28			}
29
30	elmex	1.2	sub clone {
31			my ($self) = @_;
32			my $p = $self->new (connection => $self->{connection});
33	elmex	1.3	$p->{$_} = $self->{$_} for qw/show jid priority status/;
34	elmex	1.2	$p
35			}
36
37	elmex	1.3	sub update {
38			my ($self, $node) = @_;
39
40			my $type = $node->attr ('type');
41			my ($show) = $node->find_all ([qw/client show/]);
42			my ($priority) = $node->find_all ([qw/client priority/]);
43
44			my %stati;
45			$stati{$_->attr ('lang') \|\| ''} = $_->text
46			for $node->find_all ([qw/client status/]);
47
48			my $old = $self->clone;
49
50			$self->{show} = $show ? $show->text : undef;
51			$self->{priority} = $priority ? $priority->text : undef;
52			$self->{status} = \%stati;
53			$self->{type} = $type;
54
55			$old
56	elmex	1.1	}
57
58	elmex	1.4	=item B<jid>
59
60			Returns the full JID of this presence.
61
62			=cut
63
64	elmex	1.1	sub jid { $_[0]->{jid} }
65
66	elmex	1.4	=item B<priority>
67
68			Returns the priority of this presence.
69
70			=cut
71
72	elmex	1.1	sub priority { $_[0]->{priority} }
73
74	elmex	1.4	=item B<status_all_lang>
75
76			Returns all language tags of available status descriptions.
77			See also L<status>.
78
79			=cut
80
81	elmex	1.1	sub status_all_lang {
82			my ($self, $jid) = @_;
83			keys %{$self->{status} \|\| []}
84			}
85
86	elmex	1.4	=item B<show>
87
88			Returns the show value of this presence, which is one of:
89
90			'away', 'chat', 'dnd', 'xa'
91
92			or the empty string if the presence is 'available'.
93
94			=cut
95
96	elmex	1.1	sub show { $_[0]->{show} }
97
98	elmex	1.4	=item B<status ([$lang])>
99
100			Returns the presence description. C<$lang> is optional can should be one of
101			the tags returned by C<status_all_lang>.
102
103			=cut
104
105	elmex	1.1	sub status {
106			my ($self, $lang) = @_;
107
108			if (defined $lang) {
109			return $self->{status}->{$lang}
110			} else {
111			return $self->{status}->{''}
112			if defined $self->{status}->{''};
113			return $self->{status}->{en}
114			if defined $self->{status}->{en};
115			}
116
117			undef
118			}
119
120	elmex	1.4	=item B<make_message>
121
122			Returns a L<Net::XMPP2::IM::Message> object with the to field set to
123			this presence full JID.
124
125			=cut
126
127	elmex	1.1	sub make_message {
128			my ($self) = @_;
129			Net::XMPP2::IM::Message->new (
130			connection => $self->{connection},
131			to => $self->jid
132			);
133			}
134
135			sub debug_dump {
136			my ($self) = @_;
137			printf " * %-30s [%-5s] (%3d) {%s}\n",
138			$self->jid,
139			$self->show \|\| '',
140			$self->priority \|\| 0,
141			$self->status \|\| '',
142			}
143
144	elmex	1.4	=back
145
146			=head1 AUTHOR
147
148			Robin Redeker, C<< <elmex at ta-sa.org> >>, JID: C<< <elmex at jabber.org> >>
149
150			=head1 COPYRIGHT & LICENSE
151
152			Copyright 2007 Robin Redeker, all rights reserved.
153
154			This program is free software; you can redistribute it and/or modify it
155			under the same terms as Perl itself.
156
157			=cut
158
159	elmex	1.1	1;