sub update results from the CPAN

sub update
Bot-JabberBot
view release on metacpan or search on metacpan
	my $response;
	if (ref $reply eq 'HASH') {
	    $response = $reply->{body};
	}
	else { $response = $reply; }

	$self->say({ who => $said->{who},
		     body => $response,
		     type => $in->attr('type')});  
		   
    }
}

sub said {
    # override
}

sub say {
    my ($self,$say) = @_;
    my $out = $self->nf->newNodeFromStr('<message><body>'.$say->{body}.'</body></message>');
    $out->attr('to',$say->{who});
    my $type = $say->{type} || 'chat';
    $out->attr('type',$type);
    $self->c->send($out);
}

sub presence {
    my ($self,$in) = @_;
    
    my $type = $in->attr('type');
    if ($type eq 'subscribe') {
	my $message = "<presence to='".$in->attr('from')."' type='subscribed'/>";
	my $node = $self->nf->newNodeFromStr($message);
	$self->c->send($node);
	$message = "<presence to='".$in->attr('from')."' type='subscribe'><status>I would like to add you to my roster.</status></presence>";
	my $node = $self->nf->newNodeFromStr($message);
	$self->c->send($node);
	my $roster = $self->roster;
	push @{$roster}, $in->attr('from');
	$self->roster($roster);
    }
}
 
sub handle_iq {
    my ($self,$in) = @_;

    my $type = $in->attr('id');
    if ($type =~ m/roster_1/) {
	my @roster;
	my $query = $in->getTag('query');
	my @items = $query->getTag('item');
	foreach (@items) {
	    if ($_->attr('jid') =~ m/\@/) {
		push @roster, $_->attr('jid');
	    }
	}
	$self->roster(\@roster);
    }
} 

sub update_session {
    my ($self,$said) = @_;
    my $session = $self->session;
    my $dialogue = $session->{$said->{who}} || [ ];
    my $session_length = $self->session_length || '8';
    if (scalar(@{$dialogue}) > 8) {
	pop @{$dialogue};
    }
    push @{$dialogue}, $said->{body};
    $session->{$said->{who}} = $dialogue;
    $self->session($session);
}

sub request_roster {
    my ($self) = @_;
    my $request = $self->nf->newNodeFromStr('<iq id="roster_1" type="get"><query xmlns="jabber:iq:roster"/></iq>');
    $self->c->send($request);
} 

=head1 DESCRIPTION

a very simple Jabber bot base class, which shares interface with the Bot::BasicBot 
class for IRC bots. this allows me to take Bot::BasicBot subclasses and replace the 
base class with 

    use base qw( Bot::JabberBot );

and they Just Work. also provides some jabber-specific features; the bot requests
the Roster of jabberids whose presence it wants to know about; and when it it sent a
jabber subscription request, it automatically accepts it and adds the requester to
its roster.

=head1 METHODS

      new(%args);
	 Creates a new instance of the class.  Name value pairs may be
passed which will have the same effect as calling the method of that name
with the value supplied.

      run();
	 Runs the bot.  Hands the control over to the Jabber::Connection object 

      said({ who => 'test@jabber.org', body => 'foo'}) 
 
           This is the main method that you'll want to override in your sub-
class - it's the one called by default whenever someone sends a message.
You'll be passed a reference to a hash that contains these arguments:

            { who => [jabberid of message sender],
              body => [body text of message }

You should return what you want to say.  This can either be a sim-
ple string or a hashref that contains values that are compatible with say
(just changing the body and returning the structure you were passed works
very well.)

           Returning undef will cause nothing to be said.

      say({who => 'test@jabber.org', body => 'bar'})
  
           Say something to someone.
( run in 2.436 seconds using v1.01-cache-2.11-cpan-7fcb06a456a )