1

我在使用 BUILD 方法时遇到问题，我想连接到基于 HTML 的聊天。我希望这个类能让我保持登录状态，以便执行发送和接收消息的操作。

我尝试了向下的方法，但似乎在运行时会对服务器造成压力。

package Shoutbox;

use common::sense;
use WWW::Mechanize; 
use WWW::Mechanize::DecodedContent; 
use JSON -support_by_pp;
use URI::Escape;
use Moose;


our $url = WWW::Mechanize->new();
$url->get("http://www.forum-invaders.com.br/vb/login.php");
$url->submit_form(
    fields => { 
        vb_login_username => 'login',
        vb_login_password => 'senha',
    });

has 'msg' => (is => 'rw', isa => 'Str');

sub send_msg {
    my $self = shift;
    my $message = $self->msg;
    my $content = $url->decoded_content;
    $content =~ /SECURITYTOKEN = "(.*?)"/g ;
    my $token = $1;
    if($content =~ /Bem-vindo/gi) {
        my $msg = uri_escape($message);
        $url->post("http://www.forum-invaders.com.br/vb/vbshout.php",{
            message => $msg, securitytoken => $token,
            do => "ajax", action => "save", instanceid => "2"});
    } 
}

sub get_msg{
    my $r = $url->get("http://www.forum-invaders.com.br/vb/vbshout.php?type=activeusers&do=ajax&action=fetch&instanceid=2");
    my $json = JSON->new->relaxed;
    my $s = $json->decode($r->decoded_content);
    my $msg = $s->{"shouts"}->{0}->{"message_raw"};
    my $user = $s->{"shouts"}->{0}->{"musername"};
    my $name;
    if ($user =~ />(.+)<\/span/gi) {$name = $1;}
    else {$name = $user}
    my $now = join(" => ", $name, $msg) . "\n";
    return $now;
}
no Moose;
1;

很快我收到了使用 BUILD 方法的建议，所以我这样做了，但没有奏效。

package Shoutbox;

use common::sense;
use WWW::Mechanize; 
use WWW::Mechanize::DecodedContent; 
use JSON -support_by_pp;
use URI::Escape;
use Moose;

has 'login' => (is => 'rw', isa => 'Str');
has 'password' => (is => 'rw', isa => 'Str');
our $url;
our $token;

sub BUILD{
    my $self = shift;
    $url = WWW::Mechanize->new();
    $url->get("http://www.forum-invaders.com.br/vb/login.php");
    $url->submit_form(
    fields => {
    vb_login_username => $self->login,
    vb_login_password => $self->password,
    });

    my $content = $url->decoded_content;
    $content =~ /SECURITYTOKEN = "(.*)"/g;
    if ($1 eq "guest"){
        print "Login Error\n";
        exit;
    }
    else (print "Login OK!\n";}
        $token = $1;
    print $token . "\n";
}

has 'msg' => (is => 'rw', isa => 'Str');


sub send_msg {
    BUILD;
    my $self = shift;
    my $message = $self->msg;

    my $msg = uri_escape($message);
    $url->post("http://www.forum-invaders.com.br/vb/vbshout.php",{
    message => $msg, securitytoken => $token,
    do => "ajax", action => "save", instanceid => "2"});
}

sub get_msg{
    BUILD;
    my $r = $url->get("http://www.forum-invaders.com.br/vb/vbshout.php?type=activeusers&do=ajax&action=fetch&instanceid=2");
    my $json = JSON->new->relaxed;
    my $s = $json->decode($r->decoded_content);
    my $msg = $s->{"shouts"}->{0}->{"message_raw"};
    my $user = $s->{"shouts"}->{0}->{"musername"};
    my $name;
    if ($user =~ />(.+)<\/span/gi) {$name = $1;}
    else {$name = $user}
    my $now = join(" => ", $name, $msg) . "\n";
    return $now;
    exit;
}
no Moose;
1;
4

0 回答 0