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 a 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.5
Committed:	Thu Jul 5 19:27:35 2007 UTC (19 years, 4 months ago) by elmex
Branch:	MAIN
Changes since 1.4:	+1 -1 lines
Log Message:	fixed some typos and such
#	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			This module represents a XMPP presence. It stores
15			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;