XMPP2/IM/Message.pm

package Net::XMPP2::IM::Message;
use strict;
use overload
  '""' => "to_string";

=head1 NAME

Net::XMPP2::IM::Message - An instant message

=head1 SYNOPSIS

   use Net::XMPP2::IM::Message;

   my $con = Net::XMPP2::IM::Connection->new (...);

   Net::XMPP2::IM::Message->new (
      body => "Hello there!",
      to   => "elmex@jabber.org"
   )->send ($con);

=head1 DESCRIPTION

This module represents an instant message. It's mostly
a shortlived object and acts as wrapper object around the
XML stuff that is happening under the hood.

A L<Net::XMPP2::IM::Message> object overloads the stringification
operation. The string represenation of this object is the return
value of the C<any_body> method.

=cut

=head1 METHODS

=head2 new (%args)

This method creates a new instance of a L<Net::XMPP2::IM::Message>.

C<%args> is the argument hash. All arguments to C<new> are optional.

These are the possible keys:

=over 4

=item connection => $connection

This is the L<Net::XMPP2::IM::Connection> object that will
be used to send this message when the C<send> method is called.

=item to => $jid

This is the destination JID of this message. C<$jid> should
be a bare JID when the message is sent out of a conversation 'context'.
C<$jid> should be full if this message is send within a conversation
'context', for example when replying to a previous message.

Replies can also be generated by the C<make_reply> method, see also
the C<from> argument below.

=item from => $jid

This is the source JID of this message, it's mainly
used by the C<make_reply> method.

=item lang => $lang

This is the default language that will be used to tag the values
passed in the C<body> and C<subject> argument to C<new>.

=item body => $body

This is the text C<$body> of the message either with the language
tag from the C<lang> attached or without any language tag.

If you want to attach multiple bodies with different languages use the C<add_body>
method.

=item subject => $subject

This is the C<$subject> of the message either with the language
tag from the C<lang> attached or without any language tag.

If you want to attach the subject with a different language use the C<add_subject>
method.

=back

=cut

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

   if (my $sub = delete $self->{subject}) {
      $self->add_subject ($sub);
   }
   if (my $body = delete $self->{body}) {
      $self->add_body ($body);
   }

   $self->{lang} ||= '';

   $self
}

sub to_string {
   my ($self) = @_;
   $self->any_body
}

=head2 from ([$jid])

This method returns the source JID of this message.
If C<$jid> is not undef it will replace the current
source address.

=cut

sub from {
   my ($self, $from) = @_;
   $self->{from} = $from if defined $from;
   $self->{from}
}

=head2 to ([$jid])

This method returns the destination JID of this message.
If C<$jid> is not undef it will replace the current
destination address.

=cut

sub to {
   my ($self, $to) = @_;
   $self->{to} = $to if defined $to;
   $self->{to}
}

=head2 make_reply ([$msg])

This method returns a new instance of L<Net::XMPP2::IM::Message>.
The destination address, connection and type of the returned message
object will be set.

If C<$msg> is defined and an instance of L<Net::XMPP2::IM::Message>
the destination address, connection and type of C<$msg> will be changed
and this method will not return a new instance of L<Net::XMPP2::IM::Message>.

=cut

sub make_reply {
   my ($self, $msg) = @_;

   unless ($msg) {
      $msg = Net::XMPP2::IM::Message->new ();
   }

   $msg->{connection} = $self->{connection};
   $msg->to ($self->from);
   $msg->type ($self->type);

   $msg
}

=head2 send ([$connection])

This method send this message. If C<$connection>
is defined it will set the connection of this
message object before it is send.

=cut

sub send {
   my ($self, $connection) = @_;

   $self->{connection} = $connection if $connection;

   my @add;
   push @add, (subject => $self->{subjects})
      if %{$self->{subjects} || {}};
   push @add, (thread => $self->thread)
      if $self->thread;

   $self->{connection}->send_message (
      $self->to, $self->type, undef,
      body => $self->{bodies},
      @add
   );
}

=head2 type ([$type])

This method returns the type of the message, which
is either undefined or one of the following values:

   'chat', 'error', 'groupchat', 'headline', 'normal'

If the C<$type> argument is defined it will set the type
of this message.

=cut

sub type {
   my ($self, $type) = @_;
   $self->{type} = $type
      if defined $type;
   $self->{type}
}

=head2 thread ([$thread])

This method returns the thread id of this message,
which might be undefined.

