XMPP2/IM/Message.pm

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

=head1 NAME

Net::XMPP2::IM::Message - 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.

=head1 METHODS

=over 4

=item B<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.

=item type => $type

This field sets the type of the message. See also the L<type> method below.

The default value for C<$type> is 'normal'.

=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->{type} ||= 'normal'; # default it to 'normal'
   $self->{lang} ||= '';

   $self
}

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

=item B<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}
}

=item B<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}
}

=item B<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
}

=item B<is_connected ()>

This method returns 1 when the message is "connected".
That means: It returns 1 when you can call the C<send> method
without a connection argument. (It will also return only 1 when
the connection that is referenced by this message is still
connected).

=cut

sub is_connected {
   my ($self) = @_;
   $self->{connection}->is_connected
}

=item B<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
   );
}

=item B<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}
}

=item B<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}
}

=item B<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}
}

=item B<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
}

=item B<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;
}

=item B<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
}

=item B<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} || {}}
}

=item B<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
}

=item B<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;
}

=item B<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
}

=item B<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} || {}}
}

=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; # End of Net::XMPP2
Revision:	1.6
Committed:	Thu Jul 5 19:27:35 2007 UTC (19 years, 2 months ago) by elmex
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.5:	+1 -1 lines
Log Message:	fixed some typos and such
#	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	elmex	1.6	Net::XMPP2::IM::Message - Instant message
9	elmex	1.1
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	elmex	1.5	=head1 METHODS
32	elmex	1.2
33	elmex	1.5	=over 4
34	elmex	1.2
35	elmex	1.5	=item B<new (%args)>
36	elmex	1.2
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	elmex	1.4	=item type => $type
87
88			This field sets the type of the message. See also the L<type> method below.
89
90			The default value for C<$type> is 'normal'.
91
92	elmex	1.2	=back
93	elmex	1.1
94			=cut
95
96			sub new {
97			my $this = shift;
98			my $class = ref($this) \|\| $this;
99	elmex	1.2	my $self = bless { @_ }, $class;
100
101			if (my $sub = delete $self->{subject}) {
102			$self->add_subject ($sub);
103			}
104			if (my $body = delete $self->{body}) {
105			$self->add_body ($body);
106			}
107
108	elmex	1.4	$self->{type} \|\|= 'normal'; # default it to 'normal'
109	elmex	1.2	$self->{lang} \|\|= '';
110
111			$self
112	elmex	1.1	}
113
114			sub to_string {
115			my ($self) = @_;
116	elmex	1.2	$self->any_body
117	elmex	1.1	}
118
119	elmex	1.5	=item B<from ([$jid])>
120	elmex	1.2
121			This method returns the source JID of this message.
122			If C<$jid> is not undef it will replace the current
123			source address.
124
125			=cut
126
127	elmex	1.1	sub from {
128			my ($self, $from) = @_;
129			$self->{from} = $from if defined $from;
130			$self->{from}
131			}
132
133	elmex	1.5	=item B<to ([$jid])>
134	elmex	1.2
135			This method returns the destination JID of this message.
136			If C<$jid> is not undef it will replace the current
137			destination address.
138
139			=cut
140
141	elmex	1.1	sub to {
142			my ($self, $to) = @_;
143			$self->{to} = $to if defined $to;
144			$self->{to}
145			}
146
147	elmex	1.5	=item B<make_reply ([$msg])>
148	elmex	1.2
149			This method returns a new instance of L<Net::XMPP2::IM::Message>.
150			The destination address, connection and type of the returned message
151			object will be set.
152
153			If C<$msg> is defined and an instance of L<Net::XMPP2::IM::Message>
154			the destination address, connection and type of C<$msg> will be changed
155			and this method will not return a new instance of L<Net::XMPP2::IM::Message>.
156
157			=cut
158
159	elmex	1.1	sub make_reply {
160			my ($self, $msg) = @_;
161
162			unless ($msg) {
163			$msg = Net::XMPP2::IM::Message->new ();
164			}
165
166			$msg->{connection} = $self->{connection};
167			$msg->to ($self->from);
168			$msg->type ($self->type);
169
170			$msg
171			}
172
173	elmex	1.5	=item B<is_connected ()>
174	elmex	1.3
175			This method returns 1 when the message is "connected".
176			That means: It returns 1 when you can call the C<send> method
177			without a connection argument. (It will also return only 1 when
178			the connection that is referenced by this message is still
179			connected).
180
181			=cut
182
183			sub is_connected {
184			my ($self) = @_;
185			$self->{connection}->is_connected
186			}
187
188	elmex	1.5	=item B<send ([$connection])>
189	elmex	1.1
190	elmex	1.2	This method send this message. If C<$connection>
191			is defined it will set the connection of this
192			message object before it is send.
193	elmex	1.1
194	elmex	1.2	=cut
195	elmex	1.1
196	elmex	1.2	sub send {
197			my ($self, $connection) = @_;
198	elmex	1.1
199	elmex	1.2	$self->{connection} = $connection if $connection;
200	elmex	1.1
201			my @add;
202			push @add, (subject => $self->{subjects})
203			if %{$self->{subjects} \|\| {}};
204			push @add, (thread => $self->thread)
205			if $self->thread;
206
207			$self->{connection}->send_message (
208			$self->to, $self->type, undef,
209			body => $self->{bodies},
210			@add
211			);
212			}
213
214	elmex	1.5	=item B<type ([$type])>
215	elmex	1.2
216			This method returns the type of the message, which
217			is either undefined or one of the following values:
218
219			'chat', 'error', 'groupchat', 'headline', 'normal'
220
221			If the C<$type> argument is defined it will set the type
222			of this message.
223
224			=cut
225
226	elmex	1.1	sub type {
227			my ($self, $type) = @_;
228			$self->{type} = $type
229			if defined $type;
230			$self->{type}
231			}
232
233	elmex	1.5	=item B<thread ([$thread])>
234	elmex	1.2
235			This method returns the thread id of this message,
236			which might be undefined.
237
238			If you want to set the threadid simply pass the C<$thread>
239			argument.
240
241			=cut
242
243	elmex	1.1	sub thread {
244			my ($self, $thread) = @_;
245			$self->{thread} = $thread
246			if defined $thread;
247			$self->{thread}
248			}
249
250	elmex	1.5	=item B<lang ([$lang])>
251	elmex	1.2
252			This returns the default language tag of this message,
253			which can be undefined.
254
255			To set the language tag pass the C<$lang> argument, which
256			should be the new default language tag.
257
258			If you do not want to specify any language pass the empty
259			string as language tag.
260
261			=cut
262
263			sub lang {
264			my ($self, $lang) = @_;
265			$self->{lang} = $lang
266			if defined $lang;
267			$self->{lang}
268			}
269
270	elmex	1.5	=item B<subject ([$lang])>
271	elmex	1.2
272			This method returns the subject of this message.
273			If the C<$lang> argument is defined a subject of that
274			language will be returned or undef.
275			If the C<$lang> argument is undefined this method will
276			return either the subject in the default language.
277
278			=cut
279
280	elmex	1.1	sub subject {
281			my ($self, $lang) = @_;
282
283			if (defined $lang) {
284			return $self->{subjects}->{$lang}
285			}
286
287	elmex	1.2	return $self->{subjects}->{$self->{lang}};
288
289	elmex	1.1	undef
290			}
291
292	elmex	1.5	=item B<any_subject ([$lang])>
293	elmex	1.2
294			This method will try to find any subject on the message with the
295			following try order of languagetags:
296
297			1. $lang argument if one passed
298			2. default language
299			3. subject without any language tag
300			4. subject with the 'en' language tag
301			5. any subject from any language
302
303			=cut
304
305			sub any_subject {
306			my ($self, $lang) = @_;
307			if (defined $lang) {
308			return $self->{subjects}->{$lang}
309			if defined $self->{subjects}->{$lang};
310			}
311			return $self->{subjects}->{$self->{lang}}
312			if defined $self->{subjects}->{$self->{lang}};
313			return $self->{subjects}->{''}
314			if defined $self->{subjects}->{''};
315			return $self->{subjects}->{en}
316			if defined $self->{subjects}->{en};
317			return $self->{subjects}->{$_} for (keys %{$self->{subjects}});
318			return undef;
319			}
320
321	elmex	1.5	=item B<add_subject ($subject, [$lang], [$subject2, $lang2, ...])>
322	elmex	1.2
323			This method adds the subject C<$subject> with the optional
324			language tag C<$lang> to this message. If no C<$lang>
325			argument is passed the default language for this message will be used.
326
327			Further subject => lang pairs can passed to this function like this:
328
329			$msg->add_subject ('foobar' => undef, "barfooo" => "de");
330
331			=cut
332
333	elmex	1.1	sub add_subject {
334	elmex	1.2	my $self = shift;
335			while (@_) {
336			my $subj = shift;
337			my $lang = shift;
338			$self->{subjects}->{$lang \|\| $self->{lang}} = $subj;
339			}
340			$self
341			}
342
343	elmex	1.5	=item B<subjects>
344	elmex	1.2
345			This method returns a list of key value pairs
346			with the language tag as key and the subject as value.
347
348			The subject which has the empty string as key has no
349			language attached.
350
351			=cut
352
353			sub subjects {
354			%{$_[0]->{subjects} \|\| {}}
355	elmex	1.1	}
356
357	elmex	1.5	=item B<body ([$lang])>
358	elmex	1.2
359			This method returns the body of this message.
360			If the C<$lang> argument is defined a body of that
361			language will be returned or undef.
362			If the C<$lang> argument is undefined this method will
363			return either the body in the default language.
364
365			=cut
366
367	elmex	1.1	sub body {
368			my ($self, $lang) = @_;
369
370			if (defined $lang) {
371			return $self->{bodies}->{$lang}
372			} else {
373	elmex	1.2	return $self->{bodies}->{$self->{lang}}
374			if defined $self->{bodies}->{$self->{lang}};
375	elmex	1.1	}
376
377			undef
378			}
379
380	elmex	1.5	=item B<any_body ([$lang])>
381	elmex	1.1
382	elmex	1.2	This method will try to find any body on the message with the
383			following try order of languagetags:
384	elmex	1.1
385	elmex	1.2	1. $lang argument if one passed
386			2. default language
387			3. body without any language tag
388			4. body with the 'en' language tag
389			5. any body from any language
390	elmex	1.1
391	elmex	1.2	=cut
392	elmex	1.1
393	elmex	1.2	sub any_body {
394			my ($self, $lang) = @_;
395			if (defined $lang) {
396			return $self->{bodies}->{$lang}
397			if defined $self->{bodies}->{$lang};
398			}
399			return $self->{bodies}->{$self->{lang}}
400			if defined $self->{bodies}->{$self->{lang}};
401			return $self->{bodies}->{''}
402			if defined $self->{bodies}->{''};
403			return $self->{bodies}->{en}
404			if defined $self->{bodies}->{en};
405			return $self->{bodies}->{$_} for (keys %{$self->{bodies}});
406			return undef;
407			}
408	elmex	1.1
409	elmex	1.5	=item B<add_body ($body, [$lang], [$body2, $lang2, ...])>
410	elmex	1.1
411	elmex	1.2	This method adds the body C<$body> with the optional
412			language tag C<$lang> to this message. If no C<$lang>
413			argument is passed the default language for this message will be used.
414	elmex	1.1
415	elmex	1.2	Further body => lang pairs can passed to this function like this:
416	elmex	1.1
417	elmex	1.2	$msg->add_body ('foobar' => undef, "barfooo" => "de");
418	elmex	1.1
419	elmex	1.2	=cut
420	elmex	1.1
421	elmex	1.2	sub add_body {
422			my $self = shift;
423			while (@_) {
424			my $body = shift;
425			my $lang = shift;
426			$self->{bodies}->{$lang \|\| $self->{lang}} = $body;
427			}
428			$self
429			}
430	elmex	1.1
431	elmex	1.5	=item B<bodies>
432	elmex	1.1
433	elmex	1.2	This method returns a list of key value pairs
434			with the language tag as key and the body as value.
435	elmex	1.1
436	elmex	1.2	The body which has the empty string as key has no
437			language attached.
438	elmex	1.1
439	elmex	1.2	=cut
440	elmex	1.1
441	elmex	1.2	sub bodies {
442			%{$_[0]->{bodies} \|\| {}}
443			}
444	elmex	1.1
445	elmex	1.5	=back
446
447	elmex	1.2	=head1 AUTHOR
448	elmex	1.1
449	elmex	1.5	Robin Redeker, C<< <elmex at ta-sa.org> >>, JID: C<< <elmex at jabber.org> >>
450	elmex	1.1
451			=head1 COPYRIGHT & LICENSE
452
453			Copyright 2007 Robin Redeker, all rights reserved.
454
455			This program is free software; you can redistribute it and/or modify it
456			under the same terms as Perl itself.
457
458			=cut
459
460			1; # End of Net::XMPP2