Perl 脚本似乎在缓存？

Question

我正在使用 Apache 通过 mod_perl 运行 perl 脚本。我正在尝试以一种 Restful 方式解析参数(又名 GET www.domain.com/rest.pl/Object/ID)。

如果我像这样指定 ID:GET www.domain.com/rest.pl/Object/1234 我将返回对象 1234 作为预期的结果.

但是，如果我像这样指定了一个不正确的被黑 url GET www.domain.com/rest.pl/Object/123，我也会取回对象 1234。

我很确定 this question 中的问题正在发生，所以我打包了我的方法并从我的核心脚本中调用它。即使在那之后，我仍然看到线程返回看似缓存的数据。

上述文章中的建议之一是将 my 替换为 our。我阅读 our 的印象对比my our 是全局的而 my 是本地的。我的假设是局部变量每次都会重新初始化。也就是说，就像在下面的代码示例中一样，我每次都使用新值重置变量。

Apache Perl 配置是这样设置的:

PerlModule ModPerl::Registry

<Directory /var/www/html/perl/>
   SetHandler perl-script
   PerlHandler ModPerl::Registry
   Options +ExecCGI
</Directory>

这是直接调用的 perl 脚本:

#!/usr/bin/perl -w
use strict;
use warnings;
use Rest;

Rest::init();

这是我的包 Rest。该文件包含用于处理其余请求的各种函数。

#!/usr/bin/perl -w

package Rest;

use strict;
# Other useful packages declared here.

our @EXPORT = qw( init );

our $q = CGI->new;

sub GET($$) {
    my ($path, $code) = @_;
    return unless $q->request_method eq 'GET' or $q->request_method eq 'HEAD';
    return unless $q->path_info =~ $path;
    $code->();
    exit;
}

sub init()
{
eval {
        GET qr{^/ZonesByCustomer/(.+)$} => sub {
            Rest::Zone->ZonesByCustomer($1);
        }
    }
}

# packages must return 1
1;

作为旁注，我不完全理解这个 eval 语句是如何工作的，或者 qr 命令正在解析什么字符串。此脚本主要取自 this example用于使用 perl 设置基于休息的 Web 服务。我怀疑它是从那个神奇的 $_ 变量中提取出来的，但我不确定它是否是，或者它被填充了什么(显然是查询字符串或 url，但它似乎只是成为其中的一部分？)。

这是我的包 Rest::Zone，它将包含功能操作的内容。我省略了我如何操作数据的细节，因为它正在工作并将其作为抽象 stub 保留。主要问题似乎是传入此函数的参数或函数的输出。

#!/usr/bin/perl -w

package Rest::Zone;

sub ZonesByCustomer($)
{
    my ($className, $ObjectID) = @_;

    my $q = CGI->new;
    print $q->header(-status=>200, -type=>'text/xml',expires => 'now', -Cache_control => 'no-cache', -Pragma => 'no-cache');
    my $objectXML = "<xml><object>" . $ObjectID . "</object></xml>";
    print $objectXML;
}

# packages must return 1
1;

这是怎么回事？为什么我总是收到陈旧或缓存的值？

Answer 1

不要使用全局 CGI 对象。

package Rest;

...

#our $q = CGI->new; 
# Remove that, it is only going to be executed once when the pacakge is loaded (use'd)

sub GET($$) {
    my ($path, $code) = @_;
    my $q = CGI->new; # Add this line (you can call CGI->new multiple times)
    return unless $q->request_method eq 'GET' or $q->request_method eq 'HEAD';
    return unless $q->path_info =~ $path;
    $code->();
    exit;
}

您可以将其保留为我们的 全局并在每次请求时刷新它。由于每个请求都会调用 init()，因此将其放在那里:

package Rest;
our $q;
...
sub GET ....
...
sub init
{
  $q = CGI->new;
  eval ...
  ...
}