If you want to set the threadid simply pass the C<$thread>
argument.

=cut

sub thread {
   my ($self, $thread) = @_;
   $self->{thread} = $thread
      if defined $thread;
   $self->{thread}
}

=head2 lang ([$lang])

This returns the default language tag of this message,
which can be undefined.

To set the language tag pass the C<$lang> argument, which
should be the new default language tag.

If you do not want to specify any language pass the empty
string as language tag.

=cut

sub lang {
   my ($self, $lang) = @_;
   $self->{lang} = $lang
      if defined $lang;
   $self->{lang}
}

=head2 subject ([$lang])

This method returns the subject of this message.
If the C<$lang> argument is defined a subject of that
language will be returned or undef.
If the C<$lang> argument is undefined this method will
return either the subject in the default language.

=cut

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

   if (defined $lang) {
      return $self->{subjects}->{$lang}
   }

   return $self->{subjects}->{$self->{lang}};

   undef
}

=head2 any_subject ([$lang])

This method will try to find any subject on the message with the
following try order of languagetags:

  1. $lang argument if one passed
  2. default language
  3. subject without any language tag
  4. subject with the 'en' language tag
  5. any subject from any language

=cut

sub any_subject {
   my ($self, $lang) = @_;
   if (defined $lang) {
      return $self->{subjects}->{$lang}
         if defined $self->{subjects}->{$lang};
   }
   return $self->{subjects}->{$self->{lang}}
      if defined $self->{subjects}->{$self->{lang}};
   return $self->{subjects}->{''}
      if defined $self->{subjects}->{''};
   return $self->{subjects}->{en}
      if defined $self->{subjects}->{en};
   return $self->{subjects}->{$_} for (keys %{$self->{subjects}});
   return undef;
}

=head2 add_subject ($subject, [$lang], [$subject2, $lang2, ...])

This method adds the subject C<$subject> with the optional
language tag C<$lang> to this message. If no C<$lang>
argument is passed the default language for this message will be used.

Further subject => lang pairs can passed to this function like this:

   $msg->add_subject ('foobar' => undef, "barfooo" => "de");

=cut

sub add_subject {
   my $self = shift;
   while (@_) {
      my $subj = shift;
      my $lang = shift;
      $self->{subjects}->{$lang || $self->{lang}} = $subj;
   }
   $self
}

=head2 subjects

This method returns a list of key value pairs
with the language tag as key and the subject as value.

The subject which has the empty string as key has no
language attached.

=cut

sub subjects {
   %{$_[0]->{subjects} || {}}
}

=head2 body ([$lang])

This method returns the body of this message.
If the C<$lang> argument is defined a body of that
language will be returned or undef.
If the C<$lang> argument is undefined this method will
return either the body in the default language.

=cut

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

   if (defined $lang) {
      return $self->{bodies}->{$lang}
   } else {
      return $self->{bodies}->{$self->{lang}}
         if defined $self->{bodies}->{$self->{lang}};
   }

   undef
}

=head2 any_body ([$lang])

This method will try to find any body on the message with the
following try order of languagetags:

  1. $lang argument if one passed
  2. default language
  3. body without any language tag
  4. body with the 'en' language tag
  5. any body from any language

=cut

sub any_body {
   my ($self, $lang) = @_;
   if (defined $lang) {
      return $self->{bodies}->{$lang}
         if defined $self->{bodies}->{$lang};
   }
   return $self->{bodies}->{$self->{lang}}
      if defined $self->{bodies}->{$self->{lang}};
   return $self->{bodies}->{''}
      if defined $self->{bodies}->{''};
   return $self->{bodies}->{en}
      if defined $self->{bodies}->{en};
   return $self->{bodies}->{$_} for (keys %{$self->{bodies}});
   return undef;
}

=head2 add_body ($body, [$lang], [$body2, $lang2, ...])

This method adds the body C<$body> with the optional
language tag C<$lang> to this message. If no C<$lang>
argument is passed the default language for this message will be used.

Further body => lang pairs can passed to this function like this:

   $msg->add_body ('foobar' => undef, "barfooo" => "de");

=cut

sub add_body {
   my $self = shift;
   while (@_) {
      my $body = shift;
      my $lang = shift;
      $self->{bodies}->{$lang || $self->{lang}} = $body;
   }
   $self
}

=head2 bodies

This method returns a list of key value pairs
with the language tag as key and the body as value.

The body which has the empty string as key has no
language attached.

=cut

sub bodies {
   %{$_[0]->{bodies} || {}}
}

