以下脚本应该演示我在 OpenBSD5.2 上使用 mod_perl 使用 Mojolicious 时遇到的问题。
该脚本工作正常 4 次被称为 mod_perl 下的 CGI。脚本的额外运行导致 Mojolicious 不返回异步帖子。通常在数据到达时调用的 subs 似乎不再被调用。从命令行运行脚本工作正常,因为 perl 完全从头开始,一切都重新初始化,而 mod_perl 下不是这种情况。停止和启动 Apache 会重新初始化 mod_perl,以便脚本可以再运行 4 次。
我只在 OpenBSDs 端口树 (2.76) 中提供的版本中使用 Mojolicious 在 OpenBSD5.2 上对此进行了测试。我认为这有点旧,但这就是 OpenBSD 附带的。
我在这里做错了什么吗?或者 Mojolicious 有可能有一些循环引用或导致这个问题的东西?
我对正在使用的平台(OpenBSD)没有影响。所以请不要建议“使用 Linux 并安装最新的 Mojolicious 版本”。但是,如果您确定运行更高版本的 Mojolicous 会解决问题,我可能会获得安装它的许可(尽管我还不知道如何安装)。
提前致谢!
T。
这是脚本:
#!/usr/bin/perl
use diagnostics;
use warnings;
use strict;
use feature qw(switch);
use CGI qw/:param/;
use CGI qw/:url/;
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use Mojo::IOLoop;
use Mojo::JSON;
use Mojo::UserAgent;
my ($activeconnections, $md5, $cgi);
my $ua = Mojo::UserAgent->new;
$ua->max_redirects(0)->connect_timeout(3)->request_timeout(6); # Timeout 6 seconds of which 3 may be connecting
my $delay = Mojo::IOLoop->delay();
sub online{
my $url = "http://www.backgroundtask.eu/Systeemtaken/Search.php";
$delay->begin;
$activeconnections++;
my $response_bt = $ua->post_form($url, { 'ex' => $md5 }, sub {
my ($ua, $tx) = @_;
my $content=$tx->res->body;
$content =~ m/(http:\/\/www\.backgroundtask\.eu\/Systeemtaken\/taakinfo\/.*$md5\/)/;
if ($1){
print "getting $1\n";
my $response_bt2 = $ua->get($1, sub {
$delay->end();
$activeconnections--;
print "got result, ActiveConnections: $activeconnections\n";
($ua, $tx) = @_;
my $filename = $tx->res->dom->find('table.view')->[0]->find('tr.even')->[2]->td->[1]->all_text;
print "fn = " . $filename . "\n";
}
)
} else {
print "query did not return a result\n";
$activeconnections--;
$delay->end;
}
});
}
$cgi = new CGI;
print $cgi->header(-cache_control=>"no-cache, no-store, must-revalidate") . "\n";
$md5 = lc($cgi->param("md5") || ""); # read param
$md5 =~ s/[^a-f0-9]*//g if (length($md5) == 32); # custom input filter for md5 values only
if (length $md5 != 32) {
$md5=lc($ARGV[0]);
$md5=~ s/[^a-f0-9]*//g;
die "invalid MD5 $md5\n" if (length $md5 ne 32);
}
online;
if ($activeconnections) {
print "waiting..., activeconnections: $activeconnections\n" for $delay->wait;
}
print "all pending requests completed, activeconnections is " . $activeconnections . "\n";
print "script done.\n md5 was $md5\n";
exit 0;