File Coverage

blib/lib/AnyEvent/XMPP/IM/Message.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package AnyEvent::XMPP::IM::Message;
use strict;
use overload
  '""' => "to_string";

use AnyEvent::XMPP::IM::Delayed;

our @ISA = qw/AnyEvent::XMPP::IM::Delayed/;

=head1 NAME

AnyEvent::XMPP::IM::Message - Instant message

=head1 SYNOPSIS

   use AnyEvent::XMPP::IM::Message;

   my $con = AnyEvent::XMPP::IM::Connection->new (...);

   AnyEvent::XMPP::IM::Message->new (
      body => "Hello there!",
      to   => "[e-mail]"
   )->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 object overloads the stringification
operation. The string represenation of this object is the return
value of the C method.

L is derived from L,
use the interface described there to find out whether this message was delayed.

=head1 METHODS

=over 4

=item B

This method creates a new instance of a L.

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

These are the possible keys:

=over 4

=item connection => $connection

This is the L object that will
be used to send this message when the C method is called.

=item to => $jid

This is the destination JID of this message.
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 method, see also
the C argument below.

=item from => $jid

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

=item lang => $lang

This is the default language that will be used to tag the values
passed in the C and C argument to C.

=item body => $body

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

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

=item subject => $subject

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

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

=item type => $type

This field sets the type of the message. See also the L 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 from_node {
   my ($self, $node) = @_;
   $self->{node} = $node;

   $self->fetch_delay_from_node ($node);

   my $id       = $node->attr ('id');
   my $from     = $node->attr ('from');
   my $to       = $node->attr ('to');
   my $type     = $node->attr ('type');
   my ($thread) = $node->find_all ([qw/client thread/]);

   my %bodies;
   my %subjects;

   $bodies{$_->attr ('lang') || ''} = $_->text
      for $node->find_all ([qw/client body/]);
   $subjects{$_->attr ('lang') || ''} = $_->text
      for $node->find_all ([qw/client subject/]);

   $self->{id}       = $id;
   $self->{from}     = $from;
   $self->{to}       = $to;
   $self->{type}     = $type;
   $self->{thread}   = $thread;
   $self->{bodies}   = \%bodies;
   $self->{subjects} = \%subjects;
}

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

=item B

This method returns the ID of this message.
If C<$msg_id> is not undef it will replace the current
message id.

=cut

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

=item B

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

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

This method returns a new instance of L.
The destination address, connection and type of the returned message
object will be set.

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

=cut

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

   unless ($msg) {
      $msg = $self->new ();
   }

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

   $msg
}

=item B

This method returns 1 when the message is "connected".
That means: It returns 1 when you can call the C 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

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;
   push @add, (from => $self->from)
      if $self->from;

   push @add, (id => $self->id)
      if $self->id;

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

=item B

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

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

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

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

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

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

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

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

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

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

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

=item B

This method allows the user to append custom XML stuff to the message
when it is sent. This is an example:

   my $msg =
      AnyEvent::XMPP::IM::Message->new (
         body => "Test!",
         to => "[e-mail]",
      );
   $msg->append_creation (sub {
      my ($w) = @_;
      $w->startTag (['http://test.namespace','test']);
      $w->characters ("TEST");
      $w->endTag;
   });

   $msg->send ($con);

This should send a message stanza similar to this:

=cut

sub append_creation {
   my ($self, $cb) = @_;
   push @{$self->{create_cbs}}, $cb;
}

=back

=head1 AUTHOR

Robin Redeker, C<<  >>, JID: C<<  >>

=head1 COPYRIGHT & LICENSE

Copyright 2007, 2008 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 AnyEvent::XMPP