AnyEvent-XMPP
view release on metacpan or search on metacpan
- removed to attribute from iq auth get
- implemented iq auth (XEP-0078)
- fixed some bugs and improved the API a bit
- implemented the possibility of intercepting events from the library.
0.05 Fri Jul 27 17:45:16 CEST 2007
- fixed destructor problem in disco
- disco extension now supports multiple identities
- added some unit tests!!!11
- improved error reporting a bit of internal exceptions
- fixed a bug where empty passwords didn't work
- typo bugfix in Net::XMPP2::Ext::Registration::submit_form
- lots of documentation bugfixes and also added some
more useful examples to the synopsises.
- fixed a bug with enabling and disabling multiple features
with enable_feature (as Ext::OOB does).
0.04 Thu Jul 26 20:41:57 CEST 2007
- actually added event send_stanza_data after documenting it
- added samples/simple_register_example
- fixed some bugs in Net::XMPP2::Ext::Disco
This is a (basic) skeleton for a jabber component.
samples/simple_oob_retriever
This is a simple out of band file transfer receiver bot. It uses
"curl" to fetch the files and also has the sample functionality of
sending a file url for someone who sends the bot a 'send <filename>'
message.
samples/simple_register_example
This is a example script which allows you to register, unregister
and change your password for accounts. Execute it without arguments
for more details.
samples/disco_info
This is a small example tool that allows you to fetch the software
version, disco info and disco items information about a JID.
samples/talkbot
This is a simple bot that will read lines from a file and recite
them when you send it a message. It will also automatically allow
you to subscribe to it. Start it without commandline arguments to be
informed about the usage.
samples/retrieve_roster
This is a simple example script that will retrieve the roster for an
account and print it to stdout. You start it like this:
samples/# ./retrieve_roster <jid> <password>
samples/display_avatar
This is just a small example which should display the avatar of the
account you connect to. It can be used like this:
samples/# ./display_avatar <jid> <password>
For others, which the author might forgot or didn't want to list here
see the "samples/" directory.
More examples will be included in later releases, please feel free to
ask the "AUTHOR" if you have any questions about the API. There is also
an IRC channel, see "SUPPORT".
AUTHOR
Robin Redeker, "<elmex at ta-sa.org>", JID: "<elmex at jabber.org>"
- 9.4 Revoking Membership
- 9.5 Modifying the Member List
- 9.6 Granting Moderator Privileges
- 9.7 Revoking Moderator Privileges
- 9.8 Modifying the Moderator List
- 9.9 Approving Registration Requests
- 10. Owner Use Cases
x 10.1.1 General Considerations
x 10.1.2 Creating an Instant Room
x 10.1.3 Creating a Reserved Room
x entering password protected rooms
- 7.7 Occupant Modification of the Room Subject
- 10.1.4 Requesting a Unique Room Name
- 10.2 Subsequent Room Configuration
- 10.2.1 Notification of Configuration Changes
- 10.3 Granting Ownership Privileges
- 10.4 Revoking Ownership Privileges
- 10.5 Modifying the Owner List
- 10.6 Granting Administrative Privileges
- 10.7 Revoking Administrative Privileges
- 10.8 Modifying the Admin List
lib/AnyEvent/XMPP.pm view on Meta::CPAN
=item B<samples/simple_oob_retriever>
This is a simple out of band file transfer receiver bot. It uses C<curl> to
fetch the files and also has the sample functionality of sending a file url for
someone who sends the bot a 'send <filename>' message.
=item B<samples/simple_register_example>
This is a example script which allows you to register, unregister and change
your password for accounts. Execute it without arguments for more details.
=item B<samples/disco_info>
This is a small example tool that allows you to fetch the software version,
disco info and disco items information about a JID.
=item B<samples/talkbot>
This is a simple bot that will read lines from a file and recite them
when you send it a message. It will also automatically allow you to subscribe
to it. Start it without commandline arguments to be informed about the usage.
=item B<samples/retrieve_roster>
This is a simple example script that will retrieve the roster
for an account and print it to stdout. You start it like this:
samples/# ./retrieve_roster <jid> <password>
=item B<samples/display_avatar>
This is just a small example which should display the avatar
of the account you connect to. It can be used like this:
samples/# ./display_avatar <jid> <password>
=back
For others, which the author might forgot or didn't want to
list here see the C<samples/> directory.
More examples will be included in later releases, please feel free to ask the
L</AUTHOR> if you have any questions about the API. There is also an IRC
channel, see L</SUPPORT>.
lib/AnyEvent/XMPP/Client.pm view on Meta::CPAN
sub add_extension {
my ($self, $ext) = @_;
$self->add_forward ($ext, sub {
my ($self, $ext, $ev, $acc, @args) = @_;
return if $ext->{inhibit_forward}->{$ev};
$ext->_event ($ev, $acc->connection (), @args);
});
}
=head2 add_account ($jid, $password, $host, $port, $connection_args)
This method adds a jabber account for connection with the JID C<$jid>
and the password C<$password>.
C<$host> and C<$port> can be undef and their default will be the domain of the
C<$jid> and the default for the C<port> parameter to the constructor of
L<AnyEvent::XMPP::Connection> (look there for details about DNS-SRV lookups).
C<$connection_args> must either be undef or a hash reference to
additional arguments for the constructor of the L<AnyEvent::XMPP::IM::Connection>
that will be used to connect the account.
Returns 1 on success and undef when the account already exists.
=cut
sub add_account {
my ($self, $jid, $password, $host, $port, $connection_args) = @_;
my $bj = prep_bare_jid $jid;
my $acc = $self->{accounts}->{$bj};
if ($acc) {
$acc->{password} = $password;
$acc->{host} = $host;
$acc->{port} = $port;
$acc->{args} = $connection_args;
return;
}
$acc =
$self->{accounts}->{$bj} =
AnyEvent::XMPP::IM::Account->new (
jid => $jid,
password => $password,
host => $host,
port => $port,
args => $connection_args,
);
$self->event (added_account => $acc);
$self->update_connections
if $self->{started};
lib/AnyEvent/XMPP/Client.pm view on Meta::CPAN
my $acca = $self->{accounts}->{$acc};
$self->event (removed_account => $acca);
if ($acca->is_connected) { $acca->connection ()->disconnect ($reason) }
delete $self->{accounts}->{$acc};
}
=head2 set_accounts (%$accounts)
Sets the set of (to be connected) accounts. C<$accounts> must be a hash
reference which contains the JIDs of the accounts as keys and the values for
C<$password>, C<$domain>, C<$port> and C<$connection_args> as described in
C<add_account> above.
If the account is not yet connected it will be connected on the next call to
C<update_connections> and if an account is connected that is not in
C<$accounts> it will be disconnected.
=cut
sub set_accounts {
my ($self, $accounts) = @_;
lib/AnyEvent/XMPP/Component.pm view on Meta::CPAN
AnyEvent::XMPP::Component - "XML" stream that implements the XEP-0114
=head1 SYNOPSIS
use AnyEvent::XMPP::Component;
my $con = AnyEvent::XMPP::Component->new (
domain => 'chat.jabber.org'
host => 'jabber.org',
port => 5347,
secret => 'insecurepasswordforthehackers'
);
$con->reg_cb (session_ready => sub { ... });
$con->connect;
=head1 DESCRIPTION
This module represents a XMPP connection to a server that authenticates as
component.
This module is a subclass of C<AnyEvent::XMPP::Connection> and inherits all methods.
lib/AnyEvent/XMPP/Component.pm view on Meta::CPAN
=over 4
=item B<new (%args)>
This is the constructor. It takes the same arguments as
the constructor of L<AnyEvent::XMPP::Connection> along with a
few others:
B<NOTE>: Please note that some arguments that L<AnyEvent::XMPP::Connection>
usually takes have no effect when using this class. (That would be
the 'username', 'password', 'resource' and 'jid' arguments for example.)
=over 4
=item secret => $secret
C<$secret> is the secret that will be used for authentication with the server.
=back
=cut
lib/AnyEvent/XMPP/Connection.pm view on Meta::CPAN
will used as C<$service> argument to C<tcp_connect> of L<AnyEvent::Socket>.
B<NOTE:> If you specify the port number here (instead of 'xmpp-client=5222'),
B<no> DNS SRV lookup will be done when connecting.
=item connect_timeout => $timeout
This sets the connection timeout. If the socket connect takes too long
a C<disconnect> event will be generated with an appropriate error message.
If this argument is not given no timeout is installed for the connects.
=item password => $password
This is the password for the C<username> above.
=item disable_ssl => $bool
If C<$bool> is true no SSL will be used.
=item old_style_ssl => $bool
If C<$bool> is true the TLS handshake will be initiated when the TCP
connection was established. This is useful if you have to connect to
an old Jabber server, with old-style SSL connections on port 5223.
lib/AnyEvent/XMPP/Connection.pm view on Meta::CPAN
} else {
my $handled = 0;
$self->event ("iq_${type}_request_xml" => $node, \$handled);
$handled or $self->reply_iq_error ($node, undef, 'service-unavailable');
}
}
sub send_sasl_auth {
my ($self, @mechs) = @_;
for (qw/username password domain/) {
die "No '$_' argument given to new, but '$_' is required\n"
unless defined $self->{$_};
}
$self->{writer}->send_sasl_auth (
[map { $_->text } @mechs],
$self->{username},
($self->{use_host_as_sasl_hostname}
? $self->{host}
: $self->{domain}),
$self->{password}
);
}
sub handle_stream_features {
my ($self, $node) = @_;
my @bind = $node->find_all ([qw/bind bind/]);
my @tls = $node->find_all ([qw/tls starttls/]);
# and yet another weird thingie: in XEP-0077 it's said that
# the register feature MAY be advertised by the server. That means:
lib/AnyEvent/XMPP/Connection.pm view on Meta::CPAN
}, sub {
my ($n, $e) = @_;
if ($e) {
$self->event (iq_auth_error =>
AnyEvent::XMPP::Error::IQAuth->new (context => 'iq_error', iq_error => $e)
);
} else {
my $fields = {};
my (@query) = $n->find_all ([qw/auth query/]);
if (@query) {
for (qw/username password digest resource/) {
if ($query[0]->find_all ([qw/auth/, $_])) {
$fields->{$_} = 1;
}
}
$self->do_iq_auth_send ($fields);
} else {
$self->event (iq_auth_error =>
AnyEvent::XMPP::Error::IQAuth->new (context => 'no_fields')
);
}
}
});
} else {
$self->do_iq_auth_send ({ username => 1, password => 1, resource => 1 });
}
}
sub do_iq_auth_send {
my ($self, $fields) = @_;
for (qw/username password resource/) {
die "No '$_' argument given to new, but '$_' is required\n"
unless defined $self->{$_};
}
my $do_resource = $fields->{resource};
my $password = $self->{password};
if ($fields->{digest}) {
my $out_password = encode ("UTF-8", $password);
my $out = lc sha1_hex ($self->stream_id () . $out_password);
$fields = {
username => $self->{username},
digest => $out,
}
} else {
$fields = {
username => $self->{username},
password => $password
}
}
if ($do_resource && defined $self->{resource}) {
$fields->{resource} = $self->{resource}
}
$self->send_iq (set => {
defns => 'auth',
node => { ns => 'auth', name => 'query', childs => [
lib/AnyEvent/XMPP/Error/MUC.pm view on Meta::CPAN
=head2 METHODS
=over 4
=cut
sub init {
my ($self) = @_;
if ($self->{presence_error}) {
my %mapping = (
'not-authorized' => 'password_required',
'forbidden' => 'banned',
'item-not-found' => 'room_locked',
'not-allowed' => 'room_not_creatable',
'not-acceptable' => 'use_reserved_nick',
'registration-required' => 'not_on_memberlist',
'conflict' => 'nickname_in_use',
'service-unavailable' => 'room_full',
);
my $cond = $self->{presence_error}->{error_cond};
$self->{type} = $mapping{$cond};
lib/AnyEvent/XMPP/Error/MUC.pm view on Meta::CPAN
If we got a presence error the method C<presence_error> returns a
L<AnyEvent::XMPP::Error::Presence> object with further details. However, this class
tries to provide a mapping for you (the developer) to ease the load of figuring
out which error means what. To make identification of the errors with XEP-0045
more clear I included the error codes and condition names.
Here are the more descriptive types:
=over 4
=item password_required
Entering a room Inform user that a password is required.
(Condition: not-authorized, Code: 401)
=item banned
Entering a room Inform user that he or she is banned from the room
(Condition: forbidden, Code: 403)
=item room_locked
lib/AnyEvent/XMPP/Ext.pm view on Meta::CPAN
This extension lets you register new accounts "in-band".
For details please take a look at L<AnyEvent::XMPP::Ext::Registration>.
=item XEP-0078 - Non-SASL Authentication (Version 2.3)
After lots of sweat and curses I implemented finally iq auth.
Unfortunately the XEP-0078 specifies things that are not implemented,
in fact the only server that worked was openfire and psyced.org.
So I de-analyzed the iq auth and now it just barfs the IQ set out
on the stream with the username and the password.
If you insist on XEP-0078 behaviour enable the C<anal_iq_auth> option
when creating the stream.
You can also completely disable iq auth, well, just see the documentation
of L<AnyEvent::XMPP::Connection>
=item XEP-0082 - XMPP Date and Time Profiles (Version 1.0)
Implemented some functions to deal with XMPP timestamps, see L<AnyEvent::XMPP::Util>
lib/AnyEvent/XMPP/Ext/MUC.pm view on Meta::CPAN
B<PLEASE NOTE:> If you set C<$bool> to a B<false> value you have to check the
C<did_create_room> status flag on your own instance of
L<AnyEvent::XMPP::Ext::MUC::User> (provided as the second argument to the
callback) to see whether you need to finish room creation! If you don't do this
the room B<may stay LOCKED for ever>.
See also the C<make_instant> and C<request_configuration> methods of
L<AnyEvent::XMPP::Ext::MUC>.
=item password => $password
The password for the room.
=item nickcollision_cb => $cb
If the join to the room results in a nickname collision the C<$cb>
will be called with the nickname that collided and the return value will
be used as alternate nickname and the join is retried.
This function is called I<everytime> the nickname collides on join, so you
should take care of possible endless retries.
lib/AnyEvent/XMPP/Ext/MUC.pm view on Meta::CPAN
my $rcb_id;
$rcb_id = $self->reg_cb (
join_error => sub {
my ($muc, $eroom, $error) = @_;
return unless cmp_jid ($eroom->nick_jid, $room->nick_jid);
if ($error->type eq 'nickname_in_use'
&& exists $args{nickcollision_cb}) {
$nick = $args{nickcollision_cb}->($nick);
$room->send_join ($nick, $args{password}, $args{history});
return;
}
delete $room->{room_join_timer};
$self->uninstall_room ($con, $room);
$muc->unreg_cb ($rcb_id);
},
enter => sub {
my ($muc, $eroom, $user) = @_;
return unless cmp_jid ($eroom->nick_jid, $room->nick_jid);
delete $room->{room_join_timer};
$muc->unreg_cb ($rcb_id);
}
);
$room->send_join ($nick, $args{password}, $args{history});
}
sub install_room {
my ($self, $con, $room_jid) = @_;
my $room
= $self->{rooms}->{stringprep_jid $con->jid}->{prep_bare_jid $room_jid}
= AnyEvent::XMPP::Ext::MUC::Room->new (
muc => $self,
connection => $con,
lib/AnyEvent/XMPP/Ext/MUC/Room.pm view on Meta::CPAN
sub check_online {
my ($self) = @_;
unless ($self->is_connected) {
warn "room $self not connected anymore!";
return 0;
}
1
}
sub send_join {
my ($self, $nick, $password, $history) = @_;
$self->check_online or return;
$self->{nick_jid} = _join_jid_nick ($self->{jid}, $nick);
$self->{status} = JOIN_SENT;
my @chlds;
if (defined $password) {
push @chlds, { name => 'password', childs => [ $password ] };
}
if (defined $history) {
my $h;
push @{$h->{attrs}}, ('maxchars', $history->{chars})
if defined $history->{chars};
push @{$h->{attrs}}, ('maxstanzas', $history->{stanzas})
if defined $history->{stanzas};
push @{$h->{attrs}}, ('seconds', $history->{seconds})
if defined $history->{seconds};
lib/AnyEvent/XMPP/Ext/RegisterForm.pm view on Meta::CPAN
=head1 SYNOPSIS
my $con = AnyEvent::XMPP::Connection->new (...);
...
$con->do_in_band_register (sub {
my ($form, $error) = @_;
if ($error) { print "ERROR: ".$error->string."\n" }
else {
if ($form->type eq 'simple') {
if ($form->has_field ('username') && $form->has_field ('password')) {
$form->set_field (
username => 'test',
password => 'qwerty',
);
$form->submit (sub {
my ($form, $error) = @_;
if ($error) { print "SUBMIT ERROR: ".$error->string."\n" }
else {
print "Successfully registered as ".$form->field ('username')."\n"
}
});
} else {
print "Couldn't fill out the form: " . $form->field ('instructions') ."\n";
lib/AnyEvent/XMPP/Ext/RegisterForm.pm view on Meta::CPAN
=cut
sub new {
my $this = shift;
my $class = ref($this) || $this;
my $self = bless { @_ }, $class;
$self
}
=item B<try_fillout_registration ($username, $password)>
This method tries to fill out a form which was received from the
other end. It enters the username and password and returns a
new L<AnyEvent::XMPP::Ext::RegisterForm> object which is the answer
form.
B<NOTE:> This function is just a heuristic to fill out a form for automatic
registration, but it might fail if the forms are more complex and have
required fields that we don't know.
Registration without user interaction is theoretically not possible because
forms can be different from server to server and require different information.
Please also have a look at XEP-0077.
Note that if the form is more complicated this method will not work
and it's not guranteed that the registration will be successful.
Calling this method on a answer form (where C<is_answer_form> returns true)
will have an undefined result.
=cut
sub try_fillout_registration {
my ($self, $username, $password) = @_;
my $form;
my $nform;
if (my $df = $self->get_data_form) {
my $af = AnyEvent::XMPP::Ext::DataForm->new;
$af->make_answer_form ($df);
$af->set_field_value (username => $username);
$af->set_field_value (password => $password);
$nform = $af;
} else {
$form = {
username => $username,
password => $password
};
}
return
AnyEvent::XMPP::Ext::RegisterForm->new (
data_form => $nform,
legacy_form => $form,
answered => 1
);
}
lib/AnyEvent/XMPP/Ext/Registration.pm view on Meta::CPAN
}, sub {
my ($node, $error) = @_;
if ($node) {
$cb->($self, 1)
} else {
$self->_error_or_form_cb ($error, $cb);
}
});
}
=item B<send_password_change_request ($username, $password, $cb)>
This method sends a password change request for the user C<$username>
with the new password C<$password>.
For description of the semantics of the callback in C<$cb>
plase look in the description of the C<submit_form> method below.
=cut
sub send_password_change_request {
my ($self, $username, $password, $cb) = @_;
my $con = $self->{connection};
$con->send_iq (set => {
defns => 'register',
node => { ns => 'register', name => 'query', childs => [
{ ns => 'register', name => 'username', childs => [ $username ] },
{ ns => 'register', name => 'password', childs => [ $password ] },
]}
}, sub {
my ($node, $error) = @_;
if ($node) {
$cb->($self, 1, undef, undef)
} else {
$self->_error_or_form_cb ($error, $cb);
}
});
}
lib/AnyEvent/XMPP/IM/Account.pm view on Meta::CPAN
sub remove_connection {
my ($self) = @_;
delete $self->{con}
}
sub spawn_connection {
my ($self, %args) = @_;
$self->{con} = AnyEvent::XMPP::IM::Connection->new (
jid => $self->jid,
password => $self->{password},
(defined $self->{host} ? (host => $self->{host}) : ()),
(defined $self->{port} ? (port => $self->{port}) : ()),
%args,
%{$self->{args} || {}},
);
$self->{con}->reg_cb (
ext_before_session_ready => sub {
my ($con) = @_;
$self->{track} = {};
lib/AnyEvent/XMPP/TestClient.pm view on Meta::CPAN
AnyEvent::XMPP::TestClient - XMPP Test Client for tests
=head1 SYNOPSIS
=head1 DESCRIPTION
This module is a helper module to ease the task of testing.
If you want to run the developer test suite you have to set the environment
variable C<NET_XMPP2_TEST> to something like this:
NET_XMPP2_TEST="test_me@your_xmpp_server.tld:secret_password"
Most tests will try to connect two accounts, so please take a server
that allows two connections from the same IP.
If you also want to run the MUC tests (see L<AnyEvent::XMPP::Ext::MUC>)
you also need to setup the environment variable C<NET_XMPP2_TEST_MUC>
to contain the domain of a MUC service:
NET_XMPP2_TEST_MUC="conference.your_xmpp_server.tld"
lib/AnyEvent/XMPP/TestClient.pm view on Meta::CPAN
$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}) {
lib/AnyEvent/XMPP/TestClient.pm view on Meta::CPAN
my $chp = $self->{checkpoints}->{$name}
or die "no such checkpoint defined: $name";
$chp->[0]--;
if ($chp->[0] <= 0) {
$chp->[1]->();
delete $self->{checkpoints}->{$name};
}
}
sub main_account { ($_[0]->{jid}, $_[0]->{password}) }
sub client { $_[0]->{client} }
sub tests { $_[0]->{tests} }
sub instance_ext {
my ($self, $ext, @args) = @_;
eval "require $ext; 1";
if ($@) { die "Couldn't load '$ext': $@" }
samples/disco_info view on Meta::CPAN
use AnyEvent::XMPP::Ext::Disco;
use AnyEvent::XMPP::Ext::DataForm;
use AnyEvent::XMPP::Ext::Version;
use AnyEvent::XMPP::Namespaces qw/xmpp_ns/;
binmode STDOUT, ":utf8";
my ($jid, $pw, $discodest, $disconode) = @ARGV;
unless (@ARGV >= 3) {
warn "usage: disco_info <jid> <password> <disco-request-destination-jid> [<disco-node>]\n";
exit;
}
my $j = AnyEvent->condvar;
my $cl = AnyEvent::XMPP::Client->new (debug => 1);
my $disco = AnyEvent::XMPP::Ext::Disco->new;
my $version = AnyEvent::XMPP::Ext::Version->new;
$cl->add_extension ($disco);
$cl->add_extension ($version);
samples/retrieve_roster view on Meta::CPAN
my $TIMEOUT = 30; # timeout the whole program after $TIMEOUT seconds
binmode STDOUT, ":utf8";
my ($jid, $pass) = @ARGV;
my $j = AnyEvent->condvar;
my $con =
AnyEvent::XMPP::IM::Connection->new (
jid => $jid,
password => $pass,
initial_presence => -5,
);
$con->reg_cb (
debug_recv => sub { print "< $_[1]\n" },
debug_send => sub { print "> $_[1]\n" },
) if $DEBUG;
my $timer =
AnyEvent->timer (
samples/sendmsg view on Meta::CPAN
#!/opt/perl/bin/perl
use strict;
use utf8;
use AnyEvent;
use AnyEvent::XMPP::IM::Connection;
unless (@ARGV >= 3) { die "sendmsg <account jid> <password> <destination jid>\n" }
my $msg = do { local $/; <STDIN> };
my $dest = $ARGV[2];
my $j = AnyEvent->condvar;
my $con =
AnyEvent::XMPP::IM::Connection->new (
jid => $ARGV[0],
password => $ARGV[1],
initial_presence => -10,
debug => 1
);
$con->reg_cb (
session_ready => sub {
my ($con) = @_;
print "Connected as " . $con->jid . "\n";
print "Sending message to $dest:\n$msg\n";
my $immsg = AnyEvent::XMPP::IM::Message->new (to => $dest, body => $msg);
samples/simple_register_example view on Meta::CPAN
}
}
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 {
samples/simple_register_example view on Meta::CPAN
my ($cl, $acc) = @_;
my $reg = AnyEvent::XMPP::Ext::Registration->new (connection => $acc->connection);
if ($act eq 'unregister') {
$reg->send_unregistration_request (
sub { result ($_[0], $_[1], $_[2], $_[3], 'UNREGISTERED!') }
);
} elsif ($act =~ /chpw:(\S+)/) {
$reg->send_password_change_request ($username, $1,
sub { result ($_[0], $_[1], $_[2], $_[3], 'CHANGED PW!') }
);
}
},
disconnect => sub {
my ($cl, $acc, $h, $p, $reas) = @_;
print "disconnect ($h:$p): $reas\n";
},
error => sub {
my ($cl, $acc, $err) = @_;
samples/talkbot view on Meta::CPAN
or die "Couldn't open messages file: '$msgs_file'\n";
(@msgs) = map { chomp; $_ } <$f>;
close $f;
}
binmode STDOUT, ":utf8";
my ($jid, $pw, $inputfile) = @ARGV;
unless (@ARGV >= 3) {
warn "usage: talkbot <jid> <password> <talkfile>\n";
exit;
}
read_messages ($inputfile);
my $j = AnyEvent->condvar;
my $cl = AnyEvent::XMPP::Client->new (debug => 1);
my $disco = AnyEvent::XMPP::Ext::Disco->new;
my $version = AnyEvent::XMPP::Ext::Version->new;
samples/talkbot_channel view on Meta::CPAN
my ($msg) = @_;
my $talkmsg = $msgs[int (rand (@msgs))];
"You said '$msg' but... " . $talkmsg;
}
binmode STDOUT, ":utf8";
my ($jid, $pw, $inputfile, $room) = @ARGV;
unless (@ARGV >= 3) {
warn "usage: talkbot <jid> <password> <talkfile> [<conference room jid>]\n";
exit;
}
read_messages ($inputfile);
my $j = AnyEvent->condvar;
my $cl = AnyEvent::XMPP::Client->new (debug => 1);
my $disco = AnyEvent::XMPP::Ext::Disco->new;
my $version = AnyEvent::XMPP::Ext::Version->new;
my $muc = AnyEvent::XMPP::Ext::MUC->new (disco => $disco);
t/z_00_register.t view on Meta::CPAN
my $reg = AnyEvent::XMPP::Ext::Registration->new (connection => $con);
$reg->send_registration_request (sub {
my ($reg, $form, $error) = @_;
if ($error) {
$reg_error = $error->string;
} else {
my $af = $form->try_fillout_registration ($username, $cl->{password});
$reg->submit_form ($af, sub {
my ($reg, $ok, $error, $form) = @_;
if ($ok) {
$registered = 1;
$acc->connection->authenticate;
} else {
$reg_error = $error->string;
}
t/z_05_muc2.t view on Meta::CPAN
locked => sub {
my ($muc, $room) = @_;
$cl->{room} = $room;
$sr_created = 1;
$room->request_configuration (sub {
my ($form, $error) = @_;
if ($form) {
if ($form->get_field ('muc#roomconfig_passwordprotectedroom')
&& $form->get_field ('muc#roomconfig_roomsecret')) {
$sr_pass_field = 1;
my $af = AnyEvent::XMPP::Ext::DataForm->new;
$af->make_answer_form ($form);
$af->set_field_value ('muc#roomconfig_passwordprotectedroom', 1);
$af->set_field_value ('muc#roomconfig_roomsecret', "abc123");
$af->clear_empty_fields;
$room->send_configuration ($af, sub {
my ($ok, $error) = @_;
if ($error) {
$sr_error = $error->string;
$cl->finish;
} else {
$sr_config_ok = 1;
t/z_05_muc2.t view on Meta::CPAN
my ($muc, $room, $user) = @_;
undef $guard;
$cl->finish
},
join_error => sub {
my ($muc, $room, $error) = @_;
undef $guard;
$sjo_join_error_type = $error->type;
if ($sjo_join_error_type eq 'password_required') {
$cl->state_done ('step_join_occ_done');
}
}
);
});
$cl->state (['step_join_occ_done'], 'step_join_occ_pass', {}, undef, sub {
$muc->join_room ($cl->{acc2}->connection, $ROOM, "test2user", password => 'abc123');
my $guard;
$guard = $muc->reg_cb (
enter => sub {
my ($muc, $room, $user) = @_;
$sjop_join++;
$cl->{room2} = $room;
$cl->state_done ('step_join_occ_pass_done');
undef $guard;
}, join_error => sub {
t/z_05_muc2.t view on Meta::CPAN
&& $nick_info->{second}->{user1}
&& $nick_info->{second}->{user2}
}, sub { $cl->finish });
$cl->wait;
is ($sjr_error , '', "creator joined without error");
ok ($sjr_created , "creator created room");
ok ($sr_created , "rejoin created room");
is ($sr_error , '', "rejoin created without error");
ok ($sr_pass_field , "configuration form has password fields");
ok ($sr_config_ok , "configuration form was successfully sent");
is ($sjo_join_error_type, 'password_required', "occupant joined without error");
is ($sjop_error , '', "rejoin with password no error");
is ($sjop_join , 1, "joined successfully with password");
is ($nick_info->{user1}->{own} , "$ROOM/test1owner", 'observed own JID of user1');
is ($nick_info->{user1}->{other} , "$ROOM/test2" , 'observed other JID of user1');
is ($nick_info->{user1}->{old_nick}, "test2user" , 'observed old nick of user1');
is ($nick_info->{user1}->{new_nick}, "test2" , 'observed new nick of user1');
is ($nick_info->{user2}->{own} , "$ROOM/test2" , 'observed own JID of user2');
is ($nick_info->{user2}->{other} , "$ROOM/test1owner", 'observed other JID of user2');
is ($nick_info->{user2}->{old_nick}, "test2user" , 'observed old nick of user2');
is ($nick_info->{user2}->{new_nick}, "test2" , 'observed new nick of user2');
( run in 1.221 second using v1.01-cache-2.11-cpan-49f99fa48dc )