如何让我的Perl Jabber机器人成为事件驱动程序?

前端之家收集整理的这篇文章主要介绍了如何让我的Perl Jabber机器人成为事件驱动程序?前端之家小编觉得挺不错的,现在分享给大家,也给大家做个参考。
我正在尝试制作一个Jabber机器人,我在等待消息时无法保持运行状态.如何让我的脚本继续运行?我试过调用一个子程序,它有一个while循环,我理论上已经设置检查任何消息并作出相应的反应,但我的脚本不是这样的.

这是我的来源:http://pastebin.com/03Habbvh

# set jabber bot callbacks
$jabberBot->SetMessageCallBacks(chat=>\&chat);
$jabberBot->SetPresenceCallBacks(available=>\&welcome,unavailable=>\&killBot);
$jabberBot->SetCallBacks(receive=>\&prnt,iq=>\&gotIQ);

$jabberBot->PresenceSend(type=>"available");
$jabberBot->Process(1);

sub welcome
{
    print "Welcome!\n";
    $jabberBot->MessageSend(to=>$jbrBoss->GetJID(),subject=>"",body=>"Hello There!",type=>"chat",priority=>10);
    &keepItGoing;
}

sub prnt
{
    print $_[1]."\n";
}

#$jabberBot->MessageSend(to=>$jbrBoss->GetJID(),body=>"Hello There! Global...",priority=>10);
#$jabberBot->Process(5);
#&keepItGoing;

sub chat
{
    my ($sessionID,$msg) = @_;
    $dump->pl2xml($msg);
    if($msg->GetType() ne 'get' && $msg->GetType() ne 'set' && $msg->GetType() ne '')
    {
        my $jbrCmd = &trimSpaces($msg->GetBody());
        my $dbQry = $dbh->prepare("SELECT command,acknowledgement FROM commands WHERE message = '".lc($jbrCmd)."'");
        $dbQry->execute();
        if($dbQry->rows() > 0 && $jbrCmd !~ /^insert/si)
        {
            my $ref = $dbQry->fetchrow_hashref();
            $dbQry->finish();
            $jabberBot->MessageSend(to=>$msg->GetFrom(),body=>$ref->{'acknowledgement'},priority=>10);
            eval $ref->{'command'};
            &keepItGoing;
        }
        else
        {
            $jabberBot->MessageSend(to=>$msg->GetFrom(),body=>"I didn't understand you!",priority=>10);
            $dbQry->finish();
            &keepItGoing;
        }
    }
}

sub gotIQ
{
    print "iq\n";
}

sub trimSpaces
{
    my $string = $_[0];
    $string =~ s/^\s+//; #remove leading spaces
    $string =~ s/\s+$//; #remove trailing spaces
    return $string;
}

sub keepItGoing
{

    print "keepItGoing!\n";
    my $proc = $jabberBot->Process(1);
    while(defined($proc) && $proc != 1)
    {
        $proc = $jabberBot->Process(1);
    }
}

sub killBot
{
    print "killing\n";
    $jabberBot->MessageSend(to=>$_[0]->GetFrom(),body=>"Logging Out!",priority=>10);
    $jabberBot->Process(1);
    $jabberBot->Disconnect();
    exit;
}

解决方法

POE有一些非常好的事件框架.我不知道Jabber(POE :: Component :: Jabber)有多好,但它可能值得一看.

猜你在找的Perl相关文章