Net-RVP

 view release on metacpan or  search on metacpan

client.pl  view on Meta::CPAN

$Debug->print("logging in at ".(scalar localtime)."\n");

$Log->autoflush(1);
$Log->print("logging in at ".(scalar localtime)."\n");

print 'password:';
system('stty -echo');
chomp(my $pass = <STDIN>);
system('stty echo');

# create presentity object
$rvp = Net::RVP->new(
 debug => sub { $Debug->print(@_) },
# ideally we could get the IP using IO::Socket::INET::sockport(), but we
# can't do it for the server (it gives back 0.0.0.0 since it isn't connected),
# and since the client uses LWP::UserAgent, we can't get the IP in time to
# send it (unless we could hook in somewhere but that wouldn't be portable)
# so, for now our IP must be specified manually, here:
 host  => "1.2.3.4:$port",
 name  => 'First_Last',
 user  => 'domain\\login',
 pass  => $pass,
 site  => 'rvp.server.com:80',
 sink  => $sink,
);

# set callback
$server->data(sub { $rvp->notify(shift) });

# log in, set status to online, set primary subscription renewal event
print "logging in\n";
my $renew = $rvp->login() or die 'login failed';
$rvp->status('online');
Event->timer(interval => $renew-30, cb => sub { $rvp->renew() });

# subscribe to our contacts
print "adding contacts\n";
my $contacts = $config->{contact} || {};
$contacts = $contacts->{name} || [];
$contacts = [$contacts] unless ref $contacts;

my $start = time;
$renew = 0;
my $users = {};
for my $contact(@$contacts) {
  my $user = $rvp->user($contact);
  if(my $watch = $user->watch()) {
    $renew = $watch;
    print 'Adding watch for '.$user->display().' ('.$user->email()."); status ".
     $user->state()."\n";
    $users->{lc $user->name()} = $user;
  }
}
if($renew) {
  my $ival = $renew-(time-$start)-30;  # 30 seconds short of timing out
  Event->timer(interval => ($ival < 1 ? 1 : $ival), cb => sub {
   $_->watch() for values %$users; });
}

=pod
my @state = qw(offline online idle on-phone at-lunch busy);
Event->timer(interval => 60,
 cb => sub { $rvp->status($state[rand @state]) });
=cut

# add a STDIN I/O event
if(my $flags = fcntl(STDIN,F_GETFL,pack '') >= 0) {
  fcntl(STDIN,F_SETFL,$flags | O_NONBLOCK);
}
Event->io(fd => \*STDIN, poll => 'r', cb => \&stdin_read_event);

# start event loop; this is it...
print "ready\n\n";
Event::loop();

# on finish, set STDIN back to non-blocking and write out the configuration
if(my $flags = fcntl(STDIN,F_GETFL,pack '') >= 0) {
  fcntl(STDIN,F_SETFL,$flags & ~O_NONBLOCK);
}
$config->{contact}->{name} = [ map $_->name(), values %$users ];
write_config($config);
print "logging out\n";
$rvp->status('offline');
$rvp->logout();
$Net::RVP::Debug = 0;

$Log->print("logging out at ".(scalar localtime)."\n\n");
$Log->close();

$Debug->print("logging out at ".(scalar localtime)."\n\n");
$Debug->close();

undef $rvp;



( run in 0.333 second using v1.01-cache-2.11-cpan-df04353d9ac )