=head1 AUTHOR

Robin Redeker, C<< <elmex at ta-sa.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; # End of Net::XMPP2
Revision:	1.2
Committed:	Fri Feb 9 20:23:06 2007 UTC (19 years, 7 months ago) by elmex
Branch:	MAIN
Changes since 1.1:	+297 -61 lines
Log Message:	removed unneccessary documentation and added neglected documentation.
#	User	Rev	Content
1	elmex	1.1	package Net::XMPP2::IM::Message;
2			use strict;
3			use overload
4			'""' => "to_string";
5
6			=head1 NAME
7
8			Net::XMPP2::IM::Message - An instant message
9
10			=head1 SYNOPSIS
11
12			use Net::XMPP2::IM::Message;
13
14			my $con = Net::XMPP2::IM::Connection->new (...);
15	elmex	1.2
16			Net::XMPP2::IM::Message->new (
17			body => "Hello there!",
18			to => "elmex@jabber.org"
19			)->send ($con);
20	elmex	1.1
21			=head1 DESCRIPTION
22
23	elmex	1.2	This module represents an instant message. It's mostly
24			a shortlived object and acts as wrapper object around the
25			XML stuff that is happening under the hood.
26
27			A L<Net::XMPP2::IM::Message> object overloads the stringification
28			operation. The string represenation of this object is the return
29			value of the C<any_body> method.
30
31			=cut
32
33			=head1 METHODS
34
35			=head2 new (%args)
36
37			This method creates a new instance of a L<Net::XMPP2::IM::Message>.
38
39			C<%args> is the argument hash. All arguments to C<new> are optional.
40
41			These are the possible keys:
42
43			=over 4
44
45			=item connection => $connection
46
47			This is the L<Net::XMPP2::IM::Connection> object that will
48			be used to send this message when the C<send> method is called.
49
50			=item to => $jid
51
52			This is the destination JID of this message. C<$jid> should
53			be a bare JID when the message is sent out of a conversation 'context'.
54			C<$jid> should be full if this message is send within a conversation
55			'context', for example when replying to a previous message.
56
57			Replies can also be generated by the C<make_reply> method, see also
58			the C<from> argument below.
59
60			=item from => $jid
61
62			This is the source JID of this message, it's mainly
63			used by the C<make_reply> method.
64
65			=item lang => $lang
66
67			This is the default language that will be used to tag the values
68			passed in the C<body> and C<subject> argument to C<new>.
69
70			=item body => $body
71
72			This is the text C<$body> of the message either with the language
73			tag from the C<lang> attached or without any language tag.
74
75			If you want to attach multiple bodies with different languages use the C<add_body>
76			method.
77
78			=item subject => $subject
79
80			This is the C<$subject> of the message either with the language
81			tag from the C<lang> attached or without any language tag.
82
83			If you want to attach the subject with a different language use the C<add_subject>
84			method.
85
86			=back
87	elmex	1.1
88			=cut
89
90			sub new {
91			my $this = shift;
92			my $class = ref($this) \|\| $this;
93	elmex	1.2	my $self = bless { @_ }, $class;
94
95			if (my $sub = delete $self->{subject}) {
96			$self->add_subject ($sub);
97			}
98			if (my $body = delete $self->{body}) {
99			$self->add_body ($body);
100			}
101
102			$self->{lang} \|\|= '';
103
104			$self
105	elmex	1.1	}
106
107			sub to_string {
108			my ($self) = @_;
109	elmex	1.2	$self->any_body
110	elmex	1.1	}
111
112	elmex	1.2	=head2 from ([$jid])
113
114			This method returns the source JID of this message.
115			If C<$jid> is not undef it will replace the current
116			source address.
117
118			=cut
119
120	elmex	1.1	sub from {
121			my ($self, $from) = @_;
122			$self->{from} = $from if defined $from;
123			$self->{from}
124			}
125
126	elmex	1.2	=head2 to ([$jid])
127
128			This method returns the destination JID of this message.
129			If C<$jid> is not undef it will replace the current
130			destination address.
131
132			=cut
133
134	elmex	1.1	sub to {
135			my ($self, $to) = @_;
136			$self->{to} = $to if defined $to;
137			$self->{to}
138			}
139
140	elmex	1.2	=head2 make_reply ([$msg])
141
142			This method returns a new instance of L<Net::XMPP2::IM::Message>.
143			The destination address, connection and type of the returned message
144			object will be set.
145
146			If C<$msg> is defined and an instance of L<Net::XMPP2::IM::Message>
147			the destination address, connection and type of C<$msg> will be changed
148			and this method will not return a new instance of L<Net::XMPP2::IM::Message>.
149
150			=cut
151
152	elmex	1.1	sub make_reply {
153			my ($self, $msg) = @_;
154
155			unless ($msg) {
156			$msg = Net::XMPP2::IM::Message->new ();
157			}
158
159			$msg->{connection} = $self->{connection};
160			$msg->to ($self->from);
161			$msg->type ($self->type);
162
163			$msg
164			}
165
166	elmex	1.2	=head2 send ([$connection])
167	elmex	1.1
168	elmex	1.2	This method send this message. If C<$connection>
169			is defined it will set the connection of this
170			message object before it is send.
171	elmex	1.1
172	elmex	1.2	=cut
173	elmex	1.1
174	elmex	1.2	sub send {
175			my ($self, $connection) = @_;
176	elmex	1.1
177	elmex	1.2	$self->{connection} = $connection if $connection;
178	elmex	1.1
179			my @add;
180			push @add, (subject => $self->{subjects})
181			if %{$self->{subjects} \|\| {}};
182			push @add, (thread => $self->thread)
183			if $self->thread;
184
185			$self->{connection}->send_message (
186			$self->to, $self->type, undef,
187			body => $self->{bodies},
188			@add
189			);
190			}
191
192	elmex	1.2	=head2 type ([$type])
193
194			This method returns the type of the message, which
195			is either undefined or one of the following values:
196
197			'chat', 'error', 'groupchat', 'headline', 'normal'
198
199			If the C<$type> argument is defined it will set the type
200			of this message.
201
202			=cut
203
204	elmex	1.1	sub type {
205			my ($self, $type) = @_;
206			$self->{type} = $type
207			if defined $type;
208			$self->{type}
209			}
210
211	elmex	1.2	=head2 thread ([$thread])
212
213			This method returns the thread id of this message,
214			which might be undefined.
215
216			If you want to set the threadid simply pass the C<$thread>
217			argument.
218
219			=cut
220
221	elmex	1.1	sub thread {
222			my ($self, $thread) = @_;
223			$self->{thread} = $thread
224			if defined $thread;
225			$self->{thread}
226			}
227
228	elmex	1.2	=head2 lang ([$lang])
229
230			This returns the default language tag of this message,
231			which can be undefined.
232
233			To set the language tag pass the C<$lang> argument, which
234			should be the new default language tag.
235
236			If you do not want to specify any language pass the empty
237			string as language tag.
238
239			=cut
240
241			sub lang {
242			my ($self, $lang) = @_;
243			$self->{lang} = $lang
244			if defined $lang;
245			$self->{lang}
246			}
247
248			=head2 subject ([$lang])
249
250			This method returns the subject of this message.
251			If the C<$lang> argument is defined a subject of that
252			language will be returned or undef.
253			If the C<$lang> argument is undefined this method will
254			return either the subject in the default language.
255
256			=cut
257
258	elmex	1.1	sub subject {
259			my ($self, $lang) = @_;
260
261			if (defined $lang) {
262			return $self->{subjects}->{$lang}
263			}
264
265	elmex	1.2	return $self->{subjects}->{$self->{lang}};
266
267	elmex	1.1	undef
268			}
269
270	elmex	1.2	=head2 any_subject ([$lang])
271
272			This method will try to find any subject on the message with the
273			following try order of languagetags:
274
275			1. $lang argument if one passed
276			2. default language
277			3. subject without any language tag
278			4. subject with the 'en' language tag
279			5. any subject from any language
280
281			=cut
282
283			sub any_subject {
284			my ($self, $lang) = @_;
285			if (defined $lang) {
286			return $self->{subjects}->{$lang}
287			if defined $self->{subjects}->{$lang};
288			}
289			return $self->{subjects}->{$self->{lang}}
290			if defined $self->{subjects}->{$self->{lang}};
291			return $self->{subjects}->{''}
292			if defined $self->{subjects}->{''};
293			return $self->{subjects}->{en}
294			if defined $self->{subjects}->{en};
295			return $self->{subjects}->{$_} for (keys %{$self->{subjects}});
296			return undef;
297			}
298
299			=head2 add_subject ($subject, [$lang], [$subject2, $lang2, ...])
300
301			This method adds the subject C<$subject> with the optional
302			language tag C<$lang> to this message. If no C<$lang>
303			argument is passed the default language for this message will be used.
304
305			Further subject => lang pairs can passed to this function like this:
306
307			$msg->add_subject ('foobar' => undef, "barfooo" => "de");
308
309			=cut
310
311	elmex	1.1	sub add_subject {
312	elmex	1.2	my $self = shift;
313			while (@_) {
314			my $subj = shift;
315			my $lang = shift;
316			$self->{subjects}->{$lang \|\| $self->{lang}} = $subj;
317			}
318			$self
319			}
320
321			=head2 subjects
322
323			This method returns a list of key value pairs
324			with the language tag as key and the subject as value.
325
326			The subject which has the empty string as key has no
327			language attached.
328
329			=cut
330
331			sub subjects {
332			%{$_[0]->{subjects} \|\| {}}
333	elmex	1.1	}
334
335	elmex	1.2	=head2 body ([$lang])
336
337			This method returns the body of this message.
338			If the C<$lang> argument is defined a body of that
339			language will be returned or undef.
340			If the C<$lang> argument is undefined this method will
341			return either the body in the default language.
342
343			=cut
344
345	elmex	1.1	sub body {
346			my ($self, $lang) = @_;
347
348			if (defined $lang) {
349			return $self->{bodies}->{$lang}
350			} else {
351	elmex	1.2	return $self->{bodies}->{$self->{lang}}
352			if defined $self->{bodies}->{$self->{lang}};
353	elmex	1.1	}
354
355			undef
356			}
357
358	elmex	1.2	=head2 any_body ([$lang])
359	elmex	1.1
360	elmex	1.2	This method will try to find any body on the message with the
361			following try order of languagetags:
362	elmex	1.1
363	elmex	1.2	1. $lang argument if one passed
364			2. default language
365			3. body without any language tag
366			4. body with the 'en' language tag
367			5. any body from any language
368	elmex	1.1
369	elmex	1.2	=cut
370	elmex	1.1
371	elmex	1.2	sub any_body {
372			my ($self, $lang) = @_;
373			if (defined $lang) {
374			return $self->{bodies}->{$lang}
375			if defined $self->{bodies}->{$lang};
376			}
377			return $self->{bodies}->{$self->{lang}}
378			if defined $self->{bodies}->{$self->{lang}};
379			return $self->{bodies}->{''}
380			if defined $self->{bodies}->{''};
381			return $self->{bodies}->{en}
382			if defined $self->{bodies}->{en};
383			return $self->{bodies}->{$_} for (keys %{$self->{bodies}});
384			return undef;
385			}
386	elmex	1.1
387	elmex	1.2	=head2 add_body ($body, [$lang], [$body2, $lang2, ...])
388	elmex	1.1
389	elmex	1.2	This method adds the body C<$body> with the optional
390			language tag C<$lang> to this message. If no C<$lang>
391			argument is passed the default language for this message will be used.
392	elmex	1.1
393	elmex	1.2	Further body => lang pairs can passed to this function like this:
394	elmex	1.1
395	elmex	1.2	$msg->add_body ('foobar' => undef, "barfooo" => "de");
396	elmex	1.1
397	elmex	1.2	=cut
398	elmex	1.1
399	elmex	1.2	sub add_body {
400			my $self = shift;
401			while (@_) {
402			my $body = shift;
403			my $lang = shift;
404			$self->{bodies}->{$lang \|\| $self->{lang}} = $body;
405			}
406			$self
407			}
408	elmex	1.1
409	elmex	1.2	=head2 bodies
410	elmex	1.1
411	elmex	1.2	This method returns a list of key value pairs
412			with the language tag as key and the body as value.
413	elmex	1.1
414	elmex	1.2	The body which has the empty string as key has no
415			language attached.
416	elmex	1.1
417	elmex	1.2	=cut
418	elmex	1.1
419	elmex	1.2	sub bodies {
420			%{$_[0]->{bodies} \|\| {}}
421			}
422	elmex	1.1
423	elmex	1.2	=head1 AUTHOR
424	elmex	1.1
425	elmex	1.2	Robin Redeker, C<< <elmex at ta-sa.org> >>
426	elmex	1.1
427			=head1 COPYRIGHT & LICENSE
428
429			Copyright 2007 Robin Redeker, all rights reserved.
430
431			This program is free software; you can redistribute it and/or modify it
432			under the same terms as Perl itself.
433
434			=cut
435
436			1; # End of Net::XMPP2