package AnyEvent::XMPP::Ext::Version;
use AnyEvent::XMPP::Namespaces qw/xmpp_ns/;
use AnyEvent::XMPP::Util qw/simxml/;
use AnyEvent::XMPP::Ext;
use strict;

our @ISA = qw/AnyEvent::XMPP::Ext/;

=head1 NAME

AnyEvent::XMPP::Ext::Version - Software version

=head1 SYNOPSIS

   use AnyEvent::XMPP::Ext::Version;

   my $version = AnyEvent::XMPP::Ext::Version->new;
   $version->set_name    ("My client");
   $version->set_version ("0.3");
   $version->set_os      (`uname -a`);

   $disco->enable_feature ($version->disco_feature);

=head1 DESCRIPTION

This module defines an extension to provide the abilities
to answer to software version requests and to request software
version from other entities.

See also XEP-0092

This class is derived from L<AnyEvent::XMPP::Ext> and can be added as extension to
objects that implement the L<AnyEvent::XMPP::Extendable> interface or derive from
it.

=head1 METHODS

=over 4

=item B<new (%args)>

Creates a new software version handle.

=cut

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

sub disco_feature { xmpp_ns ('version') }

sub init {
   my ($self) = @_;

   $self->set_name    ("AnyEvent::XMPP");
   $self->set_version ("$AnyEvent::XMPP::VERSION");


   $self->{cb_id} = $self->reg_cb (
      iq_get_request_xml => sub {
         my ($self, $con, $node) = @_;

         if ($self->handle_query ($con, $node)) {
            return 1;
         }

         ()
      }
   );
}

=item B<set_name ($name)>

This method sets the software C<$name> string, the default is "AnyEvent::XMPP".

=cut

sub set_name {
   my ($self, $name) = @_;
   $self->{name} = $name;
}

=item B<set_version ($version)>

This method sets the software C<$version> string that is replied.

The default is C<$AnyEvent::XMPP::VERSION>.

=cut

sub set_version {
   my ($self, $version) = @_;
   $self->{version} = $version;
}

=item B<set_os ($os)>

This method sets the operating system string C<$os>. If you pass
undef the string will be removed.

The default is no operating system string at all.

You may want to pass something like this:

   $version->set_os (`uname -s -r -m -o`);

=cut

sub set_os {
   my ($self, $os) = @_;
   $self->{os} = $os;
   delete $self->{os} unless defined $os;
}

sub version_result {
   my ($self) = @_;
   (
      { name => 'name'   , childs => [ $self->{name}    ] },
      { name => 'version', childs => [ $self->{version} ] },
      (defined $self->{os}
         ? { name => 'os', childs => [ $self->{os} ] }
         : ()
      ),
   )
}

sub handle_query {
   my ($self, $con, $node) = @_;

   if (my ($q) = $node->find_all ([qw/version query/])) {
      my @result = $self->version_result;
      $con->reply_iq_result (
         $node, {
            defns => 'version',
            node => {
               ns => 'version', name => 'query', childs => [
                  @result
               ]
            }
         }
      );
      return 1
   }

   ()
}

sub _version_from_node {
   my ($node) = @_;
   my (@vers) = $node->find_all ([qw/version query/], [qw/version version/]);
   my (@name) = $node->find_all ([qw/version query/], [qw/version name/]);
   my (@os)   = $node->find_all ([qw/version query/], [qw/version os/]);

   my $v = {};

   $v->{jid}     = $node->attr ('from');
   $v->{version} = $vers[0]->text if @vers;
   $v->{name}    = $name[0]->text if @name;
   $v->{os}      = $os[0]->text   if @os;

   $v
}

=item B<request_version ($con, $dest, $cb)>

This method sends a version request to C<$dest> on the connection C<$con>.

C<$cb> is the callback that will be called if either an error occured or
the result was received. The callback will also be called after the default IQ
timeout for the connection C<$con>.
The second argument for the callback will be either undef if no error occured
or a L<AnyEvent::XMPP::Error::IQ> error.
The first argument will be a hash reference with the following fields:

=over 4

=item jid

The JID of the entity this version reply belongs to.

=item version

The software version string of the entity.

=item name 

The software name of the entity.

=item os

The operating system of the entity, which might be undefined if none
was provided.

=back

Here an example of the structure of the hash reference:

  {
     jid     => 'juliet@capulet.com/balcony',
     name    => 'Exodus',
     version => '0.7.0.4',
     os      => 'Windows-XP 5.01.2600',
  }

=cut

sub request_version {
   my ($self, $con, $dest, $cb) = @_;

   $con->send_iq (get => {
      defns => 'version',
      node  => { ns => 'version', name => 'query' }
   }, sub {
      my ($n, $e) = @_;
      if ($e) {
         $cb->(undef, $e);
      } else {
         $cb->(_version_from_node ($n), undef);
      }
   }, to => $dest);
}

sub DESTROY {
   my ($self) = @_;
   $self->unreg_cb ($self->{cb_id})
}


=back

=head1 AUTHOR

Robin Redeker, C<< <elmex at ta-sa.org> >>, JID: C<< <elmex at jabber.org> >>

=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;