view release on metacpan or  search on metacpan

samples/simple_register_example  view on Meta::CPAN

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

sub result {
   my ($reg, $ok, $error, $form, $comment) = @_;
   $comment ||= 'REGISTERED!';
   if ($ok) {
      print "$comment\n";
   } else {
      print "ERROR: " . $error->string . " [form: $form]\n";
   }
}

my ($user, $pw, $act) = @ARGV;
my ($username, $server) = split_jid ($user);

unless ($user && $pw) {
print <<USAGE;
usage:
  register account:
     ./simple_register_example <jid> <password>

  unregister account:
     ./simple_register_example <jid> <password> unregister

  change password:
     ./simple_register_example <jid> <password> chpw:<newpassword>

USAGE
die "\n";
}

my $j = AnyEvent->condvar;
my $cl = AnyEvent::XMPP::Client->new (debug => 1);
$cl->add_account ($user, $pw);
$cl->reg_cb (
   stream_pre_authentication => sub {
      my ($cl, $acc) = @_;

      my $reg = AnyEvent::XMPP::Ext::Registration->new (connection => $acc->connection);

      if ($act eq '') {
         $reg->send_registration_request (sub {
            my ($reg, $form, $error) = @_;

            if ($error) {
               print "ERROR: " . $error->string . "\n";

            } else {
               my $df = $form->get_data_form;
               my $lf = $form->get_legacy_form_fields;
               my $oo = $form->get_oob;

               if ($df) {
                  print "GOT FORM! ".($df ? $df->as_debug_string : "")."\n";
               }
               if ($lf) {
                  require Data::Dumper;