view release on metacpan or  search on metacpan

samples/simple_oob_retriever  view on Meta::CPAN

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

my $j  = AnyEvent->condvar;
my $cl = AnyEvent::XMPP::Client->new (debug => 1);

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

my $disco = AnyEvent::XMPP::Ext::Disco->new;
my $oob   = AnyEvent::XMPP::Ext::OOB->new;

$cl->add_extension ($disco);
$cl->add_extension ($oob);

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

unless (-d 'oobdata') {
   mkdir "oobdata" or die "Couldn't make directory oobdata/: $!";
}

my $file = "aaaaaaa";
while (-e "oobdata/$file") { $file++ }

$oob->reg_cb (oob_recv => sub {
   my ($oob, $con, $node, $url) = @_;
   print "receiving url $url->{url} from ".$node->attr ('from')."\n";
   my $cont = `curl -f \Q$url->{url}\E 2> /dev/null`;
   my $exitv = $? >> 8;

   if ($exitv) {
      $oob->reply_failure ($con, $node, 'not-found');
   } else {
      if (open OUT, ">oobdata/$file") {
         print OUT $cont;
         close OUT;
         $file++;
      } else {
         warn "Couldn't write to oobdata/$file: $!\n";
      }

      $oob->reply_success ($con, $node);
   }
});

$cl->reg_cb (
   session_ready => sub {
      my ($cl, $acc) = @_;
      print "session ready, waiting...\n";
   },
   disconnect => sub {
      my ($cl, $acc, $h, $p, $reas) = @_;
      print "disconnect ($h:$p): $reas\n";
   },
   error => sub {
      my ($cl, $acc, $err) = @_;
      print "ERROR: " . $err->string . "\n";
   },
   message => sub {