view release on metacpan or  search on metacpan

samples/limit_searcher  view on Meta::CPAN

#!/opt/perl/bin/perl
use strict;
use utf8;
use AnyEvent;
use AnyEvent::XMPP::Client;
use AnyEvent::XMPP::Util qw/simxml/;
use AnyEvent::XMPP::Ext::Disco;

my $j = AnyEvent->condvar;
my $cl = AnyEvent::XMPP::Client->new;

$cl->add_account ('net_xmpp2@jabber.org', 'test');

my $max_size      = 100000;
my $first_size    = $max_size;
my $last_nok_size = $max_size;
my $last_ok_size  = 0;
my $delta         = 10;

$cl->reg_cb (
   session_ready => sub {
      my ($cl, $acc) = @_;
      my $con = $acc->connection;

      if (($last_nok_size - $last_ok_size) < $delta) {
         print "Found limit in delta range: $last_ok_size for ".$acc->jid."\n";
         $con->disconnect ("found limit");
         return 0;
      }

      $con->send_iq (set => sub {
         my ($w) = @_;
         simxml ($w,
            defns => 'jabber:iq:private',
            node  => {
               name   => 'query',
               ns     => 'jabber:iq:private',
               childs => [
                  { name => "test", dns => "test:fe", childs => [ "A" x $first_size ] },
               ]
            }
         );
         print "Trying $first_size...\n";
      }, sub {
         my ($n, $e) = @_;
         if ($e) {
            die "iq private error: " . $e->string . "\n";
         } else {
            $con->send_iq (get => sub {
               my ($w) = @_;
               simxml ($w,
                  defns => 'jabber:iq:private',
                  node => {
                     name => 'query',
                     ns => 'jabber:iq:private',
                     childs => [ { name => 'test', dns => 'test:fe' } ] 
                  }
               );
            }, sub {
               my ($n, $e) = @_;
               if ($e) { 
                  $con->disconnect ("bad iq reply");
               } else {