view release on metacpan or  search on metacpan

lib/AnyEvent/XMPP/TestClient.pm  view on Meta::CPAN

   perl t/z_00_register.t

And then you could eg. run:

   perl t/z_03_iq_auth.t

=head1 METHODS

=head2 new (%args)

Following arguments can be passed in C<%args>:

=over 4

=back

=cut

sub new_or_exit {
   my $this = shift;
   my $class = ref($this) || $this;
   my $self = {
      timeout      => 20,
      finish_count =>  1,
      @_
   };

   if ($ENV{NET_XMPP2_TEST_DEBUG}) {
      $self->{debug} = 1;
   }

   if ($ENV{NET_XMPP2_TEST_TIMEOUT}) {
      $self->{timeout} = $ENV{NET_XMPP2_TEST_TIMEOUT};
   }

   $self->{tests};

   if ($self->{muc_test} && not $ENV{NET_XMPP2_TEST_MUC}) {
      plan skip_all => "environment var NET_XMPP2_TEST_MUC not set! Set it to a conference!";
      exit;
   }

   if ($ENV{NET_XMPP2_TEST}) {
      plan tests => $self->{tests} + 1
   } else {
      plan skip_all => "environment var NET_XMPP2_TEST not set! (see also AnyEvent::XMPP::TestClient)!";
      exit;
   }

   bless $self, $class;
   $self->init;
   $self
}

sub init {
   my ($self) = @_;
   $self->{condvar} = AnyEvent->condvar;
   $self->{timeout} =
      AnyEvent->timer (
         after => $self->{timeout}, cb => sub {
            $self->{error} .= "Error: Test Timeout\n";
            $self->{condvar}->broadcast;
         }
      );

   my $cl = $self->{client} = AnyEvent::XMPP::Client->new (debug => $self->{debug} || 0);
   my ($jid, $password) = split /:/, $ENV{NET_XMPP2_TEST}, 2;

   $self->{jid}      = $jid;
   $self->{jid2}     = "2nd_" . $jid;
   $self->{password} = $password;
   $cl->add_account ($jid, $password, undef, undef, $self->{connection_args});

   if ($self->{two_accounts}) {
      my $cnt = 0;
      $cl->reg_cb (session_ready => sub {
         my ($cl, $acc) = @_;

         if (++$cnt > 1) {
            $self->{acc}  = $cl->get_account ($self->{jid});
            $self->{acc2} = $cl->get_account ($self->{jid2});
            $cl->event ('two_accounts_ready', $acc);
            $self->state_done ('two_accounts_ready');
         }
      });

      $cl->add_account ("2nd_".$jid, $password, undef, undef, $self->{connection_args});

   } else {
      $cl->reg_cb (before_session_ready => sub {
         my ($cl, $acc) = @_;
         $self->{acc} = $acc;
         $self->state_done ('one_account_ready');
      });
   }

   if ($self->{muc_test} && $ENV{NET_XMPP2_TEST_MUC}) {
      $self->{muc_room} = "test_nxmpp2@" . $ENV{NET_XMPP2_TEST_MUC};

      my $disco = $self->{disco} = $self->instance_ext ('AnyEvent::XMPP::Ext::Disco');
      my $muc   = $self->{muc}   = $self->instance_ext ('AnyEvent::XMPP::Ext::MUC', disco => $disco);

      $cl->reg_cb (
         two_accounts_ready => sub {
            my ($cl, $acc) = @_;
            my $cnt = 0;
            my ($room1, $room2);

            $muc->join_room ($self->{acc}->connection, $self->{muc_room}, "test1");
            my $rid;
            $rid = $muc->reg_cb (
               join_error => sub {
                  my ($muc, $room, $error) = @_;
                  $self->{error} .= "Error: Couldn't join $self->{muc_room}: ".$error->string."\n";
                  $self->{condvar}->broadcast;
               },
               enter => sub {
                  my ($muc, $room, $user) = @_;

                  if ($room->get_me->nick eq 'test1') {
                     $self->{user} = $user;