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 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
}

=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.3
Committed:	Fri Apr 20 14:56:45 2007 UTC (19 years, 5 months ago) by elmex
Branch:	MAIN
Changes since 1.2:	+15 -0 lines
Log Message:	implemented Client.pm. Implemented error objects which simplyfied the error reporting.
#	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.3	=head2 is_connected ()
167
168			This method returns 1 when the message is "connected".
169			That means: It returns 1 when you can call the C<send> method
170			without a connection argument. (It will also return only 1 when
171			the connection that is referenced by this message is still
172			connected).
173
174			=cut
175
176			sub is_connected {
177			my ($self) = @_;
178			$self->{connection}->is_connected
179			}
180
181	elmex	1.2	=head2 send ([$connection])
182	elmex	1.1
183	elmex	1.2	This method send this message. If C<$connection>
184			is defined it will set the connection of this
185			message object before it is send.
186	elmex	1.1
187	elmex	1.2	=cut
188	elmex	1.1
189	elmex	1.2	sub send {
190			my ($self, $connection) = @_;
191	elmex	1.1
192	elmex	1.2	$self->{connection} = $connection if $connection;
193	elmex	1.1
194			my @add;
195			push @add, (subject => $self->{subjects})
196			if %{$self->{subjects} \|\| {}};
197			push @add, (thread => $self->thread)
198			if $self->thread;
199
200			$self->{connection}->send_message (
201			$self->to, $self->type, undef,
202			body => $self->{bodies},
203			@add
204			);
205			}
206
207	elmex	1.2	=head2 type ([$type])
208
209			This method returns the type of the message, which
210			is either undefined or one of the following values:
211
212			'chat', 'error', 'groupchat', 'headline', 'normal'
213
214			If the C<$type> argument is defined it will set the type
215			of this message.
216
217			=cut
218
219	elmex	1.1	sub type {
220			my ($self, $type) = @_;
221			$self->{type} = $type
222			if defined $type;
223			$self->{type}
224			}
225
226	elmex	1.2	=head2 thread ([$thread])
227
228			This method returns the thread id of this message,
229			which might be undefined.
230
231			If you want to set the threadid simply pass the C<$thread>
232			argument.
233
234			=cut
235
236	elmex	1.1	sub thread {
237			my ($self, $thread) = @_;
238			$self->{thread} = $thread
239			if defined $thread;
240			$self->{thread}
241			}
242
243	elmex	1.2	=head2 lang ([$lang])
244
245			This returns the default language tag of this message,
246			which can be undefined.
247
248			To set the language tag pass the C<$lang> argument, which
249			should be the new default language tag.
250
251			If you do not want to specify any language pass the empty
252			string as language tag.
253
254			=cut
255
256			sub lang {
257			my ($self, $lang) = @_;
258			$self->{lang} = $lang
259			if defined $lang;
260			$self->{lang}
261			}
262
263			=head2 subject ([$lang])
264
265			This method returns the subject of this message.
266			If the C<$lang> argument is defined a subject of that
267			language will be returned or undef.
268			If the C<$lang> argument is undefined this method will
269			return either the subject in the default language.
270
271			=cut
272
273	elmex	1.1	sub subject {
274			my ($self, $lang) = @_;
275
276			if (defined $lang) {
277			return $self->{subjects}->{$lang}
278			}
279
280	elmex	1.2	return $self->{subjects}->{$self->{lang}};
281
282	elmex	1.1	undef
283			}
284
285	elmex	1.2	=head2 any_subject ([$lang])
286
287			This method will try to find any subject on the message with the
288			following try order of languagetags:
289
290			1. $lang argument if one passed
291			2. default language
292			3. subject without any language tag
293			4. subject with the 'en' language tag
294			5. any subject from any language
295
296			=cut
297
298			sub any_subject {
299			my ($self, $lang) = @_;
300			if (defined $lang) {
301			return $self->{subjects}->{$lang}
302			if defined $self->{subjects}->{$lang};
303			}
304			return $self->{subjects}->{$self->{lang}}
305			if defined $self->{subjects}->{$self->{lang}};
306			return $self->{subjects}->{''}
307			if defined $self->{subjects}->{''};
308			return $self->{subjects}->{en}
309			if defined $self->{subjects}->{en};
310			return $self->{subjects}->{$_} for (keys %{$self->{subjects}});
311			return undef;
312			}
313
314			=head2 add_subject ($subject, [$lang], [$subject2, $lang2, ...])
315
316			This method adds the subject C<$subject> with the optional
317			language tag C<$lang> to this message. If no C<$lang>
318			argument is passed the default language for this message will be used.
319
320			Further subject => lang pairs can passed to this function like this:
321
322			$msg->add_subject ('foobar' => undef, "barfooo" => "de");
323
324			=cut
325
326	elmex	1.1	sub add_subject {
327	elmex	1.2	my $self = shift;
328			while (@_) {
329			my $subj = shift;
330			my $lang = shift;
331			$self->{subjects}->{$lang \|\| $self->{lang}} = $subj;
332			}
333			$self
334			}
335
336			=head2 subjects
337
338			This method returns a list of key value pairs
339			with the language tag as key and the subject as value.
340
341			The subject which has the empty string as key has no
342			language attached.
343
344			=cut
345
346			sub subjects {
347			%{$_[0]->{subjects} \|\| {}}
348	elmex	1.1	}
349
350	elmex	1.2	=head2 body ([$lang])
351
352			This method returns the body of this message.
353			If the C<$lang> argument is defined a body of that
354			language will be returned or undef.
355			If the C<$lang> argument is undefined this method will
356			return either the body in the default language.
357
358			=cut
359
360	elmex	1.1	sub body {
361			my ($self, $lang) = @_;
362
363			if (defined $lang) {
364			return $self->{bodies}->{$lang}
365			} else {
366	elmex	1.2	return $self->{bodies}->{$self->{lang}}
367			if defined $self->{bodies}->{$self->{lang}};
368	elmex	1.1	}
369
370			undef
371			}
372
373	elmex	1.2	=head2 any_body ([$lang])
374	elmex	1.1
375	elmex	1.2	This method will try to find any body on the message with the
376			following try order of languagetags:
377	elmex	1.1
378	elmex	1.2	1. $lang argument if one passed
379			2. default language
380			3. body without any language tag
381			4. body with the 'en' language tag
382			5. any body from any language
383	elmex	1.1
384	elmex	1.2	=cut
385	elmex	1.1
386	elmex	1.2	sub any_body {
387			my ($self, $lang) = @_;
388			if (defined $lang) {
389			return $self->{bodies}->{$lang}
390			if defined $self->{bodies}->{$lang};
391			}
392			return $self->{bodies}->{$self->{lang}}
393			if defined $self->{bodies}->{$self->{lang}};
394			return $self->{bodies}->{''}
395			if defined $self->{bodies}->{''};
396			return $self->{bodies}->{en}
397			if defined $self->{bodies}->{en};
398			return $self->{bodies}->{$_} for (keys %{$self->{bodies}});
399			return undef;
400			}
401	elmex	1.1
402	elmex	1.2	=head2 add_body ($body, [$lang], [$body2, $lang2, ...])
403	elmex	1.1
404	elmex	1.2	This method adds the body C<$body> with the optional
405			language tag C<$lang> to this message. If no C<$lang>
406			argument is passed the default language for this message will be used.
407	elmex	1.1
408	elmex	1.2	Further body => lang pairs can passed to this function like this:
409	elmex	1.1
410	elmex	1.2	$msg->add_body ('foobar' => undef, "barfooo" => "de");
411	elmex	1.1
412	elmex	1.2	=cut
413	elmex	1.1
414	elmex	1.2	sub add_body {
415			my $self = shift;
416			while (@_) {
417			my $body = shift;
418			my $lang = shift;
419			$self->{bodies}->{$lang \|\| $self->{lang}} = $body;
420			}
421			$self
422			}
423	elmex	1.1
424	elmex	1.2	=head2 bodies
425	elmex	1.1
426	elmex	1.2	This method returns a list of key value pairs
427			with the language tag as key and the body as value.
428	elmex	1.1
429	elmex	1.2	The body which has the empty string as key has no
430			language attached.
431	elmex	1.1
432	elmex	1.2	=cut
433	elmex	1.1
434	elmex	1.2	sub bodies {
435			%{$_[0]->{bodies} \|\| {}}
436			}
437	elmex	1.1
438	elmex	1.2	=head1 AUTHOR
439	elmex	1.1
440	elmex	1.2	Robin Redeker, C<< <elmex at ta-sa.org> >>
441	elmex	1.1
442			=head1 COPYRIGHT & LICENSE
443
444			Copyright 2007 Robin Redeker, all rights reserved.
445
446			This program is free software; you can redistribute it and/or modify it
447			under the same terms as Perl itself.
448
449			=cut
450
451			1; # End of Net::XMPP2